Strict compiler dev 3

Cargo.toml

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

Makefile

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

PRODUCTION/codegen-strict.lm

@@ -101,7 +101,17 @@ compile-expr-strict := λctx e offset used . (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 )))
-               (assert-eq( 'strict-compile-expr::while::ConditionMustBeBranchConditional (expr::get-type e1) BranchConditional ))
+               (match (expr::get-type e1) (
+                  ()
+                  (BranchConditional ())
+                  ( _ (tail(
+                     (set e1 (expr::set-prog( e1 (
+                        (expr::get-prog e1)
+                        \t 'cmp \s '$1 , \s '%rax \n
+                     ))))
+                     (set e1 (expr::set-expr( e1 'je )))
+                  )))
+               ))
                (set e4 e1)
                (local label-true-branch)
                (set label-true-branch (uuid()))

PRODUCTION/typecheck.lm

@@ -269,7 +269,7 @@ typecheck-infer-ctx := λctx e . (match e (
       ctx
    ))
    ( u (
-      fail (UnknownLhs u)
+      fail (UnknownLhsInferCtx u)
    ))
 ));
 
@@ -325,7 +325,7 @@ typecheck-typeof-lhs := λlhs . (match lhs (
       Nil
    ))
    ( u (
-      fail (UnknownLhs u)
+      fail (UnknownLhsTypeofLhs u)
    ))
 ));
 

STDLIB/default-instruction-set.lm

@@ -54,15 +54,26 @@ fragment push := λ(: src GlobalVariable+Sized<size>). (: (
    ))
 ) Nil);
 fragment push := λ(: src LocalVariable+Sized<size>). (: (
-   (.program ( for word-offset in (range( 0 (/( size 8 )) )) (
-      \t 'pushq \s (+(
-         (.expression src)
-         (+(
-            (+( size '-8 ))
-            (inv(*( word-offset 8 )))
-         ))
-      )) \[ '%rbp \] \n
-   )))
+   (.program (
+      (for word-offset in (range( 0 (/( size 8 )) )) (
+         \t 'pushq \s (+(
+            (.expression src)
+            (+(
+               (+( size '-8 ))
+               (inv(*( word-offset 8 )))
+            ))
+         )) \[ '%rbp \] \n
+     ))
+      (if-eq size 4 (
+         \t 'pushq \s (.expression src) \[ '%rbp \] \n
+      ))
+      (if-eq size 2 (
+         \t 'pushq \s (.expression src) \[ '%rbp \] \n
+      ))
+      (if-eq size 1 (
+         \t 'pushq \s (.expression src) \[ '%rbp \] \n
+      ))
+   ))
 ) Nil);
 fragment pop := λ(: src LocalVariable+Sized<size>). (: (
    (.program ( for word-offset in (range( 1 (+( (/( size 8 )) 1 )) )) (
@@ -79,7 +90,7 @@ fragment mov := λ(: src LocalVariable+Sized<size>)(: index Literal+Constant)(:
       ))
    ))
 ) Nil);
