Strict tokenize 4

Cargo.toml

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

Makefile

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

PRODUCTION/codegen-strict.lm

@@ -251,8 +251,14 @@ compile-expr-strict := λctx e offset used . (tail(
                      ()
                      (True (set e1 (expr::set-expr( (expr::new ()) '1 ))))
                      (False (set e1 (expr::set-expr( (expr::new ()) '0 ))))
-                     ('\\o (set e1 (expr::set-expr( (expr::new ()) '35 ))))
+                     ('\\t (set e1 (expr::set-expr( (expr::new ()) '9 ))))
                      ('\\n (set e1 (expr::set-expr( (expr::new ()) '10 ))))
+                     ('\\s (set e1 (expr::set-expr( (expr::new ()) '32 ))))
+                     ('\\o (set e1 (expr::set-expr( (expr::new ()) '35 ))))
+                     ('\\` (set e1 (expr::set-expr( (expr::new ()) '39 ))))
+                     ('\\[ (set e1 (expr::set-expr( (expr::new ()) '40 ))))
+                     ('\\] (set e1 (expr::set-expr( (expr::new ()) '41 ))))
+                     ('\\: (set e1 (expr::set-expr( (expr::new ()) '59 ))))
                      (_ (set e1 (expr::set-expr( (expr::new ()) lval ))))
                   ))
                ))
@@ -278,8 +284,14 @@ compile-expr-strict := λctx e offset used . (tail(
                      ()
                      (True (set e1 (expr::set-expr( (expr::new ()) '1 ))))
                      (False (set e1 (expr::set-expr( (expr::new ()) '0 ))))
-                     ('\\o (set e1 (expr::set-expr( (expr::new ()) '35 ))))
+                     ('\\t (set e1 (expr::set-expr( (expr::new ()) '9 ))))
                      ('\\n (set e1 (expr::set-expr( (expr::new ()) '10 ))))
+                     ('\\s (set e1 (expr::set-expr( (expr::new ()) '32 ))))
+                     ('\\o (set e1 (expr::set-expr( (expr::new ()) '35 ))))
+                     ('\\` (set e1 (expr::set-expr( (expr::new ()) '39 ))))
+                     ('\\[ (set e1 (expr::set-expr( (expr::new ()) '40 ))))
+                     ('\\] (set e1 (expr::set-expr( (expr::new ()) '41 ))))
+                     ('\\: (set e1 (expr::set-expr( (expr::new ()) '59 ))))
                      (_ (set e1 (expr::set-expr( (expr::new ()) lval ))))
                   ))
                ))

PRODUCTION/utility.lm

@@ -341,6 +341,10 @@ label-case-atom := λk . (tail(
          (set nk (nk '_RP_))
          (set k (tail-string k))
       ))
+      ('! (
+         (set nk (nk '_EX_))
+         (set k (tail-string k))
+      ))
       ('$ (
          (set nk (nk '_DS_))
          (set k (tail-string k))
@@ -594,6 +598,7 @@ escape-escape-char := λc . match c (
    ()
    ( '[ '\[ )
    ( '] '\] )
+   ( '` '' )
    ( '\\ '\\\\ )
    ( ': '\: )
    ( 'o '\o )

STDLIB/default-instruction-set.lm

@@ -33,7 +33,7 @@ fragment mov := λ(: src LocalVariable+Sized<size>)(: dst LocalVariable). (: (
          )) \[ '%rbp \] \n      
       ))
       (if-eq size 4 (
-         \t 'mov \s (.expression src) \[ '%rbp \] , \s '%r15d \n
+         \t 'mov \s (+( (.expression src) (*( 4  )) )) \[ '%rbp \] , \s '%r15d \n
          \t 'mov \s '%r15d , \s (.expression dst) \[ '%rbp \] \n
       ))
       (if-eq size 2 (
@@ -100,13 +100,13 @@ fragment push := λ(: src Reg64+Array<Sized<size>,max>)(: index Literal+Constant
          )) \[ '% (.expression src) \] \n
       ))
       (if-eq size 4 (
-         \t 'pushq \s (.expression index) \[ '% (.expression src) \] \n
+         \t 'pushq \s (*( (.expression index) size )) \[ '% (.expression src) \] \n
       ))
       (if-eq size 2 (
-         \t 'pushq \s (.expression index) \[ '% (.expression src) \] \n
+         \t 'pushq \s (*( (.expression index) size )) \[ '% (.expression src) \] \n
       ))
       (if-eq size 1 (
-         \t 'pushq \s (.expression index) \[ '% (.expression src) \] \n
+         \t 'pushq \s (*( (.expression index) size )) \[ '% (.expression src) \] \n
       ))
    ))
 ) Nil);
