nydp 0.0.10 → 0.0.10.1

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: 878f0dba9573b146bf3bf438d5c8d7792f9fc1e9
-  data.tar.gz: 57c14a21f93ec56968f9f4e3bae5ee634eac9608
+  metadata.gz: ebb185874a9dc692fc52b40620ef19385b49d644
+  data.tar.gz: 6e63e8ffcf047ee20894abde0b0bb9ed497ba6ca
 SHA512:
-  metadata.gz: 2f8fa342fe36104a3d957bb3bd354b79f185948fc9779abd7c146dbe092065a29ad31cb4193ae8a8aeded94b4a4671c3075d05e9a112404dde554dbbe1887290
-  data.tar.gz: 6999b8761df3c3d19909d0341d208b08fb9793e926066838ab99329c6b87fece28dd085e56ba82970e96ebbd10a439137ce76b12f6513c853fd83f09eb7dbbff
+  metadata.gz: a80c411a9b87d57de98530cb1729b4b10e9b406b09ca6a21a1fb7d0b40afa5323e9a2b545aa202faab76332b3eff0c32297677c3816f26a46e4715ef419ca1db
+  data.tar.gz: ddc4305e8078bfb08e78b1b9c8891788d5501a3c085ba03a970ca6d59408deea2c6984f04d8d6579daa9e44596da1001dceee45af95f03d3b0a4c5a9e2b1e21f

data/.gitignore

@@ -15,5 +15,5 @@ spec/reports
 test/tmp
 test/version_tmp
 tmp
-lib/lisp/scratch.nydp
+lib/lisp/scratch
 .#*

data/lib/lisp/core-00.nydp

@@ -0,0 +1,13 @@
+; -*- lisp -*-
+;;
+;; Acknowledgements to Paul Graham. Some nydp features (including,
+;; but not limited to, 'do, 'rfn, 'loop, 'for) are stolen directly from arc.arc
+;;
+
+(assign list  (fn args args))
+(assign caar  (fn (arg) (car (car arg))))
+(assign cadr  (fn (arg) (car (cdr arg))))
+(assign cdar  (fn (arg) (cdr (car arg))))
+(assign cddr  (fn (arg) (cdr (cdr arg))))
+(assign   no  (fn (arg) (cond arg nil t)))
+(assign just  (fn (arg) arg))

data/lib/lisp/core-01-precompile.nydp

