Merge pull request #224 from andrew-johnson-4/strict-compiler-dev-rush

Strict compiler dev rush

Author: andrew-johnson-4

Cargo.toml

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

Makefile

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

STDLIB/default-rules.lm

@@ -32,47 +32,47 @@ macro ('match-pats-condition( term (:Tag: l lt) )) (
 );
 
 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 ))
+   (let (uuid ok) Trueu8)
+   (if (==( (.0( term )) l )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set (uuid ok) Falseu8))
+   (==( (uuid ok) Trueu8 ))
 ));
 
 macro ('match-pats-condition( term ((:Tag: l lt) ( x2 x1 ) ))) (tail(
-   (let ok Trueu8)
-   (if (==( (.0( term )) l )) () (set ok Falseu8))
-   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
-   (==( ok Trueu8 ))
+   (let (uuid ok) Trueu8)
+   (if (==( (.0( term )) l )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set (uuid ok) Falseu8))
+   (==( (uuid ok) Trueu8 ))
 ));
 
 macro ('match-pats-condition( term ((:Tag: l lt) ( x3 x2 x1 ) ))) (tail(
-   (let ok Trueu8)
-   (if (==( (.0( term )) l )) () (set ok Falseu8))
-   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set ok Falseu8))
-   (==( ok Trueu8 ))
+   (let (uuid ok) Trueu8)
+   (if (==( (.0( term )) l )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set (uuid ok) Falseu8))
+   (==( (uuid ok) Trueu8 ))
 ));
 
 macro ('match-pats-condition( term ((:Tag: l lt) ( x4 x3 x2 x1 ) ))) (tail(
-   (let ok Trueu8)
-   (if (==( (.0( term )) l )) () (set ok Falseu8))
-   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.4( (as term lt) )) x4 )) () (set ok Falseu8))
-   (==( ok Trueu8 ))
+   (let (uuid ok) Trueu8)
+   (if (==( (.0( term )) l )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.4( (as term lt) )) x4 )) () (set (uuid ok) Falseu8))
+   (==( (uuid ok) Trueu8 ))
 ));
 
 macro ('match-pats-condition( term ((:Tag: l lt) ( x5 x4 x3 x2 x1 ) ))) (tail(
-   (let ok Trueu8)
-   (if (==( (.0( term )) l )) () (set ok Falseu8))
-   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.4( (as term lt) )) x4 )) () (set ok Falseu8))
-   (if (match-pats-condition( (.5( (as term lt) )) x5 )) () (set ok Falseu8))
-   (==( ok Trueu8 ))
+   (let (uuid ok) Trueu8)
+   (if (==( (.0( term )) l )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.1( (as term lt) )) x1 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.2( (as term lt) )) x2 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.3( (as term lt) )) x3 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.4( (as term lt) )) x4 )) () (set (uuid ok) Falseu8))
+   (if (match-pats-condition( (.5( (as term lt) )) x5 )) () (set (uuid ok) Falseu8))
+   (==( (uuid ok) Trueu8 ))
 ));
 

STDLIB/default-stdlib.lm

@@ -194,17 +194,15 @@ print := λ(: x I8). (: (tail(
    (label start )
    (mov( R8 0u64 c1 ))
    (mov( R9 0u64 c2 ))
-   (if (==( c1 c2 )) () (jmp end-false))
-   (if (==( c1 0u8 )) () (jmp end-true))
+   (if (==( c1 c2 )) (mov( 1u64 RAX )) (mov( 0u64 RAX )) )
+   (cmp( 0u64 RAX ))
+   (je end)
+   (if (==( c1 0u8 )) (mov( 1u64 RAX )) (mov( 0u64 RAX )) )
+   (cmp( 1u64 RAX ))
+   (je end)
    (inc R8)
    (inc R9)
    (jmp start)
-   (label end-true)
-   (mov( 1u64 RAX ))
-   (jmp( end ))
-   (label end-false)
-   (mov( 0u64 RAX ))
-   (jmp( end ))
    (label end)
    (as RAX U64)
 )) U64);

STRICT/cli.lm

@@ -27,20 +27,19 @@ main := λ(: argc U64)(: argv U8[][]).(tail(
          ('--gradual_s (set config-strict Falseu8))
          ('--macro_s (set config-preprocess Trueu8))
          ('--nomacro_s (set config-preprocess Falseu8))
-         ('-o_s (tail(
-            (set argi (+( argi 1u64 )))
-            (set input (SCons(
-               (close input)
-               (close (SAtom([]( argv argi ))))
-            )))
-         )))
-         (fp (tail(
-            (print fp)
+#         ('-o_s (tail(
+#            (set argi (+( argi 1u64 )))
+#            (set input (SCons(
+#               (close input)
+#               (close (SAtom([]( argv argi ))))
+#            )))
+#         )))
+         (fp (
             (set input (SCons(
                (close input)
                (close (SAtom( fp )))
             )))
-         )))
+         ))
       ))
       (set argi (+( argi 1u64 )))
    ))

tests/strict/match7.lm

@@ -0,0 +1,22 @@
+
+import STDLIB/default-instruction-set.lm;
+import STDLIB/default-primitives.lm;
+import STDLIB/default-rules.lm;
+import STDLIB/default-stdlib.lm;
+
+import STRICT/utility.lm;
+
+config-preprocess            := 2u8;
+
+main := λ(: argc U64)(: argv U8[][]).(tail(
+   (print( (==( '--macro_s '--macro_s )) ))
+   (print( (==( '--macro_s '--nomacro_s )) ))
+   (print( (==( '--nomacro_s '--macro_s )) ))
+   (print( (==( '--nomacro_s '--nomacro_s )) ))
+   (match '--nomacro_s (
+      ()
+      ('--macro_s (set config-preprocess 1u8))
+      ('--nomacro_s (set config-preprocess 0u8))
+   ))
+   (print config-preprocess)
+));

tests/strict/match7.lm.out

@@ -0,0 +1 @@
+Ok