-fragment mov := λ(: src Reg64+x[])(: index Literal+Constant)(: dst LocalVariable+Sized<size>). (: (
+fragment mov := λ(: src Reg64)(: index Literal+Constant)(: dst LocalVariable+Sized<size>). (: (
    (.program (
       (\t 'mov \s '% (.expression src) , \s '%r14 \n)
       (for word-offset in (range( 0 (/( size 8 )) )) (
@@ -177,6 +188,11 @@ fragment cmp := λ(: imm Constant+Literal+Sized<4>)(: r Constant+Reg32). (: (.pr
 fragment cmp := λ(: imm Constant+Literal+Sized<2>)(: r Constant+Reg16). (: (.program( \t 'cmp \s '$ (.expression imm) , '% (.expression r) \n )) Nil);
 fragment cmp := λ(: imm Constant+Literal+Sized<1>)(: r Constant+Reg8). (: (.program( \t 'cmp \s '$ (.expression imm) , '% (.expression r) \n )) Nil);
 
+fragment cmp := λ(: l Constant+Reg8)(: r Constant+Reg8). (: (.program( \t 'cmp \s '% (.expression l) , '% (.expression r) \n )) Nil);
+fragment cmp := λ(: l Constant+Reg16)(: r Constant+Reg16). (: (.program( \t 'cmp \s '% (.expression l) , '% (.expression r) \n )) Nil);
+fragment cmp := λ(: l Constant+Reg32)(: r Constant+Reg32). (: (.program( \t 'cmp \s '% (.expression l) , '% (.expression r) \n )) Nil);
+fragment cmp := λ(: l Constant+Reg64)(: r Constant+Reg64). (: (.program( \t 'cmp \s '% (.expression l) , '% (.expression r) \n )) Nil);
+
 fragment movsx := λ(: src Constant+Reg8)(: dst Constant+Reg64). (: (.program( \t 'movsx \s '% (.expression src) , '% (.expression dst) \n )) Nil);
 fragment movsx := λ(: src Constant+Reg16)(: dst Constant+Reg64). (: (.program( \t 'movsx \s '% (.expression src) , '% (.expression dst) \n )) Nil);
 fragment movsx := λ(: src Constant+Reg32)(: dst Constant+Reg64). (: (.program( \t 'movsx \s '% (.expression src) , '% (.expression dst) \n )) Nil);

STDLIB/default-primitives.lm

@@ -157,44 +157,182 @@ fragment - := λ(: l GlobalVariable+U64)(: r Constant+U64). (: (
    (.expression( 'r15 ))
 ) Reg64+U64);
 
-fragment == := λ(: l U64+Reg64)(: r U64+Reg64). (: (
-   (.program (
-      \t 'cmp \s '% (.expression l) , '% (.expression r) \n
-   ))
-   (.expression( 'je ))
-) BranchConditional);
-fragment == := λ(: l U64+Reg64)(: r U64+Literal+Constant). (: (
-   (.program (
-      \t 'cmp \s '$ (.expression r) , '% (.expression l) \n
-   ))
-   (.expression( 'je ))
-) BranchConditional);
-fragment == := λ(: l U64+Literal+Constant)(: r U64+Reg64). (: (
-   (.program (
-      \t 'cmp \s '$ (.expression l) , '% (.expression r) \n
-   ))
-   (.expression( 'je ))
-) BranchConditional);
-fragment == := λ(: l U64+GlobalVariable)(: r U64+Literal+Constant). (: (
-   (.program (
-      \t 'mov \s '$ (.expression l) , '%r15 \n
-      \t 'mov \s '0 \[ '%r15 \] , \s '%r15 \n
-      \t 'cmp \s '$ (.expression r) , '%r15 \n
-   ))
-   (.expression( 'je ))
-) BranchConditional);
-fragment == := λ(: l U64+LocalVariable)(: r U64+Literal+Constant). (: (
-   (.program (
-      \t 'cmp \s '$ (.expression r) , (.expression l) \[ '%rbp \] \n
-   ))
-   (.expression( 'je ))
-) BranchConditional);
-fragment == := λ(: l U64+Literal+Constant)(: r U64+GlobalVariable). (: (
-   (.program (
-      \t 'mov \s '$ (.expression r) , '%r15 \n
-      \t 'mov \s '0 \[ '%r15 \] , \s '%r15 \n
-      \t 'cmp \s '$ (.expression l) , '%r15 \n
-   ))
-   (.expression( 'je ))
-) BranchConditional);
+== := λ(: l U8)(: r U8). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14B ))
+   (mov( r R15B ))
+   (cmp( R14B R15B ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
+== := λ(: l U16)(: r U16). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14W ))
+   (mov( r R15W ))
+   (cmp( R14W R15W ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
+== := λ(: l U32)(: r U32). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14D ))
+   (mov( r R15D ))
+   (cmp( R14D R15D ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
+== := λ(: l U64)(: r U64). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14 ))
+   (mov( r R15 ))
+   (cmp( R14 R15 ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
+
+
+== := λ(: l I8)(: r I8). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14B ))
+   (mov( r R15B ))
+   (cmp( R14B R15B ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
+== := λ(: l I16)(: r I16). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14W ))
+   (mov( r R15W ))
+   (cmp( R14W R15W ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
+== := λ(: l I32)(: r I32). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14D ))
+   (mov( r R15D ))
+   (cmp( R14D R15D ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
+== := λ(: l I64)(: r I64). (: (tail(
+   (push R14)
+   (push R15)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+   (mov( l R14 ))
+   (mov( r R15 ))
+   (cmp( R14 R15 ))
+   (je end-true)
+   (jmp end-false)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
 

STDLIB/default-stdlib.lm

@@ -183,9 +183,35 @@ print := λ(: x I8). (: (tail(
 )) Nil);
 
 == := λ(: l U8[])(: r U8[]). (: (tail(
-   123u8
-   123u8
-)) U8);
+   (let c1 0u8)
+   (let c2 0u8)
+   (gensym-label start)
+   (gensym-label end-true)
+   (gensym-label end-false)
+   (gensym-label end)
+#   (mov( l R15 ))
+#   (mov( r R14 ))
+#   (label start )
+#   (mov( R15 0u64 c1 ))
+#   (mov( R14 0u64 c2 ))
+#   (push R14)
+#   (push R15)
+   (if (==( c1 c2 )) () (jmp end-false))
+#   (if (==( c1 0u8 )) () (jmp end-true))
+#   (pop R15)
+#   (pop R14)
+#   (inc R14)
+#   (inc R15)
+#   (jmp start)
+   (label end-true)
+   (mov( 1u64 RAX ))
+   (jmp( end ))
+   (label end-false)
+   (mov( 0u64 RAX ))
+   (jmp( end ))
+   (label end)
+   (as RAX U64)
+)) U64);
 
 cons-page-tail := 0u64;
 malloc := λ (: sz U64) . (: (tail(