diff --git a/vm/tests/t28.scm b/vm/tests/t28.scm new file mode 100644 index 0000000..9532bf0 --- /dev/null +++ b/vm/tests/t28.scm @@ -0,0 +1,17 @@ +;; -*- Mode: Irken -*- + +(define x (:thing 1 2 #\A)) +(define y (:other "testing")) + +(define myfun + (:thing _ two _) -> two + (:other _) -> 19 + ) + +(:zorb + (myfun x) + (myfun y) + (myfun (:thing 7 12 #\X)) + ) + + diff --git a/vm/tests/t29.scm b/vm/tests/t29.scm new file mode 100644 index 0000000..c7af520 --- /dev/null +++ b/vm/tests/t29.scm @@ -0,0 +1,15 @@ +;; -*- Mode: Irken -*- + +(include "lib/core.scm") + +(define thing1 {a=1 b=#\b c="c"}) +(define thing2 {c="hey" b=#\b a=12}) + +(set! thing2.c "there") +(set! thing1.a 34) + +(print thing1) +(print thing2) +(print thing1.a) +(print thing2.c) + diff --git a/vm/tests/t30.scm b/vm/tests/t30.scm new file mode 100644 index 0000000..11b7140 --- /dev/null +++ b/vm/tests/t30.scm @@ -0,0 +1,23 @@ +;; -*- Mode: Irken -*- + +(include "lib/core.scm") + +;; test op_rset. + +(define (^fun1 p) + (set! p.y 1001) + (+ p.x 10) + ) + +(let ((thing1 {a=0 x=1 y=2 b="what?"}) + (thing2 {x=3 y=4 z=7})) + (set! thing1.x 27) + (set! thing2.x 19) + (print (^fun1 thing1)) + (print (^fun1 thing2)) + (print thing1) + (print thing2) + ) + + + diff --git a/vm/tests/t_samefringe.scm b/vm/tests/t_samefringe.scm new file mode 100644 index 0000000..e7586bb --- /dev/null +++ b/vm/tests/t_samefringe.scm @@ -0,0 +1,43 @@ +;; -*- Mode: Irken -*- + +(include "lib/core.scm") + +(datatype btree + (:node (btree 'a) (btree 'a)) + (:leaf 'a)) + +(defmacro btree/make + (btree/make (l r)) -> (btree:node (btree/make l) (btree/make r)) + (btree/make x) -> (btree:leaf x)) + +(define t0 (literal (btree/make ((0 ((1 (2 (3 4))) 5)) (((6 7) ((8 (9 10)) 11)) ((12 (((13 14) 15) (16 17))) (18 19))))))) +(define t1 (literal (btree/make (((0 ((1 2) 3)) (((4 5) (((6 7) 8) (9 10))) ((11 ((12 13) 14)) ((15 (16 17)) 18)))) 19)))) +(define t2 (literal (btree/make (((0 ((1 2) 3)) (((4 5) (((6 7) 8) (9 10))) ((88 ((12 13) 14)) ((15 (16 17)) 18)))) 19)))) + +(define btree/inorder + p (btree:leaf x) -> (begin (p x) #u) + p (btree:node l r) -> (begin (btree/inorder p l) (btree/inorder p r) #u)) + +(define (btree/make-generator t) + (make-generator + (lambda (consumer) + (btree/inorder + (lambda (x) (consumer (maybe:yes x))) + t) + (forever (consumer (maybe:no)))))) + +(define (same-fringe t0 t1 =) + (let ((g0 (btree/make-generator t0)) + (g1 (btree/make-generator t1))) + (let loop ((m0 (g0)) (m1 (g1))) + (match m0 m1 with + (maybe:yes v0) (maybe:yes v1) + -> (if (= v0 v1) + (loop (g0) (g1)) + (print "NOT equal")) + (maybe:no) (maybe:no) + -> (print "equal") + _ _ -> (print "unequal size"))))) + +(same-fringe t0 t1 =) +(same-fringe t0 t2 =)