really close to working

Author: andrew-johnson-4

Makefile

@@ -1,6 +1,6 @@
 
 nostd: prod
-	./production --nostd -o tmp.s tests/strict/cc2.lm
+	./production --nostd -o tmp.s tests/strict/match6.lm
 	as -o tmp.o tmp.s
 	ld -o tmp tmp.o
 	./tmp && echo $?

PRODUCTION/codegen-strict.lm

@@ -133,13 +133,17 @@ compile-expr-strict := λctx e offset used . (tail(
                   (expr::get-unframe e3)
                   \t 'jmp \s label-end \n
                   label-true-branch ': \n
-                  (expr::get-frame e2)
                   (expr::get-prog e2)
-                  (expr::get-unframe e2)
                   label-end ': \n
                ))))
                (set e4 (expr::set-context( e4 (expr::get-context e2) )))
-               (set e4 (expr::set-offset( e4 (expr::get-offset e3) )))
+               (set e4 (expr::set-offset( e4 (expr::get-offset e1) )))
+               (set e4 (expr::set-frame( e4 (
+                  (expr::get-frame e1) (expr::get-frame e2)
+               ))))
+               (set e4 (expr::set-unframe( e4 (
+                  (expr::get-unframe e1) (expr::get-unframe e2)
+               ))))
                e4
             )))
             ( (App( (Variable 'label) (Variable label-name) )) (

STDLIB/default-rules.lm

@@ -31,18 +31,18 @@ macro ('match-pats-condition( term (:Tag: l lt) )) (
    (==( (.0( term )) l ))
 );
 
-macro ('match-pats-condition( term ((:Tag: l lt) ( x1 )) )) (
-   if (==( (.0( term )) l ))
-      (match-pats-condition( (.1( (as term lt) )) x1 ))
-      (branchfalse())
-);
+macro ('match-pats-condition( term ((:Tag: l lt) ( x1 )) )) (tail(
+   (let ok Trueu8)
+   (if (==( (.0( term )) l )) () (set ok Falseu8))
+   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
+   (==( ok Trueu8 ))
+));
 
-macro ('match-pats-condition( term ((:Tag: l lt) ( x1 x2 ) ))) (
-   if (==( (.0( term )) l ))
-      (if (match-pats-condition( (.2( (as term lt) )) x1 ))
-          (match-pats-condition( (.1( (as term lt) )) x2 ))
-          (branchfalse())
-      )
-      (branchfalse())
-);
+macro ('match-pats-condition( term ((:Tag: l lt) ( x1 x2 ) ))) (tail(
+   (let ok Trueu8)
+   (if (==( (.0( term )) l )) () (set ok Falseu8))
+   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
+   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
+   (==( ok Trueu8 ))
+));
 

tests/strict/match6.lm

@@ -8,24 +8,22 @@ import STDLIB/default-stdlib.lm;
 type Cases CaseOne | (CaseTwo( U64 )) | (CaseThree( U64 , U64 ));
 
 main := (
-#   (match (CaseOne)  (
-#      ()
-#      ( (CaseOne) (print 'CaseOne_s) )
-#      ( (CaseTwo( x )) (tail( (print 'CaseTwo_s) (print x) )) )
-#      ( (CaseThree( x y )) (tail( (print 'CaseThree_s) (print x) (print y) )))
-#   ))
-#   (match (CaseTwo( 1u64 ))  (
-#      ()
-#      ( (CaseOne) (print 'CaseOne_s) )
-#      ( (CaseTwo( x )) (tail( (print 'CaseTwo_s) (print x) )) )
-#      ( (CaseThree( x y )) (tail( (print 'CaseThree_s) (print x) (print y) )))
-#   ))
+   (match (CaseOne)  (
+      ()
+      ( (CaseOne) (print 'CaseOne_s) )
+      ( (CaseTwo( x )) (tail( (print 'CaseTwo_s) (print x) )) )
+      ( (CaseThree( x y )) (tail( (print 'CaseThree_s) (print x) (print y) )))
+   ))
+   (match (CaseTwo( 1u64 ))  (
+      ()
+      ( (CaseOne) (print 'CaseOne_s) )
+      ( (CaseTwo( x )) (tail( (print 'CaseTwo_s) (print x) )) )
+      ( (CaseThree( x y )) (tail( (print 'CaseThree_s) (print x) (print y) )))
+   ))
    (match (CaseThree( 2u64 3u64 ))  (
       ()
-#      ( (CaseOne) (print 'CaseOne_s) )
-#      ( (CaseTwo( x )) (tail( (print 'CaseTwo_s) (print x) )) )
-#      ( (CaseThree( x y )) (tail( (print 'CaseThree_s) (print x) (print y) )))
-#      ( (CaseTwo( x )) () )
-      ( (CaseThree( x y )) (tail( (print x) (print y) )) )
+      ( (CaseOne) (print 'CaseOne_s) )
+      ( (CaseTwo( x )) (tail( (print 'CaseTwo_s) (print x) )) )
+      ( (CaseThree( x y )) (tail( (print 'CaseThree_s) (print x) (print y) )))
    ))
 );