jasper.jpr

(assign slice (fun slice (xs start end)
		   (().slice.call xs start end)))

(assign list (fun list ('xs) xs))

(assign-mac mac (fun mac (name 'argsnbody)
		     (list 'assign-mac name ((list 'fun name).concat argsnbody))))

(mac def (name 'argsnbody)
  (list 'assign name ((list 'fun name).concat argsnbody)))

(def idfn (x) x)

(def cat ()
  (().concat.apply () arguments))

(def join (xs x)
  (().join.call xs x))

(def str ('xs)
  (join xs ""))

(def alist (x)
  (rawif x (is x.constructor Array)))

(def astr (x)
  (is (typeof x) 'string))

(def anumber (x)
  (is (typeof x) 'number))

(def afunction (x)
  (is (typeof x) 'function))

(def apply (f 'argsa argsb)
  (f.apply null (cat argsa argsb)))

(def apply-method (f o 'argsa argsb)
  (f.apply o (cat argsa argsb)))

(mac |[| ('body)
  (list 'fun "" (list '_) body))

(def map1 (f xs)
  (().map.call xs [f _]))

(def map (f 'xss)
  (if (is xss.length 1)
      (map1 f (get xss 0))
      (let length (apply Math.min (map1 [. _ length] xss))
	(let ys ()
	  (let i 0
	    (while (< i length)
	      (ys.push (apply f (map1 [get _ i] xss)))
	      (++ i)))
	  ys))))

(def sfy (x)
  (if (is x null)
      'null
      (is x undefined)
      'undefined
      (alist x)
      (str "(" (join (map sfy x) " ") ")")
      (str x)))

(def prn (a 'as)
  (apply-method console.log console (sfy a) (map sfy as))
  a)

(def mapcat (f 'xss)
  (apply cat (apply map f xss)))

(def quote (a)
  (JSON.stringify a))

(def catmac (xs)
  (if (xs.every [and (alist _) (is (get _ 0) 'list)])
      (cat '(list) (mapcat (fun || ((_ 'ys))
			     ys)
			   xs))
      (cat '(cat) xs)))

(def runqq (a)
  (if (alist a)
      (if (is (get a 0) ',@)
	  (get a 1)
	  (is (get a 0) ',)
	  (list 'list (get a 1))
	  (list 'list (catmac (map runqq a))))
      (cat '(list) (quote a))))

(mac ` (a)
  (let xs (runqq a)
    (if (and (alist xs) (is (get xs 0) 'list))
	(get xs 1)
	(list 'get xs 0))))

(mac fn (args 'body)
  `(fun || ,args ,@body))

(mac when (cond 'body)
  `(if ,cond (do ,@body)))

(mac land ('xs)
  (if (is xs.length 0)
       true
       (is xs.length 1)
       (get xs 0)
       `(if ,(get xs 0)
	     (land ,@(slice xs 1)))))

(def subsname (name sub code)
  (if (alist code)
      (if (is (get code 0) '.)
	  `(. ,(subsname name sub (get code 1)) ,@(slice code 2))
	  (map (fn (x) (subsname name sub x)) code))
      (is code name)
      sub
      code))

(def first ((a _)) a)
(def second ((_ a)) a)

(mac with (bindings 'body)
  (if (is bindings.length 0)
      `(do ,@body)
      `(let ,(first bindings) ,(second bindings)
	 (with ,(slice bindings 2)
	   ,@body))))

(mac aif (expr then else)
  `(let it ,expr
     (if it ,then ,else)))

(mac laif (expr then else)
  `(let it ,expr
     (if it ,then ,else)))

(mac afn (args 'body)
  `(fun self ,args ,@body))

(mac awhile (cond 'body)
  `(let it undefined
     (while (= it ,cond)
       ,@body)))

(def listify (x)
  (if (alist x)
      x
      (list x)))

(mac w/uniq (names 'body)
  `(with ,(mapcat [list _ `(gensym ',_)]
		  (listify names))
	 ,@body))

(mac zap (f place 'args)
  `(= ,place (,f ,place ,@args)))

(def pair (xs)
  (with (ys ()
	 i 0)
    (while (< i xs.length)
      (if (< (+ i 1) xs.length)
	  (ys.push (list (get xs i) (get xs (+ i 1))))
	  (ys.push (list (get xs i))))
      (zap + i 2))
    ys))

(mac case (expr 'args)
  (w/uniq g
    `(let ,g ,expr
       (if ,@(mapcat [if (is _.length 2)
			 `((is ,g ',(get _ 0))
			   ,(get _ 1))
			 _]
		     (pair args))))))

(mac dbg ('xs)
  (w/uniq g
    `(let ,g ,xs
       (prn ',xs ":" ,g)
       ,g)))

(mac lor ('xs)
  (if xs
       (w/uniq g
	 `(let ,g ,(get xs 0)
	    (if ,g ,g (lor ,@(slice xs 1)))))))

(mac do1 (x 'xs)
  (w/uniq g
    `(let ,g ,x
       ,@xs
       ,g)))

(def list2obj (args)
  (let res (Object.create null)
    (map (fn ((k v)) (= (get res k) v))
	 args)
    res))

(mac obj ('args)
  `(list2obj (list ,@(map (fn ((k v))
                            `(list ',k ,v))
                          (pair args)))))

(mac each-from-while (starti iv xs cond 'body)
  (with (i null v null gxs (gensym xs))
    (if (alist iv)
	(do
	  (= i (first iv))
	  (= v (second iv)))
	(do
	  (= i (gensym i))
	  (= v iv)))
    `(with (,i ,starti
	    ,gxs ,xs)
       ,(subsname v `(get ,gxs ,i)
		  `(while (and (< ,i (, gxs).length) ,cond)
		     ,@body
		     (++ ,i)))
       ,i)))

(mac each-while (iv xs cond 'body)
  `(each-from-while 0 ,iv ,xs ,cond ,@body))

(mac each (iv xs 'body)
  `(each-while ,iv ,xs true ,@body))

(def testify (test)
  (if (afunction test)
      test
      [is test _]))

(mac no (x)
  `(if ,x
	false
	true))

(def index-by (test xs)
  (with (f (testify test)
	 index false)
    (each-while (i v) xs (no index)
      (if (f v)
	   (= index i)))
    index))

(def find (test xs)
  (laif (index-by test xs)
	(get xs it)))

(def split-by (f xs)
  (let i (index-by f xs)
    (if (is i false)
	(list xs ())
	(list (slice xs 0 i) (slice xs i)))))

(def some (test xs)
  (with (f (testify test)
	 res false)
    (each-while x xs (no res)
      (laif (f x)
	    (= res it)))
    res))

(def all (test xs)
  (let f (testify test)
    (! (some [! (f _)] xs))))

(def iso (x y)
  (or (is x y)
      (and (alist x) (alist y) (is x.length y.length)
	   (all true (map iso x y)))))

(mac callback (to from 'body)
  `(,@to (fn ,from ,@body)))