Merge pull request #232 from andrew-johnson-4/strict-tokenize-2

Strict tokenize 2

Author: andrew-johnson-4

BOOTSTRAP/cli.s

@@ -75514,7 +75514,7 @@ uuid_000000000000047c:
 	pop %r13
 	push %r12
 	push %r13
-	mov $uuid_0000000000000030, %r12
+	mov $uuid_0000000000000002, %r12
 	mov $0, %r13
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
@@ -75605,7 +75605,7 @@ uuid_000000000000047c:
 	mov -80(%rbp),%r13
 	push %r12
 	push %r13
-	mov $uuid_000000000000002d, %r12
+	mov $uuid_000000000000003f, %r12
 	mov $0, %r13
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
@@ -76690,7 +76690,7 @@ uuid_000000000000048e:
 	pop %r13
 	push %r12
 	push %r13
-	mov $uuid_0000000000000030, %r12
+	mov $uuid_0000000000000002, %r12
 	mov $0, %r13
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)
@@ -76781,7 +76781,7 @@ uuid_000000000000048e:
 	mov -80(%rbp),%r13
 	push %r12
 	push %r13
-	mov $uuid_000000000000002d, %r12
+	mov $uuid_000000000000003f, %r12
 	mov $0, %r13
 	call uuid_0000000000000003
 	mov %r12, 0(%r8)

Cargo.toml

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

PRODUCTION/codegen-strict.lm

