Merge pull request #222 from andrew-johnson-4/complex-match

Complex match

Author: andrew-johnson-4

BOOTSTRAP/cli.s

@@ -73954,6 +73954,22 @@ uuid_000000000000045c:
 	push %r13
 	mov -72(%rbp),%r12
 	mov -80(%rbp),%r13
+	call __expr_C__C_get_frame_C___
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	pop %r13
+	pop %r12
+	push %r8
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	mov %r8, %r12
+	pop %r13
+	push %r12
+	push %r13
+	mov -72(%rbp),%r12
+	mov -80(%rbp),%r13
 	call __expr_C__C_get_prog_C___
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
@@ -74166,6 +74182,22 @@ uuid_000000000000045c:
 	push %r13
 	mov -88(%rbp),%r12
 	mov -96(%rbp),%r13
+	call __expr_C__C_get_frame_C___
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	pop %r13
+	pop %r12
+	push %r8
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	mov %r8, %r12
+	pop %r13
+	push %r12
+	push %r13
+	mov -88(%rbp),%r12
+	mov -96(%rbp),%r13
 	call __expr_C__C_get_prog_C___
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
@@ -74180,6 +74212,38 @@ uuid_000000000000045c:
 	pop %r13
 	push %r12
 	push %r13
+	mov -88(%rbp),%r12
+	mov -96(%rbp),%r13
+	call __expr_C__C_get_unframe_C___
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	pop %r13
+	pop %r12
+	push %r8
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	mov %r8, %r12
+	pop %r13
+	push %r12
+	push %r13
+	mov -72(%rbp),%r12
+	mov -80(%rbp),%r13
+	call __expr_C__C_get_unframe_C___
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	pop %r13
+	pop %r12
+	push %r8
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	mov %r8, %r12
+	pop %r13
+	push %r12
+	push %r13
 	mov $uuid_0000000000000008, %r12
 	mov $0, %r13
 	call uuid_0000000000000003
@@ -74298,6 +74362,22 @@ uuid_000000000000045c:
 	mov %r13, 8(%r8)
 	mov %r8, %r12
 	pop %r13
+	push %r12
+	push %r13
+	mov -72(%rbp),%r12
+	mov -80(%rbp),%r13
+	call __expr_C__C_get_unframe_C___
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	pop %r13
+	pop %r12
+	push %r8
+	call uuid_0000000000000003
+	mov %r12, 0(%r8)
+	mov %r13, 8(%r8)
+	mov %r8, %r12
+	pop %r13
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
 	mov %r13, 8(%r8)
@@ -74617,8 +74697,9 @@ uuid_000000000000046d:
 	pop %r13
 	push %r12
 	push %r13
-	mov -24(%rbp),%r12
-	mov -32(%rbp),%r13
+	mov -72(%rbp),%r12
+	mov -80(%rbp),%r13
+	call __expr_C__C_get_offset_C___
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
 	mov %r13, 8(%r8)
@@ -74667,8 +74748,9 @@ uuid_000000000000046d:
 	pop %r13
 	push %r12
 	push %r13
-	mov -24(%rbp),%r12
-	mov -32(%rbp),%r13
+	mov -72(%rbp),%r12
+	mov -80(%rbp),%r13
+	call __expr_C__C_get_offset_C___
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
 	mov %r13, 8(%r8)

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "lambda_mountain"
-version = "1.11.85"
+version = "1.11.86"
 authors = ["Andrew <andrew@subarctic.org>"]
 license = "MIT"
 description = "Lambda Mountain"

Makefile

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

PRODUCTION/codegen-strict.lm

@@ -87,20 +87,25 @@ compile-expr-strict := λctx e offset used . (tail(
                (set label-end-loop (uuid()))
                (set e3 (expr::set-prog( e3 (
                   label-begin-loop ': \n
+                  (expr::get-frame e1)
                   (expr::get-prog e1)
                   \t (expr::get-expr e1) \s label-do-loop \n
                   \t 'jmp \s label-end-loop \n
                   label-do-loop ': \n
+                  (expr::get-frame e2)
                   (expr::get-prog e2)
+                  (expr::get-unframe e2)
+                  (expr::get-unframe e1)
                   \t 'jmp \s label-begin-loop \n
                   label-end-loop ': \n                  
+                  (expr::get-unframe e1)
                ))))
                e3
             )))
             ( (App( (App( (App( (Variable 'if) cond )) t )) f )) (tail(
                (set e1 (compile-expr-strict( ctx cond offset Used )))
-               (set e2 (compile-expr-strict( (expr::get-context e1) t offset Used )))
-               (set e3 (compile-expr-strict( ctx f offset Used )))
+               (set e2 (compile-expr-strict( (expr::get-context e1) t (expr::get-offset e1) Used )))
+               (set e3 (compile-expr-strict( ctx f (expr::get-offset e1) Used )))
                (match (expr::get-type e1) (
                   ()
                   (BranchConditional ())

STDLIB/default-primitives.lm

@@ -86,7 +86,8 @@ fragment branchtrue := λ(: _ Nil). (: (
    (.expression( 'jmp ))
 ) BranchConditional);
 fragment branchfalse := λ(: _ Nil). (: (
-   (.expression( 'nop ))
+   (.program( \t 'cmp \s '%rsp, \s '%rsp \n ))
+   (.expression( 'jne ))
 ) BranchConditional);
 
 fragment + := λ(: l LocalVariable+U8)(: r LocalVariable+U8). (: (

tests/strict/match5.lm

@@ -0,0 +1,16 @@
+
+import STDLIB/default-instruction-set.lm;
+import STDLIB/default-primitives.lm;
+import STDLIB/default-rules.lm;
+import STDLIB/default-stdlib.lm;
+
+main := (tail(
+   (let x 0u64)
+   (while (<( x 4u64 )) (
+      (match x (
+         ()
+         (y (print y))
+      ))
+      (set x (+( x 1u64 )))
+   ))
+));

tests/strict/match5.lm.out

@@ -0,0 +1 @@
+0123