@@ -0,0 +1,130 @@
+
+
+(assign mac-expand (fn (macfn name body)
+  (cond macfn
+        (pre-compile (apply macfn body))
+        (cons name body))))
+
+(assign macs (hash))
+
+(assign pre-compile-expr
+        (fn (name body)
+            (mac-expand (hash-get macs name) name body)))
+
+(assign pre-compile-each
+        (fn (args)
+            (cond args
+                  (cond (pair? args)
+                        (cons (pre-compile (car args))
+                              (pre-compile-each (cdr args)))
+                        args))))
+
+(assign pre-compile-msg
+        (fn (src compiled)
+            (pre-compile-msg "pre-compile" src "\n  -> " compiled)
+            compiled))
+
+(assign pre-compile-raw
+        (fn (arg)
+            (cond (pair? arg)
+                  (cond (eq? (car arg) 'quote)
+                        arg
+                        (pre-compile-each (pre-compile-expr (car arg) (cdr arg))))
+                  arg)))
+
+(assign pre-compile-debug
+        (fn (arg)
+            (pre-compile-msg arg (pre-compile-raw arg))))
+
+(assign debug-pre-compile
+        (fn (arg)
+            (assign pre-compile (cond arg pre-compile-debug pre-compile-raw))))
+
+(debug-pre-compile nil)
+
+(hash-set macs 'def
+          (fn (name args . body)
+              (list 'assign
+                    name
+                    (+ (list 'fn args)
+                       body))))
+
+(def qq-handle-unquote-splicing (arg rest level)
+     (cond (eq? level 0)
+           (qq-do-unquote-splicing arg rest level)
+           (qq-skip-unquote-splicing arg rest level)))
+
+(def qq-do-unquote-splicing (arg rest level)
+     (cond (no rest)
+           arg
+           (list '+
+                 (pre-compile arg)
+                 (qq-quasiquote rest level))))
+
+(def qq-skip-unquote-splicing (arg rest level)
+     (list 'cons
+           (list 'list ''unquote-splicing (qq-quasiquote arg (- level 1)))
+           (qq-quasiquote rest level)))
+
+(def qq-handle-quasiquote (arg rest level)
+     (list 'cons
+           (list 'list ''quasiquote (qq-quasiquote arg (+ level 1)))
+           (qq-quasiquote rest level)))
+
+(def qq-handle-unquote (arg rest level)
+     (list 'cons
+           (qq-maybe-unquote arg level)
+           (qq-quasiquote rest level)))
+
+(def qq-unquote-recurse (arg rest level)
+        (list 'cons
+              (qq-quasiquote arg level)
+              (qq-quasiquote rest level)))
+
+(def qq-handle-plain (arg rest level)
+     (list 'cons
+           (list 'quote arg)
+           (qq-quasiquote rest level)))
+
+(def qq-unquote? (arg rest level)
+     (cond (pair? arg)
+           (cond (eq? (car arg) 'unquote)
+                 (qq-handle-unquote (cadr arg) rest level)
+                 (cond (eq? (car arg) 'unquote-splicing)
+                       (qq-handle-unquote-splicing (cadr arg) rest level)
+                       (cond (eq? (car arg) 'quasiquote)
+                             (qq-handle-quasiquote (cadr arg) rest level)
+                             (qq-unquote-recurse arg rest level))))
+           (qq-handle-plain arg rest level)))
+
+(def qq-maybe-unquote (xs level)
+     (cond (eq? level 0)
+           (pre-compile xs)
+           (list 'list ''unquote (qq-quasiquote xs (- level 1)))))
+
+(def qq-quasiquote (xs level)
+            (cond (no xs)
+                  nil
+                  (cond (pair? xs)
+                        (cond (eq? (car xs) 'unquote)
+                              (qq-maybe-unquote (cadr xs) level)
+                              (cond (eq? (car xs) 'unquote-splicing)
+                                    (qq-handle-unquote-splicing (cadr xs) nil level)
+                                    (cond (eq? (car xs) 'quasiquote)
+                                          (list 'list ''quasiquote (qq-quasiquote (cdr xs) (+ level 1)))
+                                          (qq-unquote? (car xs) (cdr xs) level))))
+                        (list 'quote xs))))
+
+(hash-set macs 'quasiquote
+          (fn (arg) (qq-quasiquote arg 0)))
+
+(hash-set macs 'mac (fn (name args . body)
+  `(hash-set macs ',name (fn ,args ,@body))))
+
+(mac if args
+     (cond (no args) nil
+           (cond (cdr args)
+                 (cond (cddr args)
+                       `(cond ,(car args) ,(cadr args) (if ,@(cddr args)))
+                       `(cond ,(car args) ,(cadr args)))
+                 (car args))))

data/lib/lisp/core-02-utils.nydp

@@ -0,0 +1,8 @@
+; -*- lisp -*-
+
+(def map (f things)
+  (if (no things)
+      nil
+    (pair? things)
+    (cons (f (car things)) (map f (cdr things)))
+    (map f (list things))))

data/lib/lisp/core-03-syntax.nydp

@@ -0,0 +1,148 @@
+; -*- lisp -*-
+
+(mac unless (arg . body)
+  `(if (no ,arg) (do ,@body)))
+
+(def expand-colon-syntax (first rest)
+     (if (no rest)
+         `(apply ,first args)
+         `(,first ,(expand-colon-syntax (car rest) (cdr rest)))))
+
+(mac colon-syntax args
+  (if (eq? (car args) '||)
+      (error "Irregular ': syntax: got ~(inspect args) : not prefix-syntax : in ~(joinstr ":" (cons pfx rest))")
+      `(fn args ,(expand-colon-syntax (car args) (cdr args)))))
+
+(mac bang-syntax (pfx . rest)
+  (if (no (eq? pfx '||))
+      (error "Irregular '! syntax: got prefix ~(inspect pfx) in ~(joinstr "!" (cons pfx rest))"))
+  (if (cdr rest)
+      (error "Irregular '! syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "!" (cons pfx rest))")
+      (if (caris 'colon-syntax (car rest))
+          `(colon-syntax no ,@(cdar rest))
+          `(colon-syntax no ,(car rest)))))
+
+(mac and args
+  (if args
+      (if (cdr args)
+          `(if ,(car args) (and ,@(cdr args)))
+          (car args))
+      't))
+
+(mac do args
+  `((fn nil ,@args)))
+
+(mac when (condition . body)
+  `(cond ,condition (do ,@body)))
+
+(def pairs (things)
+     (if (no things)       nil
+       (no (cdr things)) (list (list (car things)))
+       (cons (list (car things) (cadr things))
+             (pairs (cddr things)))))
+
+(mac with (parms . body)
+     `((fn ,(map car (pairs parms))
+           ,@body)
+       ,@(map cadr (pairs parms))))
+
+(mac let (var val . body)
+     `(with (,var ,val) ,@body))
+
+(let uniq-counter 0
+     (def uniq (prefix)
+          (sym (joinstr "-"
+                        (list prefix
+                              (assign uniq-counter
+                                      (+ uniq-counter 1))))))
+     (def reset-uniq-counter ()
+          (assign uniq-counter 0)))
+
+(mac w/uniq (vars . body)
+     (if (pair? vars)
+         `(with ,(apply + (map (fn (n) (list n '(uniq ',n))) vars))
+                ,@body)
+       `(let ,vars (uniq ',vars) ,@body)))
+
+(mac or args
+     (cond args
+           (w/uniq ora
+                   `(let ,ora ,(car args)
+                         (cond ,ora ,ora (or ,@(cdr args)))))))
+
+(mac pop (xs)
+     (w/uniq gp
+             `(let ,gp (car ,xs)
+                   (assign ,xs (cdr ,xs))
+                   ,gp)))
+
+(def build-keyword-args (pairs)
+  (map (fn (ab) `(list (quote ,(car ab)) ,@(cdr ab))) pairs))
+
+(def build-hash-get-key (name)
+  (if (pair? name)
+      (if (caris 'unquote name)
+          (cadr name)
+          name)
+      (list 'quote name)))
+
+;; (build-hash-getters '(a b c))
+;; => (hash-get (hash-get a 'b) 'c)
+(def build-hash-getters (names acc)
+  (if (no acc)
+      (build-hash-getters (cdr names) (car names))
+      names
+      (build-hash-getters (cdr names) `(hash-get ,acc ,(build-hash-get-key (car names))))
+      acc))
+
+(def build-hash-lookup-from (root names)
+  (build-hash-getters (cons root names) nil))
+
+(mac hash-lookup (names)
+  (build-hash-getters names nil))
+
+(mac dot-syntax names `(hash-lookup ,names))
+(mac dollar-syntax (_ name) `(,name))
+
+(def dot-syntax-assignment (names value-expr)
+  (let rnames (rev names)
+    `(hash-set ,(build-hash-getters (rev (cdr rnames)) nil)
+               ,(build-hash-get-key:car rnames)
+               ,value-expr)))
+
+(mac = (name value)
+  (if (isa 'symbol name)
+      `(assign ,name ,value)
+      (caris 'dot-syntax name)
+      (dot-syntax-assignment (cdr name) value)))
+
+(def brace-list-hash-key (k)
+  (if (isa 'symbol k)      `(quote ,k)
+      (caris 'unquote k)   (cadr k)
+      k))
+
+(def brace-list-build-hash (args)
+  (w/uniq hash
+    (let mappings (pairs args)
+      `(let ,hash (hash)
+            ,@(map (fn (m) `(hash-set ,hash ,(brace-list-hash-key (car m)) ,(cadr m))) mappings)
+            ,hash))))
+
+(def build-ampersand-syntax (arg)
+  (if (caris 'dot-syntax arg)
+      `(fn (obj) ,(build-hash-lookup-from 'obj (cdr arg)))
+      `(fn (obj) ,(build-hash-lookup-from 'obj (list arg)))))
+
+(mac ampersand-syntax (pfx . rest)
+  (if (no (eq? pfx '||))
+      (error "Irregular '& syntax: got prefix ~(inspect pfx) in ~(joinstr "&" (cons pfx rest))"))
+  (if (cdr rest)
+      (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "&" (cons pfx rest))")
+      (build-ampersand-syntax (car rest))))
+
+(mac brace-list-mono (arg) arg)
+
+(mac brace-list args
+  (if (no (cdr args))
+      `(brace-list-mono ,(car args))
+      (brace-list-build-hash args)))

data/lib/lisp/core-04-utils.nydp

@@ -0,0 +1,122 @@
+; -*- lisp -*-
+
+(def each (f acc things)
+  (if things
+      (each f (f acc (car things)) (cdr things))
+      acc))
+
+(def eachr (f things)
+     (when things
+       (eachr f (cdr things))
+       (f (car things))))
+
+(def zip (a b)
+  (if a
+      (cons (list (car a) (car b))
+            (zip (cdr a) (cdr b)))))
+
+(def reversify (things acc)
+  (if (no things)
+      acc
+      (reversify (cdr things)
+                 (cons (car things) acc))))
+
+(def rev (things) (reversify things nil))
+
+(mac push (x things)
+  `(assign ,things (cons ,x ,things)))
+
+(def flatten (things)
+     (let acc nil
+          (let flattenize nil
+               (assign flattenize (fn (x)
+                                      (if (pair? x)
+                                          (eachr flattenize x)
+                                        (push x acc))))
+               (flattenize things))
+          acc))
+
+(def joinstr (txt . things)
+     (let joinables (flatten things)
+       (apply +
+              (to-string (car joinables))
+              (flatten (zip (map (fn (_) txt) (cdr joinables))
+                            (map to-string (cdr joinables)))))))
+
+(def string-pieces pieces
+  (joinstr "" pieces))
+
+(def nth (n things)
+     (if (eq? n 0)
+         (car things)
+       (nth (- n 1) (cdr things))))
+
+(def iso (x y)
+     (or (eq? x y)
+         (and (pair? x)
+              (pair? y)
+              (iso (car x) (car y))
+              (iso (cdr x) (cdr y)))))
+
+(def isa     (type obj) (eq? (type-of obj) type))
+(def sym?    (arg)      (isa 'symbol arg))
+(def string? (arg)      (isa 'string arg))
+(mac just    (arg)      arg)
+(def quotify (arg)      `(quote ,arg))
+
+(def caris (obj things)
+     (and (isa 'pair things)
+          (eq? (car things)  obj)))
+
+(def len (xs)
+  (if (pair? xs)   (+ 1 (len (cdr xs)))
+      (string? xs) (string-length xs)
+      0))
+
+(assign dynamics (hash))
+
+(mac dynamic (name)
+  (hash-set dynamics name t)
+  (let with-mac-name (sym "w/~name")
+    (w/uniq prev
+      `(do
+        (mac ,with-mac-name (new-value . body)
+             (w/uniq result
+                     `(let ,',prev (hash-get (thread-locals) ',',name)
+                           (hash-set (thread-locals) ',',name ,new-value)
+                           (let ,result (do ,@body)
+                             (hash-set (thread-locals) ',',name ,',prev)
+                             ,result))))
+           (def ,name () (hash-get (thread-locals) ',name))))))
+
+(mac on-err (handler . body)
+  `(handle-error (fn (err) ,handler)
+                 (fn ()    ,@body)))
+
+(mac ensure (protection . body)
+  `(ensuring (fn () ,protection)
+             (fn ()    ,@body)))
+
+(mac rfn (name parms . body)
+  `(let ,name nil
+     (assign ,name (fn ,parms ,@body))))
+
+(mac afn (parms . body)
+  `(rfn self ,parms ,@body))
+
+(mac loop (start test update . body)
+  (w/uniq (gfn gparm)
+    `(do ,start
+         ((rfn ,gfn (,gparm)
+            (if ,gparm
+                (do ,@body ,update (,gfn ,test))))
+          ,test))))
+
+(mac for (v init max . body)
+  (w/uniq (gi gm)
+    `(with (,v nil ,gi ,init ,gm (+ ,max 1))
+       (loop (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1))
+         ,@body))))
+
+(mac mapx (things x expr)
+  `(map (fn (,x) ,expr) ,things))

data/lib/lisp/tests/foundation-test.nydp

@@ -106,7 +106,18 @@
 
     ("recursive hash assignment with embedded dollar-syntax"
      (pre-compile '(= a.$b.,c.d 42))
-     (hash-set (hash-get (hash-get a (b)) c) 'd 42)))
+     (hash-set (hash-get (hash-get a (b)) c) 'd 42))
+
+    (suite "merge"
+      ("merge with symbol keys"
+       (let h (hash-merge { a 1 b 2 c 3 } { a 99 c 98 d 97 })
+            (list h.a h.b h.c h.d (hash-keys h) ))
+       (99 2 98 97 (a b c d )))
+
+      ("merge with mixed symbol and string and int keys"
+       (let h (hash-merge { a 1 "b" 2 3 'c } { a 99 b 98 3 "foo" })
+            (cons (hash-keys h) (mapx (hash-keys h) k h.,k)))
+       ((a "b" 3 b) 99 2 "foo" 98))))
 
   (suite "isa"
     ("t for 'pair for list"

data/lib/nydp/builtin/hash.rb

@@ -54,3 +54,14 @@ class Nydp::Builtin::HashKeys
     end
   end
 end
+
+class Nydp::Builtin::HashMerge
+  include Nydp::Helper, Nydp::Builtin::Base
+
+  def builtin_invoke vm, args
+    hash_0 = args.car
+    hash_1 = args.cdr.car
+
+    vm.push_arg hash_0.merge hash_1
+  end
+end

data/lib/nydp/core.rb

@@ -13,9 +13,7 @@ module Nydp
     end
 
     def loadfiles
-      b = relative_path('../lisp/boot.nydp')
-      t = relative_path('../lisp/test-runner.nydp')
-      [b,t]
+      Dir.glob(relative_path '../lisp/core-*.nydp').sort
     end
 
     def testfiles
@@ -64,6 +62,7 @@ module Nydp
       Symbol.mk(:"hash-get",    ns).assign(Nydp::Builtin::HashGet.new ns)
       Symbol.mk(:"hash-set",    ns).assign(Nydp::Builtin::HashSet.new)
       Symbol.mk(:"hash-keys",   ns).assign(Nydp::Builtin::HashKeys.new(ns))
+      Symbol.mk(:"hash-merge",  ns).assign(Nydp::Builtin::HashMerge.new)
       Symbol.mk(:"vm-info",     ns).assign Nydp::Builtin::VmInfo.new
       Symbol.mk(:"pre-compile", ns).assign Nydp::Builtin::PreCompile.new
     end

data/lib/nydp/version.rb

@@ -1,3 +1,3 @@
 module Nydp
-  VERSION = "0.0.10"
+  VERSION = "0.0.10.1"
 end

data/spec/hash_spec.rb

@@ -30,6 +30,19 @@ describe Nydp::Hash do
     end
   end
 
+  describe "hash merge" do
+    it "merges two hashes" do
+      ns = { }
+      Nydp.setup(ns)
+      hash_0 = { foo: 12, bar: 34}
+      hash_1 = { foo: 49, zap: 87}
+
+      merged = Nydp.apply_function ns, "hash-merge", hash_0, hash_1
+
+      expect(merged).to eq({ foo: 49, bar: 34, zap: 87 })
+    end
+  end
+
   describe "nydp hashes" do
     describe "new hash" do
       it "returns a new Nydp hash" do

metadata

@@ -1,14 +1,14 @@
 --- !ruby/object:Gem::Specification
 name: nydp
 version: !ruby/object:Gem::Version
-  version: 0.0.10
+  version: 0.0.10.1
 platform: ruby
 authors:
 - Conan Dalton
 autorequire: 
 bindir: bin
 cert_chain: []
-date: 2015-07-24 00:00:00.000000000 Z
+date: 2015-07-25 00:00:00.000000000 Z
 dependencies:
 - !ruby/object:Gem::Dependency
   name: bundler
@@ -84,9 +84,12 @@ files:
 - Rakefile
 - bin/nydp
 - bin/nydp-tests
-- lib/lisp/bm.nydp
-- lib/lisp/boot.nydp
-- lib/lisp/test-runner.nydp
+- lib/lisp/core-00.nydp
+- lib/lisp/core-01-precompile.nydp
+- lib/lisp/core-02-utils.nydp
+- lib/lisp/core-03-syntax.nydp
+- lib/lisp/core-04-utils.nydp
+- lib/lisp/core-05-test-runner.nydp
 - lib/lisp/tests/boot-tests.nydp
 - lib/lisp/tests/dynamic-scope-test.nydp
 - lib/lisp/tests/error-tests.nydp

data/lib/lisp/bm.nydp

@@ -1,18 +0,0 @@
-(def bm-pythag ()
-  (for i 1 100
-    (for j 1 100
-      (sqrt (+ (* i i) (* j j))))))
-
-(def bmf (f n)
-  (for b 1 n (f)))
-
-(def bm (f n)
-  (let time (millisecs)
-    (bmf f n)
-    (let elapsed (- (millisecs) time)
-      (p "took: ~elapsed ms")
-      (p "~n iterations, ~(/ elapsed n) ms per iteration")))
-  nil)
-
-(def rbs ()
-  (bm bm-pythag 20))

data/lib/lisp/boot.nydp

@@ -1,429 +0,0 @@
-; -*- lisp -*-
-
-;;
-;; Acknowledgements to Paul Graham. Some nydp features defined in this file (including,
-;; but not limited to, 'do, 'rfn, 'loop, 'for) are stolen directly from arc.arc
-;;
-
-(assign last-cons (fn (xs)
-                      (cond (pair? (cdr xs))
-                            (last-cons (cdr xs))
-                            xs)))
-
-
-(assign append-list (fn (list-1 list-2)
-                         (cdr-set (last-cons list-1) list-2)
-                         list-1))
-
-(assign list  (fn args args))
-(assign last  (fn (arg) (car (last-cons arg))))
-(assign caar  (fn (arg) (car (car arg))))
-(assign cadr  (fn (arg) (car (cdr arg))))
-(assign cdar  (fn (arg) (cdr (car arg))))
-(assign cddr  (fn (arg) (cdr (cdr arg))))
-(assign   no  (fn (arg) (cond arg nil t)))
-(assign just  (fn (arg) arg))
-
-(assign mac-expand (fn (macfn name body)
-  (cond macfn
-        (pre-compile (apply macfn body))
-        (cons name body))))
-
-(assign macs (hash))
-
-(assign pre-compile-expr
-        (fn (name body)
-            (mac-expand (hash-get macs name) name body)))
-
-(assign pre-compile-each
-        (fn (args)
-            (cond args
-                  (cond (pair? args)
-                        (cons (pre-compile (car args))
-                              (pre-compile-each (cdr args)))
-                        args))))
-
-(assign pre-compile-msg
-        (fn (src compiled)
-            (pre-compile-msg "pre-compile" src "\n  -> " compiled)
-            compiled))
-
-(assign pre-compile-raw
-        (fn (arg)
-            (cond (pair? arg)
-                  (cond (eq? (car arg) 'quote)
-                        arg
-                        (pre-compile-each (pre-compile-expr (car arg) (cdr arg))))
-                  arg)))
-
-(assign pre-compile-debug
-        (fn (arg)
-            (pre-compile-msg arg (pre-compile-raw arg))))
-
-(assign debug-pre-compile
-        (fn (arg)
-            (assign pre-compile (cond arg pre-compile-debug pre-compile-raw))))
-
-(debug-pre-compile nil)
-
-(hash-set macs 'def
-          (fn (name args . body)
-              (list 'assign
-                    name
-                    (+ (list 'fn args)
-                       body))))
-
-(def qq-handle-unquote-splicing (arg rest level)
-     (cond (eq? level 0)
-           (qq-do-unquote-splicing arg rest level)
-           (qq-skip-unquote-splicing arg rest level)))
-
-(def qq-do-unquote-splicing (arg rest level)
-     (cond (no rest)
-           arg
-           (list '+
-                 (pre-compile arg)
-                 (qq-quasiquote rest level))))
-
-(def qq-skip-unquote-splicing (arg rest level)
-     (list 'cons
-           (list 'list ''unquote-splicing (qq-quasiquote arg (- level 1)))
-           (qq-quasiquote rest level)))
-
-(def qq-handle-quasiquote (arg rest level)
-     (list 'cons
-           (list 'list ''quasiquote (qq-quasiquote arg (+ level 1)))
-           (qq-quasiquote rest level)))
-
-(def qq-handle-unquote (arg rest level)
-     (list 'cons
-           (qq-maybe-unquote arg level)
-           (qq-quasiquote rest level)))
-
-(def qq-unquote-recurse (arg rest level)
-        (list 'cons
-              (qq-quasiquote arg level)
-              (qq-quasiquote rest level)))
-
-(def qq-handle-plain (arg rest level)
-     (list 'cons
-           (list 'quote arg)
-           (qq-quasiquote rest level)))
-
-(def qq-unquote? (arg rest level)
-     (cond (pair? arg)
-           (cond (eq? (car arg) 'unquote)
-                 (qq-handle-unquote (cadr arg) rest level)
-                 (cond (eq? (car arg) 'unquote-splicing)
-                       (qq-handle-unquote-splicing (cadr arg) rest level)
-                       (cond (eq? (car arg) 'quasiquote)
-                             (qq-handle-quasiquote (cadr arg) rest level)
-                             (qq-unquote-recurse arg rest level))))
-           (qq-handle-plain arg rest level)))
-
-(def qq-maybe-unquote (xs level)
-     (cond (eq? level 0)
-           (pre-compile xs)
-           (list 'list ''unquote (qq-quasiquote xs (- level 1)))))
-
-(def qq-quasiquote (xs level)
-            (cond (no xs)
-                  nil
-                  (cond (pair? xs)
-                        (cond (eq? (car xs) 'unquote)
-                              (qq-maybe-unquote (cadr xs) level)
-                              (cond (eq? (car xs) 'unquote-splicing)
-                                    (qq-handle-unquote-splicing (cadr xs) nil level)
-                                    (cond (eq? (car xs) 'quasiquote)
-                                          (list 'list ''quasiquote (qq-quasiquote (cdr xs) (+ level 1)))
-                                          (qq-unquote? (car xs) (cdr xs) level))))
-                        (list 'quote xs))))
-
-(hash-set macs 'quasiquote
-          (fn (arg) (qq-quasiquote arg 0)))
-
-(hash-set macs 'mac (fn (name args . body)
-  `(hash-set macs ',name (fn ,args ,@body))))
-
-(mac if args
-     (cond (no args) nil
-           (cond (cdr args)
-                 (cond (cddr args)
-                       `(cond ,(car args) ,(cadr args) (if ,@(cddr args)))
-                       `(cond ,(car args) ,(cadr args)))
-                 (car args))))
-
-(mac unless (arg . body)
-  `(if (no ,arg) (do ,@body)))
-
-(def expand-colon-syntax (first rest)
-     (if (no rest)
-         `(apply ,first args)
-         `(,first ,(expand-colon-syntax (car rest) (cdr rest)))))
-
-(mac colon-syntax args
-  (if (eq? (car args) '||)
-      (error "Irregular ': syntax: got ~(inspect args) : not prefix-syntax : in ~(joinstr ":" (cons pfx rest))")
-      `(fn args ,(expand-colon-syntax (car args) (cdr args)))))
-
-(mac bang-syntax (pfx . rest)
-  (if (no (eq? pfx '||))
-      (error "Irregular '! syntax: got prefix ~(inspect pfx) in ~(joinstr "!" (cons pfx rest))"))
-  (if (cdr rest)
-      (error "Irregular '! syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "!" (cons pfx rest))")
-      (if (caris 'colon-syntax (car rest))
-          `(colon-syntax no ,@(cdar rest))
-          `(colon-syntax no ,(car rest)))))
-
-(mac and args
-  (if args
-      (if (cdr args)
-          `(if ,(car args) (and ,@(cdr args)))
-          (car args))
-      't))
-
-(mac do args
-  `((fn nil ,@args)))
-
-(mac when (condition . body)
-  `(cond ,condition (do ,@body)))
-
-(def map (f things)
-  (if (no things)
-      nil
-    (pair? things)
-    (cons (f (car things)) (map f (cdr things)))
-    (map f (list things))))
-
-(def pairs (things)
-     (if (no things)       nil
-       (no (cdr things)) (list (list (car things)))
-       (cons (list (car things) (cadr things))
-             (pairs (cddr things)))))
-
-(mac with (parms . body)
-     `((fn ,(map car (pairs parms))
-           ,@body)
-       ,@(map cadr (pairs parms))))
-
-(mac let (var val . body)
-     `(with (,var ,val) ,@body))
-
-(def each (f acc things)
-  (if things
-      (each f (f acc (car things)) (cdr things))
-      acc))
-
-(def eachr (f things)
-     (when things
-       (eachr f (cdr things))
-       (f (car things))))
-
-(def zip (a b)
-  (if a
-      (cons (list (car a) (car b))
-            (zip (cdr a) (cdr b)))))
-
-(def reversify (things acc)
-  (if (no things)
-      acc
-      (reversify (cdr things)
-                 (cons (car things) acc))))
-
-(def rev (things) (reversify things nil))
-
-(mac push (x things)
-  `(assign ,things (cons ,x ,things)))
-
-(def flatten (things)
-     (let acc nil
-          (let flattenize nil
-               (assign flattenize (fn (x)
-                                      (if (pair? x)
-                                          (eachr flattenize x)
-                                        (push x acc))))
-               (flattenize things))
-          acc))
-
-(def joinstr (txt . things)
-     (let joinables (flatten things)
-       (apply +
-              (to-string (car joinables))
-              (flatten (zip (map (fn (_) txt) (cdr joinables))
-                            (map to-string (cdr joinables)))))))
-
-(def string-pieces pieces
-  (joinstr "" pieces))
-
-(let uniq-counter 0
-     (def uniq (prefix)
-          (sym (joinstr "-"
-                        (list prefix
-                              (assign uniq-counter
-                                      (+ uniq-counter 1))))))
-     (def reset-uniq-counter ()
-          (assign uniq-counter 0)))
-
-(mac w/uniq (vars . body)
-     (if (pair? vars)
-         `(with ,(apply + (map (fn (n) (list n '(uniq ',n))) vars))
-                ,@body)
-       `(let ,vars (uniq ',vars) ,@body)))
-
-(mac or args
-     (cond args
-           (w/uniq ora
-                   `(let ,ora ,(car args)
-                         (cond ,ora ,ora (or ,@(cdr args)))))))
-
-(mac pop (xs)
-     (w/uniq gp
-             `(let ,gp (car ,xs)
-                   (assign ,xs (cdr ,xs))
-                   ,gp)))
-
-(def nth (n things)
-     (if (eq? n 0)
-         (car things)
-       (nth (- n 1) (cdr things))))
-
-(def iso (x y)
-     (or (eq? x y)
-         (and (pair? x)
-              (pair? y)
-              (iso (car x) (car y))
-              (iso (cdr x) (cdr y)))))
-
-(def isa     (type obj) (eq? (type-of obj) type))
-(def sym?    (arg)      (isa 'symbol arg))
-(def string? (arg)      (isa 'string arg))
-(mac just    (arg)      arg)
-(def quotify (arg)      `(quote ,arg))
-
-(def caris (obj things)
-     (and (isa 'pair things)
-          (eq? (car things)  obj)))
-
-(def len (xs)
-  (if (pair? xs)   (+ 1 (len (cdr xs)))
-      (string? xs) (string-length xs)
-      0))
-
-(def build-keyword-args (pairs)
-  (map (fn (ab) `(list (quote ,(car ab)) ,@(cdr ab))) pairs))
-
-(assign dynamics (hash))
-
-(mac dynamic (name)
-  (hash-set dynamics name t)
-  (let with-mac-name (sym "w/~name")
-    (w/uniq prev
-      `(do
-        (mac ,with-mac-name (new-value . body)
-             (w/uniq result
-                     `(let ,',prev (hash-get (thread-locals) ',',name)
-                           (hash-set (thread-locals) ',',name ,new-value)
-                           (let ,result (do ,@body)
-                             (hash-set (thread-locals) ',',name ,',prev)
-                             ,result))))
-           (def ,name () (hash-get (thread-locals) ',name))))))
-
-(def build-hash-get-key (name)
-  (if (pair? name)
-      (if (caris 'unquote name)
-          (cadr name)
-          name)
-      (list 'quote name)))
-
-;; (build-hash-getters '(a b c))
-;; => (hash-get (hash-get a 'b) 'c)
-(def build-hash-getters (names acc)
-  (if (no acc)
-      (build-hash-getters (cdr names) (car names))
-      names
-      (build-hash-getters (cdr names) `(hash-get ,acc ,(build-hash-get-key (car names))))
-      acc))
-
-(def build-hash-lookup-from (root names)
-  (build-hash-getters (cons root names) nil))
-
-(mac hash-lookup (names)
-  (build-hash-getters names nil))
-
-(mac dot-syntax names `(hash-lookup ,names))
-(mac dollar-syntax (_ name) `(,name))
-
-(def dot-syntax-assignment (names value-expr)
-  (let rnames (rev names)
-    `(hash-set ,(build-hash-getters (rev (cdr rnames)) nil)
-               ,(build-hash-get-key:car rnames)
-               ,value-expr)))
-
-(mac = (name value)
-  (if (isa 'symbol name)
-      `(assign ,name ,value)
-      (caris 'dot-syntax name)
-      (dot-syntax-assignment (cdr name) value)))
-
-(def brace-list-hash-key (k)
-  (if (isa 'symbol k)      `(quote ,k)
-      (caris 'unquote k)   (cadr k)
-      k))
-
-(def brace-list-build-hash (args)
-  (w/uniq hash
-    (let mappings (pairs args)
-      `(let ,hash (hash)
-            ,@(map (fn (m) `(hash-set ,hash ,(brace-list-hash-key (car m)) ,(cadr m))) mappings)
-            ,hash))))
-
-(def build-ampersand-syntax (arg)
-  (if (caris 'dot-syntax arg)
-      `(fn (obj) ,(build-hash-lookup-from 'obj (cdr arg)))
-      `(fn (obj) ,(build-hash-lookup-from 'obj (list arg)))))
-
-(mac ampersand-syntax (pfx . rest)
-  (if (no (eq? pfx '||))
-      (error "Irregular '& syntax: got prefix ~(inspect pfx) in ~(joinstr "&" (cons pfx rest))"))
-  (if (cdr rest)
-      (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(joinstr "&" (cons pfx rest))")
-      (build-ampersand-syntax (car rest))))
-
-(mac brace-list-mono (arg) arg)
-
-(mac brace-list args
-  (if (no (cdr args))
-      `(brace-list-mono ,(car args))
-      (brace-list-build-hash args)))
-
-(mac on-err (handler . body)
-  `(handle-error (fn (err) ,handler)
-                 (fn ()    ,@body)))
-
-(mac ensure (protection . body)
-  `(ensuring (fn () ,protection)
-             (fn ()    ,@body)))
-
-(mac rfn (name parms . body)
-  `(let ,name nil
-     (assign ,name (fn ,parms ,@body))))
-
-(mac afn (parms . body)
-  `(rfn self ,parms ,@body))
-
-(mac loop (start test update . body)
-  (w/uniq (gfn gparm)
-    `(do ,start
-         ((rfn ,gfn (,gparm)
-            (if ,gparm
-                (do ,@body ,update (,gfn ,test))))
-          ,test))))
-
-(mac for (v init max . body)
-  (w/uniq (gi gm)
-    `(with (,v nil ,gi ,init ,gm (+ ,max 1))
-       (loop (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1))
-         ,@body))))
-
-(mac mapx (things x expr)
-  `(map (fn (,x) ,expr) ,things))