@@ -143,12 +143,34 @@ fragment pop := λ(: src LocalVariable+Sized<size>). (: (
 fragment mov := λ(: src LocalVariable+Sized<size>)(: index Literal+Constant)(: dst Reg64+x[]). (: (
    (.program (
       (\t 'mov \s '% (.expression dst) , \s '%r14 \n)
+      (\t 'add \s '$ (*( index size )) , \s '%r14 \n)
       (for word-offset in (range( 0 (/( size 8 )) )) (
          \t 'movq \s (+( (.expression src) (*( word-offset 8 )) )) \[ '%rbp \] , \s '%r15 \n
          \t 'movq \s '%r15 , \s (*( word-offset 8 )) \[ '%r14 \] \n
       ))
    ))
 ) Nil);
+fragment mov := λ(: src LocalVariable+Sized<size>)(: index Literal+Constant)(: dst LocalVariable+Array<Sized<size>,?>). (: (
+   (.program (
+      \t 'mov \s (.expression dst) \[ '%rbp \] , \s '%r14 \n
+      (for word-offset in (range( 0 (/( size 8 )) )) (
+         \t 'mov \s (+( (+( (*( word-offset 8 )) (.expression src) )) (*( index size )) )) \[ '%rbp \] , '%r15 \n
+         \t 'mov \s '%r15 , \s (+( (*( word-offset 8 )) (*( index size )) )) \[ '%r14 \] \n
+      ))
+      (if-eq size 4 (
+         \t 'mov \s (+( (.expression src) (*( index size )) )) \[ '%rbp \] , '%r15d \n
+         \t 'mov \s '%r15d , \s (*( index size )) \[ '%r14 \] \n
+      ))
+      (if-eq size 2 (
+         \t 'mov \s (+( (.expression src) (*( index size )) )) \[ '%rbp \] , '%r15w \n
+         \t 'mov \s '%r15w , \s (*( index size )) \[ '%r14 \] \n
+      ))
+      (if-eq size 1 (
+         \t 'mov \s (+( (.expression src) (*( index size )) )) \[ '%rbp \] , '%r15b \n
+         \t 'mov \s '%r15b , \s (*( index size )) \[ '%r14 \] \n
+      ))
+   ))
+) Nil);
 fragment mov := λ(: src Reg64)(: index Literal+Constant)(: dst LocalVariable+Sized<size>). (: (
    (.program (
       (\t 'mov \s '% (.expression src) , \s '%r14 \n)
@@ -170,19 +192,19 @@ fragment mov := λ(: src Reg64)(: index Literal+Constant)(: dst LocalVariable+Si
       ))
    ))
 ) Nil);
-fragment mov := λ(: src Literal+Constant)(: index Literal+Constant)(: dst LocalVariable+Sized<size>). (: (
+fragment mov := λ(: src Literal+Constant)(: index Literal+Constant)(: dst LocalVariable+Array<Sized<size>,?>). (: (
    (.program (
       (if-eq size 8 (
-         \t 'movq \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \n
+         \t 'movq \s '$ (.expression src) , \s (+( (.expression dst) (*( index size )) )) \[ '%rbp \] \n
       ))
       (if-eq size 4 (
-         \t 'movl \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \n
+         \t 'movl \s '$ (.expression src) , \s (+( (.expression dst) (*( index size )) )) \[ '%rbp \] \n
       ))
       (if-eq size 2 (
-         \t 'movw \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \n
+         \t 'movw \s '$ (.expression src) , \s (+( (.expression dst) (*( index size )) )) \[ '%rbp \] \n
       ))
       (if-eq size 1 (
-         \t 'movb \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \n
+         \t 'movb \s '$ (.expression src) , \s (+( (.expression dst) (*( index size )) )) \[ '%rbp \] \n
       ))
    ))
 ) Nil);
@@ -323,5 +345,10 @@ fragment add := λ(: src Reg16)(: dst Reg16). (: (.program( \t 'add \s '% (.expr
 fragment add := λ(: src Reg32)(: dst Reg32). (: (.program( \t 'add \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
 fragment add := λ(: src Reg64)(: dst Reg64). (: (.program( \t 'add \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
 
+fragment sub := λ(: src Reg8)(: dst Reg8). (: (.program( \t 'sub \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
+fragment sub := λ(: src Reg16)(: dst Reg16). (: (.program( \t 'sub \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
+fragment sub := λ(: src Reg32)(: dst Reg32). (: (.program( \t 'sub \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
+fragment sub := λ(: src Reg64)(: dst Reg64). (: (.program( \t 'sub \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
+
 fragment push := λ(: l Reg64). (: (.program( \t 'push \s '% (.expression l) \n )) Nil);
 fragment pop := λ(: l Reg64). (: (.program( \t 'pop \s '% (.expression l) \n )) Nil);

STDLIB/default-primitives.lm

@@ -10,6 +10,61 @@ fragment type I64;    size I64 8;    atom suffix I64    _i64;
 fragment type ASCII;  size ASCII 1;  atom suffix ASCII  _c;
 fragment type String; size String 8; atom suffix String _s;
 
+#[] := λ(: l Array<Sized<8>,?>)(: li U64). (: (
+#   (mov( l R15 ))
+#   (mov( r R14 ))
+#   (shl( 3_u64 R14 ))
+#   (add( R14 R15 ))
+#   (mov( R15 0_u64 RAX ))
+#   (as RAX x)
+#) x);
+#[] := λ(: l Array<Sized<4>,?>)(: li U64). (: (
+#   (mov( l R15 ))
+#   (mov( r R14 ))
+#   (shl( 2_u64 R14 ))
+#   (add( R14 R15 ))
+#   (mov( R15 0_u64 RAX ))
+#   (as RAX x)
+#) x);
+#[] := λ(: l Array<Sized<2>,?>)(: li U64). (: (
+#   (mov( l R15 ))
+#   (mov( r R14 ))
+#   (shl( 1_u64 R14 ))
+#   (add( R14 R15 ))
+#   (mov( R15 0_u64 RAX ))
+#   (as RAX x)
+#) x);
+#[] := λ(: l Array<Sized<1>,?>)(: li U64). (: (
+#   (mov( l R15 ))
+#   (mov( r R14 ))
+#   (add( R14 R15 ))
+#   (mov( R15 0_u64 RAX ))
+#   (as RAX x)
+#) x);
+
+fragment [] := λ(: l LocalVariable+Array<x+Sized<1>,?>)(: r LocalVariable+U64). (: (
+   (.program (
+      \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r15 \n
+      \t 'mov \s (.expression r) \[ '%rbp \] , \s '%r14 \n
+      \t 'add \s '%r14 , \s '%r15 \n
+      \t 'mov \s '0 \[ '%r15 \] , \s '%r15b \n
+   ))
+   (.expression( 'r15b ))
+) x+Reg8);
+
+
+fragment [] := λ(: l LocalVariable+Array<x,?>)(: r GlobalVariable+U64). (: (
+   (.program (
+      \t 'mov \s '$ (.expression l) , \s '%r15 \n
+      \t 'mov \s '$ (.expression r) , \s '%r14 \n
+      \t 'mov \s '0 \[ '%r14 \] , \s '%r14 \n
+      \t 'shl \s '$3 , \s '%r14 \n
+      \t 'add \s '%r14 , \s '%r15 \n
+      \t 'mov \s '0 \[ '%r15 \] , \s '%r15 \n
+   ))
+   (.expression( 'r15 ))
+) x+Reg64);
+
 fragment [] := λ(: l GlobalVariable+Array<x,?>)(: r GlobalVariable+U64). (: (
    (.program (
       \t 'mov \s '$ (.expression l) , \s '%r15 \n
@@ -77,6 +132,13 @@ fragment > := λ(: l LocalVariable+U64)(: r Constant+U64). (: (
    (as RAX U64)
 )) U64);
 
+- := λ(: l U64)(: r U64). (: (tail(
+   (mov( r R8 ))
+   (mov( l RAX ))
+   (sub( R8 RAX ))
+   (as RAX U64)
+)) U64);
+
 fragment branchtrue := λ(: _ Nil). (: (
    (.expression( 'jmp ))
 ) BranchConditional);
@@ -85,30 +147,28 @@ fragment branchfalse := λ(: _ Nil). (: (
    (.expression( 'jne ))
 ) BranchConditional);
 
-fragment - := λ(: l LocalVariable+U8)(: r Constant+U8). (: (
-   (.program( \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r12b \n \t 'sub \s '$ (.expression r) , \s '%r12b \n ))
-   (.expression( 'r12b ))
-) Reg8+U8);
-fragment - := λ(: l LocalVariable+U16)(: r Constant+U16). (: (
-   (.program( \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r12w \n \t 'sub \s '$ (.expression r) , \s '%r12w \n ))
-   (.expression( 'r12w ))
-) Reg16+U16);
-fragment - := λ(: l LocalVariable+U32)(: r Constant+U32). (: (
-   (.program( \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r12d \n \t 'sub \s '$ (.expression r) , \s '%r12d \n ))
-   (.expression( 'r12d ))
-) Reg32+U32);
-fragment - := λ(: l LocalVariable+U64)(: r Constant+U64). (: (
-   (.program( \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r12 \n \t 'sub \s '$ (.expression r) , \s '%r12 \n ))
-   (.expression( 'r12 ))
-) Reg64+U64);
-fragment - := λ(: l GlobalVariable+U64)(: r Constant+U64). (: (
-   (.program(
-      \t 'mov \s '$ (.expression l) , \s '%r15 \n
-      \t 'mov \s '0 \[ '%r15 \] , \s '%r15 \n
-      \t 'sub \s '$ (.expression r) , \s '%r15 \n
-   ))
-   (.expression( 'r15 ))
-) Reg64+U64);
+!= := λ(: 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-false)
+   (jmp end-true)
+   (label end-true)
+   (mov( 1_u64 RAX ))
+   (jmp end)
+   (label end-false)
+   (mov( 0_u64 RAX ))
+   (jmp end)
+   (label end)
+   (pop R15)
+   (pop R14)
+   (as RAX U64)
+)) U64);
 
 == := λ(: l U8)(: r U8). (: (tail(
    (push R14)

STDLIB/default-stdlib.lm

@@ -11,13 +11,13 @@ close := λ(: x S). (: (tail(
 )) S[]);
 
 non-zero := λ(: s S). (: (tail(
-   (mov( 1_u64 RAX ))
+   (let r 1_u64)
    (match s (
       ()
-      (SNil (mov( 0_u64 RAX )))
+      (SNil (set r 0_u64))
       (_ ())
    ))
-   (as RAX U64)
+   r
 )) U64);
 
 print := λ(: x S). (: (tail(
@@ -305,6 +305,34 @@ tail-string := λ(: s String). (: (tail(
 )) String);
 
 clone-rope := λ(: s S). (: (tail(
-   (let x 'TODO\sclone-rope_s)
-   x
+   (let r (malloc( 0_u64 )))
+   (clone-rope-impl s )
+   (let rtail (as (malloc( 1_u64 )) U8[]))
+   (mov( 0_u8 0_u64 rtail ))
+   (as r String)
+)) String);
+clone-rope-impl := λ(: s S). (: (match s (
+   ()
+   ( SNil () )
+   ( (SCons( l r )) (tail(
+      (clone-rope-impl (maybe-deref l))
+      (clone-rope-impl (maybe-deref r))
+   )))
+   ( (SAtom a) (tail(
+      (let ci 0_u64)
+      (let c ([]( (as a U8[]) ci )))
+      (while (!=( c 0_u8 )) (
+         (let t (as (malloc( 1_u64 )) U8[]))
+         (mov( c 0_u64 t ))
+         (set ci (+( ci 1_u64 )))
+         (set c ([]( (as a U8[]) ci )))
+      ))
+   )))
+)) Nil);
+
+clone-rope := λ(: s U8). (: (tail(
+   (let x (as (malloc 2_u64) U8[]))
+   (mov( s 0_u64 x ))
+   (mov( 0_u8 1_u64 x ))
+   (as x String)
 )) String);

STRICT/parse.lm

@@ -1,5 +1,6 @@
 
 parse := λ. (: (tail(
-   ()
-   ()
+   (print 'Parse:\s_s)
+   (print ast-tokenized-program)
+   (print '\n_s)
 )) Nil);