new tests.

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))
 )

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)

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)
  )


  

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 =)