Merge pull request #218 from andrew-johnson-4/strict-compiler-dev-3-4

Strict compiler dev 3 4

Author: andrew-johnson-4

BOOTSTRAP/cli.s

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

Cargo.toml

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

Makefile

@@ -228,7 +228,7 @@ stack-define-destructure := λ ctx lhs offset . (match lhs (
       (local return)
       (set return (expr::new()))
       (set return (expr::set-context( return ctx )))
-      (set return (expr::set-offset( return (i2s new_offset) )))
+      (set return (expr::set-offset( return (expr::get-offset more-e) )))
       return
    )))
    ( u (fail (UnknownStackArg lhs)))

PRODUCTION/stack.lm

@@ -97,6 +97,18 @@ fragment mov := λ(: src Reg64)(: index Literal+Constant)(: dst LocalVariable+Si
          \t 'movq \s (*( word-offset 8 )) \[ '%r14 \] , '%r15 \n
          \t 'movq \s '%r15 , \s (+( (.expression dst) (*( word-offset 8 )) )) \[ '%rbp \] \n
       ))
+      (if-eq size 4 (
+         \t 'movq \s '0 \[ '%r14 \] , \s '%r15 \n
+         \t 'movq \s '%r15 , \s (.expression dst) \[ '%rbp \] \n
+      ))
+      (if-eq size 2 (
+         \t 'movq \s '0 \[ '%r14 \] , \s '%r15 \n
+         \t 'movq \s '%r15 , \s (.expression dst) \[ '%rbp \] \n
+      ))
+      (if-eq size 1 (
+         \t 'movq \s '0 \[ '%r14 \] , \s '%r15 \n
+         \t 'movq \s '%r15 , \s (.expression dst) \[ '%rbp \] \n
+      ))
    ))
 ) Nil);
 

STDLIB/default-instruction-set.lm

@@ -189,20 +189,16 @@ print := λ(: x I8). (: (tail(
    (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)
+   (mov( l R8 ))
+   (mov( r R9 ))
+   (label start )
+   (mov( R8 0u64 c1 ))
+   (mov( R9 0u64 c2 ))
    (if (==( c1 c2 )) () (jmp end-false))
-#   (if (==( c1 0u8 )) () (jmp end-true))
-#   (pop R15)
-#   (pop R14)
-#   (inc R14)
-#   (inc R15)
-#   (jmp start)
+   (if (==( c1 0u8 )) () (jmp end-true))
+   (inc R8)
+   (inc R9)
+   (jmp start)
    (label end-true)
    (mov( 1u64 RAX ))
    (jmp( end ))

STDLIB/default-stdlib.lm

@@ -14,7 +14,6 @@ main := (tail(
       (print x)(print y)(print \n_s)
       (if (==( x y )) (print 'Failure\n_s) (print 'ZeroNotEqualOne\n_s) )
    ))
-   ()
    (tail(
       (let x 0u16)
       (let y 0u16)

tests/strict/ifeq.lm

@@ -0,0 +1,15 @@
+
+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 'a_s)
+   (let y 'a_s)
+   (print x)(print y)(print \n_s)
+   (if (==( x y )) (print 'AEqA\n_s) (print 'Failure\n_s) )
+   (set y 'b_s)
+   (print x)(print y)(print \n_s)
+   (if (==( x y )) (print 'Failure\n_s) (print 'ANotEqB\n_s) )
+));

tests/strict/ifstreq.lm

@@ -0,0 +1,4 @@
+aa
+AEqA
+ab
+ANotEqB

tests/strict/ifstreq.lm.out

@@ -1 +1 @@
-abcabcabc
+abc