1559 - tests now pass; mfn is indeed redundant

030.wart

@@ -1,5 +1,70 @@
-= foo (fn'(y) (eval `(if 3 ,y)))
-= bar (fn(x) (foo pr.x))
-debug.1
-bar 111
-quit.
+= mac! (fn '(name params . body)
+  (eval `(= ,name (fn ',params
+                    (eval ((fn() ,@body)))))))
+
+mac! def!(name params . body)
+  `(= ,name (fn ,params ,@body))
+
+mac! do body
+  `((fn() ,@body))
+
+def! prn args
+  (if args
+    (do
+      pr car.args
+      prn @cdr.args
+      car.args)
+    (pr "
+"))
+
+mac! def(name params . body)
+  if bound?.name
+    (prn "redef: " name)
+  `(def! ,name ,params ,@body)
+
+mac! mac(name params . body)
+  if bound?.name
+    (prn "redef: " name)
+  `(mac! ,name ,params ,@body)
+
+mac alias(new old) ; include later refinements
+  `(mac ,new $args
+     `(,,old ,@$args))
+
+def compose(f g)
+  fn 'args
+    eval `(,f (,g ,@args))
+
+def complement(f)
+  (compose not f)
+
+mac let(var val . body)
+  `((fn(,var) ,@body) ,val)
+
+def list args
+  if args
+    (cons car.args
+          (list @cdr.args))
+
+let $iso iso ; ignore later refinements
+  def isa(x t)
+    ($iso t type.x)
+
+= cadr car:cdr
+= cddr cdr:cdr
+
+def id(_)
+  _
+
+= quote (car:car (cons ' 'a))
+def quote?(_) (iso _ quote)
+= backquote (car '`(1))
+def backquote?(_) (iso _ backquote)
+= unquote (car:cadr '`(,1))
+def unquote?(_) (iso _ unquote)
+= unquote-splice (car:cadr '`(,@1))
+def unquote-splice?(_) (iso _ unquote-splice)
+
+def die args
+  prn @args
+  quit.

031test.test

@@ -0,0 +1,5 @@
+(test "test using keyword args"
+ :valueof (+ 1 1)
+ :should be 2)
+
+(test "test using positional args" iso (+ 1 1) 2)

032check.test

@@ -0,0 +1,206 @@
+(test "if handles 0 args"
+ :valueof (if)
+ :should be nil)
+
+(test "if handles 1 arg"
+ :valueof if.3
+ :should be 3)
+
+(test "if handles 2 args"
+ :valueof (if 3 4)
+ :should be 4)
+
+(test "if handles then branch"
+ :valueof (if 3 4 5)
+ :should be 4)
+
+(test "if handles else branch"
+ :valueof (if nil 4 5)
+ :should be 5)
+
+(test "if handles 3 args"
+ :valueof (if nil 4 5)
+ :should be 5)
+
+(test "if handles 4 args"
+ :valueof (if nil 4 5 6)
+ :should be 6)
+
+(test "if handles 5 args"
+ :valueof (if nil 4 nil 6 7)
+ :should be 7)
+
+(test "if handles :else"
+ :valueof (if nil 4 :else 6)
+ :should be 6)
+
+(test "if handles lexical scope"
+ :valueof (let x 34 (if x))
+ :should be 34)
+
+(test "if handles dynamic scope"
+ :valueof (do (= x 34)
+              (if x 35))
+ :should be 35)
+
+
+
+(test "or handles 0 args"
+ :valueof or.
+ :should be nil)
+
+(test "or handles nil arg"
+ :valueof or.nil
+ :should be nil)
+
+(test "or handles non-nil arg"
+ :valueof or.3
+ :should be 3)
+
+(test "or handles 2 args"
+ :valueof (or nil 3)
+ :should be 3)
+
+(test "or handles multiple non-nil args"
+ :valueof (or 3 4)
+ :should be 3)
+
+(test "or short-circuits on first non-nil arg"
+ :valueof (let x nil
+            (or 3 (= x 4))
+            x)
+ :should be nil)
+
+(test "or evals each arg at most once"
+ :valueof (let x 0
+            (or (do (= x (+ x 1))
+                    3)
+                (do (= x (+ x 1))
+                    4))
+            x)
+ :should be 1)
+
+(test "or handles lexical scope"
+ :valueof (do (= x 35)
+              (let x 3
+                (or nil x)))
+ :should be 3)
+
+
+
+(test "and handles 0 args"
+ :valueof and.
+ :should ~be nil)
+
+(test "and handles nil arg"
+ :valueof and.nil
+ :should be nil)
+
+(test "and handles non-nil arg"
+ :valueof and.3
+ :should be 3)
+
+(test "and handles 2 args"
+ :valueof (and nil 3)
+ :should be nil)
+
+(test "and handles 2 non-nil args"
+ :valueof (and 3 4)
+ :should be 4)
+
+(test "and handles lexical scope"
+ :valueof ((fn(x) (and 3 x 4)) nil)
+ :should be nil)
+
+(test "and short-circuits"
+ :valueof (let x 0
+            (and (= x 3)
+                 nil
+                 (= x 4))
+            x)
+ :should be 3)
+
+(test "and handles dynamic scope"
+ :valueof (do (= x 35)
+              (and x 36))
+ :should be 36)
+
+
+
+(test "iso handles nils"
+ :valueof (iso nil 3)
+ :should be nil)
+
+(test "iso compares nils"
+ :valueof (iso nil nil)
+ :should ~be nil)
+
+(test "iso handles ints"
+ :valueof (iso 3 4)
+ :should be nil)
+
+(test "iso handles ints - 2"
+ :valueof (iso 3 3)
+ :should ~be nil)
+
+(test "iso handles strings"
+ :valueof (iso "a" "b")
+ :should be nil)
+
+(test "iso handles strings - 2"
+ :valueof (iso "a" "a")
+ :should ~be nil)
+
+(test "iso handles lists"
+ :valueof (iso list.1 list.2)
+ :should be nil)
+
+(test "iso handles lists - 2"
+ :valueof (iso list.1 list.1)
+ :should ~be nil)
+
+(test "iso handles user-defined types"
+ :valueof (iso '(type foo 3) '(type foo 3))
+ :should ~be nil)
+
+
+
+(test "match - atom positive"
+ :valueof (match 3 3)
+ :should ~be nil)
+
+(test "match - atom negative"
+ :valueof (match 3 4)
+ :should be nil)
+
+(test "match - list positive"
+ :valueof (match '(1 (2 3)) '(1 (2 3)))
+ :should ~be nil)
+
+(test "match - list negative"
+ :valueof (match '(2 (2 3)) '(1 (2 3)))
+ :should be nil)
+
+(test "match treats _ as atom wildcard"
+ :valueof (match '_ 3)
+ :should ~be nil)
+
+(test "match - _ positive"
+ :valueof (match '(1 (_ 3 4)) '(1 (2 3 4)))
+ :should ~be nil)
+
+(test "match - _ negative"
+ :valueof (match '(2 (_ 3 4)) '(1 (2 3 4)))
+ :should be nil)
+
+(test "match - _ matches lists"
+ :valueof (match '_ '(3))
+ :should ~be nil)
+
+(test "match - _ matches lists when dotted"
+ :valueof (match '(1 . _) '(1 2 3))
+ :should ~be nil)
+
+(test "match treats any sym beginning with _ as wildcard"
+ :valueof (match '(1 . _x) '(1 2 3))
+ :should ~be nil)

032check.wart

@@ -0,0 +1,51 @@
+= compiled-if if
+let $if if
+  mac! if args
+    $if !cdr.args
+      car.args
+      `(,$if ,car.args
+         ,cadr.args
+         (if ,@cddr.args))
+
+mac or args
+  if args
+    `(let $x ,car.args
+       if $x
+         $x
+         or ,@cdr.args)
+
+mac and args
+  if !args
+    1
+    if !cdr.args
+      car.args
+      `(if ,car.args
+         and ,@cdr.args)
+
+alias nil? not
+alias no not
+
+def match(a b)
+  (or (iso a b)
+      (iso str.a.0 "_")
+      (and cons?.a cons?.b
+           (match car.a car.b)
+           (match cdr.a cdr.b)))
+
+let $iso iso
+  def! iso(a b)
+    or ($iso a b)
+      and (cons? a)
+          (cons? b)
+          (iso car.a car.b)
+          (iso cdr.a cdr.b)
+
+def only(f)
+  (fn args
+    (if f (f @args)))
+
+mac check(x test else)
+  `(let $x ,x
+     if (,test $x)
+      $x
+      ,else)