(
  (globals . (
    (mac . [define mac
  (litmac litfn () ((m . params) . body)
    `(define ,m
       (litmac litfn () ,params ,@body)))])
    (def . [mac (def (name . params) . body)
  `(define ,name (fn ,params ,@body))])
    (do . [mac (do . body)
  `((fn () ,@body))])
    (let . [mac (let var val . body)
  `((fn (,var) ,@body) ,val)])
    (when . [mac (when cond . body)
  `(if ,cond (do ,@body) ())])
    (iflet . [mac (iflet var expr then else)
  `(let ,var ,expr
     (if ,var ,then ,else))])
    (aif . [mac (aif expr then else)
  `(iflet it ,expr ,then ,else)])
    (forever . [mac (forever . body)
  `(while 1 ,@body)])
    (list . [def (list . args)
  # we should probably make a copy here
  args])
    (ret . [mac (ret var val . body)
  `(let ,var ,val ,@body ,var)])
    (nth . [def (nth n xs)
  if (n < 1)
    (car xs)
    (nth n-1 (cdr xs))])
    (map1 . [def (map1 f xs)
  if (no xs)
    ()
    (cons (f (car xs))
          (map1 f (cdr xs)))])
    (compose . [def (compose f g)
  (fn args
    (f (apply g args)))])
    (caar . [define caar (compose car car)])
    (cadr . [define cadr (compose car cdr)])
    (cddr . [define cddr (compose cdr cdr)])
    (cdar . [define cdar (compose cdr car)])
    (val . [define val cadr])
    (some . [def (some f xs)
  if (no xs)
    ()
    if (f (car xs))
      xs
      (some f (cdr xs))])
    (any . [define any some])
    (all . [def (all f xs)
  if (no xs)
    1
    if (f (car xs))
      (all f (cdr xs))
      ()])
    (find . [def (find x xs)
  if (no xs)
    ()
    if (x = (car xs))
      1
      (find x (cdr xs))])
    (pair . [def (pair xs)
  if (no xs)
    ()
    if (no (cdr xs))
      (list (list (car xs)))
      (cons (list (car xs) (cadr xs))
            (pair (cddr xs)))])
    (with . [mac (with bindings . body)
  `((fn ,(map1 car (pair bindings))
      ,@body)
    ,@(map1 cadr (pair bindings)))])
    (afn . [mac (afn params . body)
  `(let self ()
     (set self (fn ,params ,@body)))])
    (seq . [def (seq n)
  ((afn (i)
     (if (i > n)
       ()
       (cons i (self i+1))))
   1)])
    (each . [mac (each x xs . body)
  `(walk ,xs (fn (,x) ,@body))])
    (walk . [def (walk xs f)
  when xs
    (f (car xs))
    (walk (cdr xs) f)])
    (rem . [def (rem f xs)
  if (no xs)
    ()
    let rest (rem f (cdr xs))
      if (f (car xs))
        rest
        (cons (car xs) rest)])
    (keep . [def (keep f xs)
  if (no xs)
    ()
    let rest (keep f (cdr xs))
      if (f (car xs))
        (cons (car xs) rest)
        rest])
    (alist? . [def (alist? x)
  (and (cons? x)
       (cons? (car x)))])
    (assoc . [def (assoc alist key)
  if (no alist)
    ()
    if (key = (caar alist))
      (car alist)
      (assoc (cdr alist) key)])
    (get . [def (get alist key)
  aif (assoc alist key)
    (cdr it)
    ()])
    (+= . [mac (var += inc)
  `(set ,var (,var + ,inc))])
    (++ . [mac (++ var)
  `(+= ,var 1)])
    (for . [mac (for var init test update . body)
  `(let ,var ,init
     (while ,test
       ,@body
       ,update))])
    (repeat . [# Ideally we shouldn't have to provide
# var.
# But then nested repeats won't work
# until we use gensyms.
# And shell doesn't currently support
# gensyms.
# By exposing var to caller, it becomes
# caller's responsibility to use unique
# vars for each invocation of repeat.
mac (repeat var n . body)
  `(for ,var 0 (,var < ,n) (++ ,var)
     ,@body)])
    (grid . [def (grid m n val)
  ret g (populate n ())
    for i 0 (< i n) ++i
      iset g i (populate m val)])
    (indexgrid . [def (indexgrid g x y)
  (index (index g y) x)])
    (isetgrid . [def (isetgrid g x y val)
  iset (index g y) x val])
    (hborder . [def (hborder scr y color)
  (hline scr y 0 (width scr) color)])
    (vborder . [def (vborder scr x color)
  (vline scr x 0 (height scr) color)])
    (read_line . [def (read_line keyboard)
  ret str (stream)
    let c (key keyboard)
      while (not (or (c = 0) (c = 10)))
        (write str c)
        (set c (key keyboard))])
    (wait . [def (wait keyboard)
  while (= 0 (key keyboard))
    ()])
    (sq . [def (sq n) (n * n)])
    (cube . [def (cube n) (n * n * n)])
    (fill_rect . [def (fill_rect screen x1 y1 x2 y2 color)
  for y y1 (y < y2) ++y
    (hline screen y x1 x2 color)])
    (ring . [def (ring screen cx cy r0 w clr)
  for r r0 (r < r0+w) ++r
    (circle screen cx cy r clr)])
    (Greys . [define Greys
  ret p (populate 16 ())
    for i 0 (< i 16) ++i
      iset p i i+16])
    (Pinks . [define Pinks (array
                84 85 59 60 61
                13 36 37 5 108)])
    (palette . [def (palette p i)
  (index p (i % (len p)))])
    (pat . [def (pat screen)
  with (w (width screen)
        h (height screen))
    for y 0 (y < h) ++y
      for x 0 (x < w) ++x
        (pixel screen x y (palette Greys x*y))])
    (main . [def (main screen keyboard)
  (life screen)])
    (liferes . [define liferes 8])
    (life . [def (life screen)
  with (w (/ (width screen) liferes)
        h (/ (height screen) liferes))
    with (g1 (grid w h 0)
          g2 (grid w h 0))
      isetgrid g1 w/2 h/2-1 1
      isetgrid g1 w/2+1 h/2-1 1
      isetgrid g1 w/2-1 h/2 1
      isetgrid g1 w/2 h/2 1
      isetgrid g1 w/2 h/2+1 1
      renderlife screen g1
      while 1
        steplife g1 g2 screen
        renderlife screen g2
        steplife g2 g1 screen
        renderlife screen g1])
    (steplife . [def (steplife old new screen)
  ++lifetime
  with (h (len old)
        w (len (index old 0)))
    for x 0 (< x w) ++x
      for y 0 (< y h) ++y
        fill_rect screen x*liferes y*liferes x+1*liferes y+1*liferes 0
        with (curr (indexgrid old x y)
              n (neighbors old x y w h)
             )
          isetgrid new x y (if (= n 2)
                             curr
                             (if (= n 3)
                               1
                               0))])
    (renderlife . [def (renderlife screen g)
  with (w (width screen)
        h (height screen))
    for y 0 (< y h) y+=liferes
      for x 0 (< x w) x+=liferes
        (fill_rect screen x y x+liferes y+liferes 
          (if (0 = (indexgrid g x/liferes y/liferes))
            3
#            (1 + lifetime%15)
            0))])
    (neighbors . [def (neighbors g x y w h)
  ret result 0
    when (y > 0)
      when (x > 0)
        result += (indexgrid g x-1 y-1)
      result += (indexgrid g x y-1)
      when (x < w-1)
        result += (indexgrid g x+1 y-1)
    when (x > 0)
      result += (indexgrid g x-1 y)
    when (x < w-1)
      result += (indexgrid g x+1 y)
    when (y < h-1)
      when (x > 0)
        result += (indexgrid g x-1 y+1)
      result += (indexgrid g x y+1)
      when (x < w-1)
        result += (indexgrid g x+1 y+1)])
    (lifetime . [define lifetime 0])
  ))
  (sandbox . [life screen])
)