prelude.vaq

; global environment

(op thunk ()
   (list 'lambda () (pair 'seq rest)))

(proc isa? (thing type)
   (thing.type.has? type))

(proc bool? (thing)
   (isa? thing 'bool))

(proc lambda? (thing)
   (isa? thing 'lambda))

(proc proc? (thing)
   (isa? thing 'proc))

(proc op? (thing)
   (isa? thing 'op))

(proc apply? (thing)
   (thing.answers? 'apply))

(proc symbol? (thing)
   (isa? thing 'symbol))

(proc stream? (thing)
   (isa? thing 'stream))

(proc socket? (thing)
   (isa? thing 'socket))

(proc null? (thing)
   (is? thing null))

(proc eof? (x)
   (isa? x 'EOF))

(proc not (x)
   x.to-bool.not)

(proc != (x y)
   (not (= x y)))

(proc >= (x y)
   (not (< x y)))

(proc <= (x y)
   (not (> x y)))

(op and (x)
   (if rest
      (list 'if x (and.apply rest) 'false)
      (list 'if x 'true 'false)))

(op or (x)
   (def stub (gensym))
   (list 'seq
      (list 'def stub x)
      (list 'if stub stub (if rest (or.apply rest) 'false))))

(proc and? (x)
   (if x
      (if rest
         (and?.apply rest)
         true)
      false))

(proc or? (x)
   (if x
      x
      (if rest
         (or?.apply rest)
         false)))

(proc nand ()
   (not (and?.apply rest)))

(proc nor ()
   (not (or?.apply rest)))

(proc xor (x y)
   (nor (and? x y) (nor x y)))

(proc identity (x) x)

(proc append (xs)
   (if rest
      (let (rv (xs.append rest.head))
         (append.apply (pair rv rest.tail)))
      xs))

(proc union (xs)
   (if rest
      (let (rv (xs.union rest.head))
         (union.apply (pair rv rest.tail)))
      xs))

(proc apply (f args)
   (def options (if opt.opt opt.opt (table)))
   (f.apply args opt: options))

(proc papply (f)
   ((lambda (cargs)
      (proc ()
         (f.apply (append cargs rest) opt: opt))) rest))

(proc error (name form message)
   (fail
      (object 'type '(error)
              'name name
              'form form
              'view (lambda () (vector 'error name form message))
              'message message
              'to-text message)))

(proc compose ()
   (def funz rest)
   (def s funz.size)
   (if (= s 0)
      (error 'too-few-args %(compose @rest) "(compose ...) requires at least one argument.  It prefers more than one.")
      (if (= s 1)
         rest.head
         (if (= s 2)
            (proc () (funz.head (funz.tail.head.apply rest opt: opt)))
            (compose funz.head (apply compose funz.tail))))))

(op loop (name vars)
   (proc sep (x y xs names vals)
      (if xs.empty?
         (pair (send (pair x names) 'reverse) (send (pair y vals) 'reverse))
         (sep xs.head xs.1 xs.tail.tail (pair x names) (pair y vals))))
   (def p
      (if vars.empty?
         (pair () ())
         (sep vars.head vars.1 vars.tail.tail () ())))
   (def lambda-form
      ((send (list 'lambda p.head) 'append)
         (list
            (pair 'seq rest))))
   (def args (gensym))
   (list
      'let
      (list args (pair 'list p.tail))
      (list 'def name lambda-form)
      (list (list 'send name ''apply) args 'null)))

(op : () ; table op
   (pair 'table
      (if (pair? rest)
         (if (= (mod rest.size 2) 0)
            (loop go (k rest.head v rest.1 xs rest.tail.tail acc ())
               (def noob (pair (list 'quote k) (pair v acc)))
               (if (pair? xs)
                  (go xs.head xs.tail.head xs.tail.tail noob)
                  noob))
            (error 'args-fail %(: @rest) "(: ...) requires an even number of arguments"))
            ())))

(op cond ()
   (def default
      (if (opt.get 'else)
         (opt.get 'else)
         (list 'error ''cond-no-matching-clause (list 'pair ''cond (list 'quote rest)) "(cond... ) form fell through!")))
   (if (< rest.size 2)
      (error 'syntax-error (pair 'cond rest) "(cond ...) should have at least one predicate and consequent.")
      (loop go (pred rest.0 conseq rest.1 remaining rest.tail.tail)
         (if remaining
            (list 'if pred conseq (go remaining.0 remaining.1 remaining.tail.tail))
            (list 'if pred conseq default)))))

(op qq (expr)
   (proc constant? (expr)
      (if (pair? expr)
         (= expr.head 'quote)
         (send (= '(symbol) expr.type) 'not)))
   (proc combine-skeletons (left right expr)
      (cond
         (and (constant? left) (constant? right))
            (if (and (= (env.eval left)  expr.head)
                     (= (env.eval right) expr.tail))
               (list 'quote expr)
               (list 'quote (pair (env.eval left) (env.eval right))))
         (= right ())
            (list 'list left)
         (and (pair? right) (= right.head 'list))
            (pair 'list (pair left right.tail))
         else: (list 'pair left right)))
   (proc expand-quasiquote (expr nesting)
      (cond
         (send (pair? expr) 'not)
            (if (constant? expr)
               expr
               (list 'quote expr))
         (and (is? expr.head 'unq) (= expr.size 2))
            (if nesting.zero?
               expr.1
               (combine-skeletons
                  ''unq
                  (expand-quasiquote expr.tail nesting.dec)
                  expr))
         (and (is? expr.head 'qq) (= expr.size 2))
            (combine-skeletons
               ''qq
               (expand-quasiquote expr.tail nesting.inc)
               expr)
         (and (pair? expr.head) (= expr.head.head 'unqs) (= expr.head.size 2))
            (if (= nesting 0)
               (list (list 'send expr.head.1 ''append)
                    (expand-quasiquote expr.tail nesting))
               (combine-skeletons
                  (expand-quasiquote expr.head nesting.dec)
                  (expand-quasiquote expr.tail nesting)
                  expr))
         else:
            (combine-skeletons
               (expand-quasiquote expr.head nesting)
               (expand-quasiquote expr.tail nesting)
               expr)))
   (expand-quasiquote expr 0))

(op when (pred)
   (qq
      (if (unq pred)
         (seq (unqs rest))
         null)))

(op case (val)
   (def default
      (if (opt.get 'else)
         (opt.get 'else)
         (list 'error ''case-no-matching-clause (list 'pair ''case (list 'quote rest)) "(case ...) form fell through!")))
   (if (< rest.size 2)
      (error 'syntax-error (pair 'case rest) "(case ...) should have at least one predicate and consequent.")
      (seq
         (def cval (gensym))
         (qq
            (let ((unq cval) (unq val))
               (unq
                  (loop go (stuff rest.0 conseq rest.1 remaining rest.tail.tail)
                     (def pred (qq ((send (quote (unq stuff)) 'has?) (unq cval))))
                     (if remaining
                        (list 'if pred conseq (go remaining.0 remaining.1 remaining.tail.tail))
                        (list 'if pred conseq default)))))))))

(op while (pred body)
   ; call (next <value>) to skip the rest of the bodies and go to the next loop (continue)
   ;     if predicate evals false, <value> will be returned from the while expression
   ; call (last <value>) to terminate the loop and return said value (break)
   (def jump (gensym))
   (def rv (gensym))
   (def kont (gensym))
   %(gate
      ((thunk
         (def $jump
            (lambda ($rv)
               (seq
                  (proc next (v) (capture $kont ($jump v)))
                  (proc last (v) (capture $kont v))
                  (if $pred
                     ($jump (seq @(pair body rest)))
                     $rv))))
         ($jump null)))))

(op everywhere ()
   %(seq @rest (compile-eval @rest)))

(everywhere
   (proc list-fold (f acc xs)
      (if xs.empty?
         acc
         (list-fold f (f xs.head acc) xs.tail)))

   (proc list-foldr (f acc xs)
      (if xs.empty?
         acc
         (f xs.head (list-foldr f acc xs.tail))))

   (proc list-map (f xs)
      (if xs
         (pair (f xs.head) (list-map f xs.tail))
         ()))

   (proc list-filter (f xs)
      (list-foldr (lambda (x y) (if (f x) (pair x y) y)) '() xs))

   (def list-sort
      (let ()
         (def merge (lambda (f a b)
            (if a.size.zero?
               b
               (if b.size.zero?
                  a
                  (if (f a.head b.head)
                     (pair a.0 (merge f a.tail b))
                     (pair b.0 (merge f a b.tail)))))))

         (def sort (lambda (f yarr)
            (def len yarr.size)
            (if (< len 2)
               yarr
               (seq
                  (def half (send (/ len 2) 'floor))
                  (merge f (sort f (yarr.take half)) (sort f (yarr.drop half)))))))

         (lambda (f xs)
            (sort f xs)))))

(op _ (body)
   (def uscore (gensym))
   (def bodies (pair body rest))
   (proc rename (form)
      (if (pair? form)
         (if (= form.head '_)
            form
            (list-map rename form))
         (if (= form '_)
            uscore
            form)))
   (qq
      (lambda ((unq uscore))
         (seq (unqs (rename bodies))))))

(op ensure (thnk)
   (def v (gensym))
   %(guard
      (proc (e k)
         ($thnk)
         (fail e))
      (gate
         (let ($v (seq @rest))
            ($thnk)
            $v))))

(op test (name expr)
   %(let ()
      (proc guard-proc (e k)
         (log (list (quote $name) 'ERROR e))
         false)
      (let (ok (guard guard-proc $expr))
         (if ok
            (say (list (quote $name) 'ok))
            (log (list (quote $name) 'FAIL))))))

(proc cell (value)
   (def box (vector value))
   (object
      'type '(cell)
      'get  (lambda () box.0)
      'set! (lambda (v)
               (seq
                  (box.set! 0 v)
                  v))
      'inc! (lambda ()
               (def x (+ box.0 1))
               (box.set! 0 x)
               x)
      'dec! (lambda ()
               (def x (- box.0 1))
               (box.set! 0 x)
               x)
      'view (lambda () (vector 'cell (send box.0 'view)))
      auto: '(get inc! dec!)))

(op qw ()
   (pair 'list (list-map (lambda (x) x.to-text) rest)))

(op with-gensyms (gs)
   (def pairs (list-map (_ (list _ '(gensym))) gs))
   (def lets
      (loop go (x pairs.head xs pairs.tail)
         (if xs
            (go (x.append xs.head) xs.tail)
            x)))
   %(let $lets @rest))

(op for (init pred update body)
   (def bodies (pair body rest))
   (with-gensyms (jump rv tmp kont)
      %(gate
         (let $init
            (def $jump
               (lambda ($rv)
                  (seq
                      (proc redo (v) (last ($jump v)))
                      (proc next (v) (seq $update (redo v)))
                      (proc last (v) (capture $kont v))
                      (if $pred
                         (let ($tmp (seq @bodies))
                            $update
                            ($jump $tmp))
                         $rv))))
            ($jump null)))))

(op each (name arg body)
   (def bodies (pair body rest))
   (with-gensyms (xs jump)
     %(let ($xs (send $arg 'to-list))
         (proc $jump ($name)
            @bodies)
         (list-map $jump $xs))))

(proc range (start end)
   (def step (if opt.step opt.step 1))
   (loop go (i start acc ())
      (if (> i end)
         acc.reverse
         (go (+ i step) (pair i acc)))))

(op matrix ()
   ; (matrix ((0 0 1) (0 0 2)) ((0 1 1) (0 2 1)))
   ;     -> (vector: (vector: (vector: 0 0 1) (vector: 0 0 2)) (vector: (vector: 0 1 1) (vector: 0 2 1)))
   (qq
      (vector
         (unqs
            (list-map
               (_
                  (if (pair? _)
                     (qq (matrix (unqs _)))
                     _))
               rest)))))

(proc vaquero-internal-x-prod (xs ys)
   (cond
      xs.to-bool.not ys
      ys.to-bool.not xs
      else:
         (apply append
            (list-map
               (lambda (x) 
                  (list-map
                     (lambda (y)
                        (if (pair? x)
                           (append x (list y))
                           (list x y)))
                     ys))
               xs)
            )))

(proc vaquero-internal-x-prod-n (xs)
   (if rest
      (let (acc (vaquero-internal-x-prod xs rest.head))
         (vaquero-internal-x-prod-n.apply (pair acc rest.tail)))
      xs))

(op bind (names)
   ; FIXME expand to destructure trees as well as lists
   (def expr-val (gensym))
   (proc define (name n)
      %(def $name (send $expr-val $n)))
   (def defz
      (loop go (name names.head others names.tail n 0 acc ())
         (def new-acc (pair (define name n) acc))
         (if others
            (go others.head others.tail n.inc new-acc)
            new-acc.reverse)))
   %(seq
      (def $expr-val (seq @rest))
      @defz))

(op gen (name body)
   %(def $name
      (let (default (proc () @(pair body rest))
            max-arity (cell 0)
            clauses (:)
            cache (:))
         (proc add-clause! (formal-types handler)
            (def this-arity formal-types.size)
            ; check for pre-existing - no overrides
            (when (clauses.has? formal-types)
               (error 'spec-already-defined
                      %(spec $'$name $formal-types $handler)
                      "Generic procedure specializations can not be redefined."))
            (when (> this-arity max-arity.get)
               (max-arity.set! this-arity))
            (cache.del!.apply cache.keys)
            (clauses.set! formal-types handler))
         (proc gen-apply (args)
            (def arity (math.min max-arity.get args.size))
            (def signature (list-map (_ (append _.type '(object))) (args.take arity)))
            (def options opt)
            (if (cache.has? signature)
               ((send (cache.get signature) 'apply) args opt: options)
               (let (possible (vaquero-internal-x-prod-n.apply signature))
                  (loop go (this possible.head others possible.tail)
                     (if (clauses.has? this)
                        (let (f (clauses.get this))
                           (cache.set! signature f) ; cache result
                           (f.apply args opt: options))
                        (if others
                           (go others.head others.tail)
                           (default.apply args opt: options)))))))
         (proc view ()
            (send
               (list clauses 'default default)
               'view))
         (object
            'type '(gen proc lambda)
            'add-clause! add-clause!
            'apply gen-apply
            'view view))))

(op spec (name formal-types body)
   (def mod-2 (mod formal-types.size 2))
   (def good-args (and formal-types mod-2.to-bool.not))
   (when good-args.not
      (error 'bad-arguments
              %(spec $name $formal-types $body @rest)
              "spec: requires an alternating list of names and types, at least one pair."))
   (bind (types formals)
      (loop do (arg-type formal-types.head arg-name formal-types.tail.head types () names () remains formal-types.tail.tail)
         (let (nu-types (pair arg-type types) nu-names (pair arg-name names))
            (if remains
               (do remains.head remains.tail.head nu-types nu-names remains.tail.tail)
               (list nu-types.reverse nu-names.reverse)))))
   %((send $name 'add-clause!)
      (quote $types)
      (proc $formals @(pair body rest))))

(op assert (predicate)
   (with-gensyms (testy result)
      (qq
         (let ((unq testy) (quote (unq predicate)) (unq result) (unq predicate))
            (if (unq result)
               true
               (error 'assertion-failed (unq testy) "Assertion failed."))))))

(proc ndx (n x)
   (when (or (< n 0) (< x 0))
      (error 'type-error %(ndx $n $x) "usage: (ndx n x) : n and x must be integers greater than zero."))
   (proc dx ()
      (+ 1 (rand x)))
   (loop go (m n total 0)
      (if m.zero?
         total
         (go m.dec (+ total (dx))))))

(proc repl (e in out err)
   (out.print "vaquero> ")
   (def input in.read)
   (when (isa? input 'EOF)
      (return "End Of Line."))
   (def result (e.eval input))
   (out.say result)
   (repl e in out err))

(proc parse (s)
   s.to-stream.read-seq)

(proc resend (msg)
   (lambda (obj)
      (send obj msg)))

(proc forward-to (obj)
   (lambda (msg)
      (send obj msg)))

(def json
   (let ()
      (def syms '(true false null))

      (proc json-in (txt)
         #(doc this parser is pretty good at accepting valid JSON.
               It is less good at rejecting invalid JSON.  Rough draft.)
         (proc read-num (p)
            p.read.to-number)
         (proc read-text (p)
            p.read)
         (proc read-symbol (p)
            p.read.to-symbol)
         (proc read-array (p)
            p.read-char ; discard opening [
            (loop go (next p.peek-char items ())
               (when (eof? next)
                  (error 'json-read-error items "Unexpected EOF in JSON array!"))
               (if next.whitespace?
                   (seq p.read-char (go p.peek-char items))
                   (case next
                      ("]")     (seq p.read-char items.reverse)
                      (",")     (seq p.read-char (go p.peek-char items))
                      else:
                         (let (item (reader p))
                             (go p.peek-char (items.cons item)))))))
         (proc read-object (p)
            p.read-char ; discard opening {
            (loop go (next p.peek-char items (table))
               (when (eof? next)
                  (error 'json-read-error items "Unexpected EOF in JSON object!"))
               (if next.whitespace?
                  (seq p.read-char (go p.peek-char items))
                  (case next
                     ("}")  (seq p.read-char items)
                     (",")  (seq p.read-char (go p.peek-char items))
                     else:
                        (let (key (send (reader p) 'to-symbol))
                           (p.skip-while " :\t\n")
                           (let (val (reader p))
                              (items.set! key val)
                              (go p.peek-char items)))))))
         (proc reader (p)
            (def next p.peek-char)
            (when (eof? next)
               (return next))
            (if next.whitespace?
               (seq
                  p.read-char
                  (reader p))
               (case next
                  ("\"")    (read-text p)
                  ("[")     (read-array p)
                  ("]")     (error 'json-read-error txt "Unexpected ] !")
                  ("{")     (read-object p)
                  ("}")     (error 'json-read-error txt "Unexpected } !")
                  ("-" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
                      (read-num p)
                  else:
                     (let (this-guy (read-symbol p))
                        (if (not (syms.has? this-guy))
                           (error 'json-read-error this-guy "Unquoted string!")
                           this-guy)))))
         (reader txt.to-stream))

         (proc json-out (thing)
            (proc comma-fy (xs)
               (cat.apply xs opt: (: with ",")))
            (cond
               (null? thing)   thing.to-text
               (bool? thing)   thing.to-text
               (num? thing)    thing.to-text
               (symbol? thing) (json-out thing.to-text)
               (text? thing)   (cat "\"" (thing.replace "\"" "\\\"" flags: "g") "\"")
               (vector? thing) (json-out thing.to-list)
               (table? thing) (cat "{" (comma-fy (list-map (lambda (kv) (cat (json-out kv.key.to-text) ":" (json-out kv.val))) thing.to-list)) "}")
               (list? thing)   (cat "[" (comma-fy (list-map json-out thing)) "]")
               (pair? thing)   (cat "[" (json-out thing.head) "," (json-out thing.tail) "]")
               else:
                  (if (thing.responds? 'to-json)
                     thing.to-json
                     (error 'json-write-error thing "json.write - unknown-type"))))

         (object
            'read json-in
            'write json-out
            'parse json-in
            'stringify json-out)))

(op promise (expr) ; lazy evaluation
   (def result (gensym))
   %(let ($result (cell null))
      (object
         auto: '(value)
         'type '(promise)
         'view  (lambda () (vector 'promise '$expr))
         'value (lambda ()
                   (if (is? (send $result (quote get)) null)
                      (seq
                         ((send $result (quote set!)) $expr)
                         (send $result (quote get)))
                      (send $result (quote get)))))))

(proc seal (obj)
   (def passed  (or opt.pass ()))
   (def hidden  (or opt.hide ()))
   (def secret  (or opt.secret null))
   (def type    '(sealed-object))

   (proc none-shall-pass (m)
       (not (hidden.has? m)))

   (def forward
      (if passed
         passed
         (if hidden
            (list-filter none-shall-pass obj.messages)
            ())))

   (proc unseal (xyzzy)
      (if (null? secret)
         (error 'ACCESS-DENIED sealed "ACCESS DENIED")
         (if (= xyzzy secret)
            obj
            (error 'ACCESS-DENIED sealed "ACCESS DENIED"))))

   (def sealed
      (object
         'type type
         'unseal unseal
         forward: %(($obj @forward))))

   sealed)

(op alias (name new-alias)
   %(op $new-alias ()
      %($'$name @rest)))

(alias lambda L)

(proc any? (f xs)
   (when (not (apply? f))
      (error 'bad-argument %(any? $f $xs @rest)
                           "any?: first argument must be a procedure."))
   (def ys xs.to-list)
   (loop go (z ys.head zs ys.tail)
      (if (f z)
         true
         (if (pair? zs)
            (go zs.head zs.tail)
            false))))

(proc every? (f xs)
   (when (not (apply? f))
      (error 'bad-argument %(every? $f $xs @rest) "every?: first argument must be a procedure."))
   (def ys xs.to-list)
   (loop go (z ys.head zs ys.tail)
      (if (f z)
         (if (pair? zs)
            (go zs.head zs.tail)
            true)
         false)))

(gen map
   (error
      'type-error
      %(map @rest)
      "map not defined for the supplied arguments."))

(spec map (lambda f list xs)
   (list-map f xs))

(spec map (lambda f list xs list ys)
   (proc get-heads (ls)
      (list-map (resend 'head) ls))
   (proc get-tails (ls)
      (list-map (resend 'tail) ls))
   (let (lists (append (list xs ys) rest))
      (loop go (heads (get-heads lists) tails (get-tails lists) results ())
         (def noo (pair (apply f heads) results))
         (if (every? identity tails)
            (go (get-heads tails) (get-tails tails) noo)
            noo.reverse))))

(proc vaquero-internal-get-vector-iterator (index?)
   (if index?
      (lambda (v n) (pair n (v.get n)))
      (lambda (v n) (v.get n))))

(spec map (lambda p vector v)
   (def sz v.size)
   (def noob (vector size: sz))
   (def iterator (vaquero-internal-get-vector-iterator opt.index))
   (loop go (n 0)
      (noob.set! n (p (iterator v n)))
      (if (= n sz.dec)
         noob
         (go n.inc))))

(spec map (lambda p vector u vector v)
   (def all (pair u (pair v rest)))
   (def sz (apply math.min (map (resend 'size) all)))
   (def noob (vector size: sz))
   (def iterator (vaquero-internal-get-vector-iterator opt.index))
   (loop go (n 0)
      (noob.set! n (apply p (map (lambda (v) (iterator v n)) all)))
      (if (= n sz.dec)
         noob
         (go n.inc))))

(spec map (lambda p table t)
   ; FIXME do something better. External iterators?
   (send (map p t.to-list) 'to-table))

(spec map (lambda p set s)
   ; FIXME do something better. External iterators?
   (send (map p s.to-list) 'to-set))

(gen fold
   (error
      'type-error
      %(fold @rest)
      "fold not defined for the supplied arguments."))

(spec fold (lambda f object init list xs)
   (list-fold f init xs))

(spec fold (lambda f object init list xs list ys)
   (when (not (apply? f))
      (error 'bad-argument %(fold $f $init $xs $ys @rest) "fold: first argument must be a procedure."))
   (def lists (pair xs (pair ys rest)))
   (proc fold-m (f init lists)
      (if (any? (resend 'empty?) lists)
         init
         (fold-m f
            (apply f (append (list-map (resend 'head) lists) (list init)))
            (list-map (resend 'tail) lists))))
   (fold-m f init lists))

(spec fold (lambda f object init vector v)
   (def sz v.size)
   (def noob (vector size: sz))
   (def iterator (vaquero-internal-get-vector-iterator opt.index))
   (loop go (n 0 acc init)
      (def new-acc (f (iterator v n) acc))
      (if (= n sz.dec)
         new-acc
         (go n.inc new-acc))))

(spec fold (lambda f object init vector u vector v)
   (def all (pair u (pair v rest)))
   (def sz (apply math.min (map (resend 'size) all)))
   (def iterator (vaquero-internal-get-vector-iterator opt.index))
   (loop go (n 0 acc init)
      (def prep (lambda (v) (iterator v n)))
      (def new-acc (apply f (append (map prep all) (list acc))))
      (if (= n sz.dec)
         new-acc
         (go n.inc new-acc))))

(spec fold (lambda f object init table t)
   ; FIXME do something better. External iterators?
   (fold f init t.to-list))

(spec fold (lambda f object init set s)
   ; FIXME do something better. External iterators?
   (fold f init s.to-list))

(gen filter
   (error
      'type-error
      %(filter @rest)
      "filter not defined for the supplied arguments."))

(spec filter (lambda f list xs)
   (list-filter f xs))

(spec filter (lambda f vector v)
   (def max v.size.dec)
   (loop go (n 0 stack ())
      (def val (v n))
      (def noo (if (f val) (pair val stack) stack))
      (if (= n max)
         (apply vector noo.reverse)
         (go n.inc noo))))

(spec filter (lambda f table t)
   (send (filter f t.to-list) 'to-table))

(spec filter (lambda f set s)
   (send (filter f s.to-list) 'to-set))

(gen sort
   (error
      'type-error
      %(sort @rest)
      "sort not defined for the supplied arguments."))

(spec sort (lambda f list xs)
   (list-sort f xs))

(spec sort (lambda f vector v)
   ; FIXME this is lame.  implement quicksort or something
   (send (list-sort f v.to-list) 'to-vector))


; (gen foldr ?
; (gen join
; (spec join (list xs)
; (spec join (vector v)
; (spec join (table t)
; (spec join (set s)

(proc zip (xs)
   (apply map %($list $xs @rest)))

(proc flatten (xs)
   (cond
      (= xs ()) ()
      (not (pair? xs)) (list xs)
      else: (append (flatten xs.head)
                       (flatten xs.tail))))

(op github (name sym)
   (def txt sym.to-text)
   (def xs (txt.split "/"))
   (def user xs.0)
   (def repo xs.1)
   (def module-path
      (cat (cat.apply (xs.drop 2) opt: (: with "/")) ".vaq"))
   (def uri (cat "https://raw.githubusercontent.com" user repo "master" module-path with: "/"))
   %(use $name $uri))

; reserving for future use

(def ! null)
(def ? null)
(def & null)
(def ~ null)
(def ^ null)

(def global env)