@@ -122,9 +122,9 @@ compile-expr-strict := λctx e offset used . (tail(
                   ( et (tail(
                      (set e1 (expr::set-prog( e1 (
                         (expr::get-prog e1)
-                        \t 'cmp \s '$1 , \s '%rax \n
+                        \t 'cmp \s '$0 , \s '%rax \n
                      ))))
-                     (set e1 (expr::set-expr( e1 'je )))
+                     (set e1 (expr::set-expr( e1 'jne )))
                   )))
                ))
 
@@ -165,9 +165,9 @@ compile-expr-strict := λctx e offset used . (tail(
                   ( _ (tail(
                      (set e1 (expr::set-prog( e1 (
                         (expr::get-prog e1)
-                        \t 'cmp \s '$1 , \s '%rax \n
+                        \t 'cmp \s '$0 , \s '%rax \n
                      ))))
-                     (set e1 (expr::set-expr( e1 'je )))
+                     (set e1 (expr::set-expr( e1 'jne )))
                   )))
                ))
                (set e4 e1)

STDLIB/default-instruction-set.lm

@@ -165,6 +165,13 @@ fragment mov := λ(: src Literal+Constant)(: index Literal+Constant)(: dst Local
    ))
 ) Nil);
 
+fragment mov := λ(: src Sized<1>[]+LocalVariable)(: index Literal+Constant)(: dst Reg8). (: (
+   (.program(
+      \t 'mov \s (.expression src) \[ '%rbp \] , \s '%r15 \n
+      \t 'mov \s (.expression index) \[ '%r15 \] , \s '% (.expression dst) \n
+   ))
+) Nil);
+
 fragment mov := λ(: src LocalVariable)(: dst Constant+Reg64). (: ( (.program( \t 'mov \t (.expression src) \[ '%rbp \] , \s '% (.expression dst) \n)) ) Nil);
 fragment mov := λ(: src GlobalVariable)(: dst Constant+Reg64). (: ( (.program(
    \t 'mov \t '$ (.expression src) , \s '% (.expression dst) \n
@@ -241,6 +248,11 @@ fragment mov := λ(: src LocalVariable)(: dst Reg16). (: (.program( \t 'mov \s (
 fragment mov := λ(: src LocalVariable)(: dst Reg32). (: (.program( \t 'mov \s (.expression src) \[ '%rbp \] , \s '% (.expression dst) \n )) Nil);
 fragment mov := λ(: src LocalVariable)(: dst Reg64). (: (.program( \t 'mov \s (.expression src) \[ '%rbp \] , \s '% (.expression dst) \n )) Nil);
 
+fragment mov := λ(: src Constant+Literal+Sized<1>)(: dst Reg8). (: (.program( \t 'mov \s '$ (.expression src) , \s '% (.expression dst) \n )) Nil);
+fragment mov := λ(: src Constant+Literal+Sized<2>)(: dst Reg16). (: (.program( \t 'mov \s '$ (.expression src) , \s '% (.expression dst) \n )) Nil);
+fragment mov := λ(: src Constant+Literal+Sized<4>)(: dst Reg32). (: (.program( \t 'mov \s '$ (.expression src) , \s '% (.expression dst) \n )) Nil);
+fragment mov := λ(: src Constant+Literal+Sized<8>)(: dst Reg64). (: (.program( \t 'mov \s '$ (.expression src) , \s '% (.expression dst) \n )) Nil);
+
 fragment push := λ(: dst Reg8). (: (.program( \t 'mov \s '% (.expression dst) , '%r15b \n \t 'push \s '%r15 \n )) Nil);
 fragment push := λ(: dst Reg16). (: (.program( \t 'mov \s '% (.expression dst) , '%r15w \n \t 'push \s '%r15 \n )) Nil);
 fragment push := λ(: dst Reg32). (: (.program( \t 'mov \s '% (.expression dst) , '%r15d \n \t 'push \s '%r15 \n )) Nil);

STDLIB/default-primitives.lm

@@ -1,13 +1,14 @@
 
-fragment type U8;  size U8 1;  atom suffix U8  u8;
-fragment type U16; size U16 2; atom suffix U16 u16;
-fragment type U32; size U32 4; atom suffix U32 u32;
-fragment type U64; size U64 8; atom suffix U64 u64;
-fragment type I8;  size I8 1;  atom suffix I8  i8;
-fragment type I16; size I16 2; atom suffix I16 i16;
-fragment type I32; size I32 4; atom suffix I32 i32;
-fragment type I64; size I64 8; atom suffix I64 i64;
-                size String 8; atom suffix String _s;
+fragment type U8;     size U8 1;     atom suffix U8  u8;
+fragment type U16;    size U16 2;    atom suffix U16 u16;
+fragment type U32;    size U32 4;    atom suffix U32 u32;
+fragment type U64;    size U64 8;    atom suffix U64 u64;
+fragment type I8;     size I8 1;     atom suffix I8  i8;
+fragment type I16;    size I16 2;    atom suffix I16 i16;
+fragment type I32;    size I32 4;    atom suffix I32 i32;
+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;
 
 fragment [] := λ(: l GlobalVariable+Array<x,?>)(: r GlobalVariable+U64). (: (
    (.program (

STDLIB/default-stdlib.lm

@@ -104,6 +104,11 @@ print := λ(: x U64). (: (tail(
    (jne( pdigits ))
 )) Nil);
 
+print := λ(: cs ASCII). (: (tail(
+   (system-call( 1u64 1u64 (as (& cs) U64) 1u64 ))
+   ()
+)) Nil);
+
 print := λ(: x I64). (: (tail(
    (let cs 0u8)
    (gensym-label unsigned)
@@ -252,7 +257,6 @@ read-file := λ(: fp String). (: (tail(
    (while (==( more Trueu8 )) (tail(
       (let rdsz (system-call( 0u64 fd (as stail U64) 1024u64 )))
       (malloc( rdsz ))
-      (print rdsz)
       (if (==( rdsz 0u64 )) (
          (set more Falseu8)
       ) (
@@ -267,4 +271,25 @@ read-file := λ(: fp String). (: (tail(
    (as shead String)
 )) String);
 
+head-string := λ(: s String). (: (tail(
+   (if (==( (as s U64) 0u64 )) (
+      (mov( 0u8 AL ))
+   ) (
+      (mov( (as s U8[]) 0u64 AL ))
+   ))
+   (as AL U8)
+)) U8);
 
+tail-string := λ(: s String). (: (tail(
+   (if (==( (as s U64) 0u64 )) (
+      (mov( 0u64 RAX ))
+   ) (
+      (if (head-string s) (tail(
+         (mov( (as s U64) RAX ))
+         (inc( RAX ))
+      )) (
+         (mov( 0u64 RAX ))
+      ))
+   ))
+   (as RAX String)
+)) String);

STRICT/cli.lm

@@ -38,7 +38,6 @@ main := λ(: argc U64)(: argv String[]).(tail(
          ('--macro_s (set config-preprocess Trueu8))
          ('--nomacro_s (set config-preprocess Falseu8))
          ('-o_s (tail(
-            (print 'O_s)
             (set argi (+( argi 1u64 )))
             (set config-target ([]( argv argi )))
          )))

STRICT/tokenize.lm

@@ -3,10 +3,10 @@ type Tokens EOF | (HeadOrder( String , Tokens[] )) | (TailOrder( Tokens[] , Stri
 
 tokenize := λ(: fp String). (: (tail(
    (let text (read-file fp))
-   (while (head-string text) (
-      (print (head-string text))
+   (while (head-string text) (tail(
+      (print (as (head-string text) ASCII))
       (set text (tail-string text))
-   ))
+   )))
 )) Nil);
 
 close := λ(: x Tokens). (: (tail(

tests/strict/head-string.lm

@@ -0,0 +1,8 @@
+
+import STDLIB/default-instruction-set.lm;
+import STDLIB/default-primitives.lm;
+import STDLIB/default-rules.lm;
+import STDLIB/default-stdlib.lm;
+
+main := (print (as (head-string 'ABC_s) ASCII));
+

tests/strict/head-string.lm.out

@@ -0,0 +1 @@
+A

tests/strict/tail-string.lm

@@ -0,0 +1,8 @@
+
+import STDLIB/default-instruction-set.lm;
+import STDLIB/default-primitives.lm;
+import STDLIB/default-rules.lm;
+import STDLIB/default-stdlib.lm;
+
+main := (print (tail-string 'ABC_s));
+

tests/strict/tail-string.lm.out

@@ -0,0 +1 @@
+BC