Strict tokenize

Cargo.toml

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

Makefile

@@ -3,7 +3,7 @@ nostd: prod
 	./production --nostd -o tmp.s STRICT/cli.lm
 	as -o tmp.o tmp.s
 	ld -o tmp tmp.o
-	./tmp && echo $?
+	./tmp STRICT/cli.lm && echo $?
 
 test: prod
 	./production -o production1.s PRODUCTION/cli.lm

PRODUCTION/utility.lm

@@ -309,6 +309,10 @@ label-case-atom := λk . (tail(
          (set nk (nk '_))
          (set k (tail-string k))
       ))
+      ('+ (
+         (set nk (nk '_pl_))
+         (set k (tail-string k))
+      ))
       ('= (
          (set nk (nk '_eq_))
          (set k (tail-string k))

STDLIB/default-instruction-set.lm

@@ -148,6 +148,22 @@ fragment mov := λ(: src Reg64)(: index Literal+Constant)(: dst LocalVariable+Si
       ))
    ))
 ) Nil);
+fragment mov := λ(: src Literal+Constant)(: index Literal+Constant)(: dst LocalVariable+Sized<size>). (: (
+   (.program (
+      (if-eq size 8 (
+         \t 'movq \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \n
+      ))
+      (if-eq size 4 (
+         \t 'movl \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \n
+      ))
+      (if-eq size 2 (
+         \t 'movw \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \n
+      ))
+      (if-eq size 1 (
+         \t 'movb \s '$ (.expression src) , \s (.expression dst) \[ '%rbp \] \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(
@@ -246,6 +262,7 @@ fragment movsx := λ(: src Constant+Reg8)(: dst Constant+Reg64). (: (.program( \
 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);
 
+fragment jb := λ(: dst Label). (: (.program( \t 'jb \s (.expression dst) \n )) Nil);
 fragment jg := λ(: dst Label). (: (.program( \t 'jg \s (.expression dst) \n )) Nil);
 fragment jge := λ(: dst Label). (: (.program( \t 'jge \s (.expression dst) \n )) Nil);
 fragment jl := λ(: dst Label). (: (.program( \t 'jl \s (.expression dst) \n )) Nil);
@@ -267,5 +284,10 @@ fragment add := λ(: src Constant+Literal+Sized<8>)(: dst Reg64). (: (.program(
 
 fragment add := λ(: src LocalVariable+Sized<8>)(: dst Reg64). (: (.program( \t 'addq \s (.expression src) \[ '%rbp \] , \s '% (.expression dst) \n )) Nil);
 
+fragment add := λ(: src Reg8)(: dst Reg8). (: (.program( \t 'add \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
+fragment add := λ(: src Reg16)(: dst Reg16). (: (.program( \t 'add \s '% (.expression src) , \s '% (.expression dst) \n )) Nil);
+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 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

@@ -57,30 +57,24 @@ fragment > := λ(: l LocalVariable+U64)(: r Constant+U64). (: (
    (.expression( 'ja ))
 ) BranchConditional);
 
-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 'cmp \s '$ (.expression r) , '%r15 \n
-   ))
-   (.expression( 'jb ))
-) BranchConditional);
-fragment < := λ(: l LocalVariable+U64)(: r Constant+U64). (: (
-   (.program (
-      \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r15 \n
-      \t 'cmp \s '$ (.expression r) , '%r15 \n
-   ))
-   (.expression( 'jb ))
-) BranchConditional);
-fragment < := λ(: l LocalVariable+U64)(: r GlobalVariable+U64). (: (
-   (.program (
-      \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r15 \n
-      \t 'mov \s '$ (.expression r) , \s '%r14 \n
-      \t 'mov \s '0 \[ '%r14 \] , \s '%r14 \n
-      \t 'cmp \s '%r14 , '%r15 \n
-   ))
-   (.expression( 'jb ))
-) BranchConditional);
+< := λ(: l U64)(: r U64). (: (tail(
+   (gensym-label end)
+   (mov( 1u64 RAX ))
+   (mov( l R8 ))
+   (mov( r R9 ))
+   (cmp( R9 R8 ))
+   (jb end)
+   (mov( 0u64 RAX ))
+   (label end)
+   (as RAX U64)
+)) U64);
+
++ := λ(: l U64)(: r U64). (: (tail(
+   (mov( l R8 ))
+   (mov( r RAX ))
+   (add( R8 RAX ))
+   (as RAX U64)
+)) U64);
 
 fragment branchtrue := λ(: _ Nil). (: (
    (.expression( 'jmp ))
@@ -90,49 +84,6 @@ fragment branchfalse := λ(: _ Nil). (: (
    (.expression( 'jne ))
 ) BranchConditional);
 
-fragment + := λ(: l LocalVariable+U8)(: r LocalVariable+U8). (: (
-   (.program(
-      \t 'mov \s (.expression l) \[ '%rbp \] , \s '%al \n
-      \t 'mov \s (.expression r) \[ '%rbp \] , \s '%r12b \n
-      \t 'add \s '%al , \s '%r12b \n
-   ))
-   (.expression( 'r12b ))
-) Reg8+U8);
-
-fragment + := λ(: l LocalVariable+U8)(: r Constant+U8). (: (
-   (.program( \t 'mov \s (.expression l) \[ '%rbp \] , \s '%r12b \n \t 'add \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 'add \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 'add \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 'add \s '$ (.expression r) , \s '%r12 \n ))
-   (.expression( 'r12 ))
-) Reg64+U64);
-
-fragment + := λ(: l GlobalVariable+U64)(: r Literal+Constant+U64). (: (
-   (.program( \t 'mov \s '$ (.expression l) , \s '%r15 \n \t 'mov \s '0 \[ '%r15 \] , '%r15 \n \t 'add \s '$ (.expression r) , \s '%r15 \n ))
-   (.expression( 'r15 ))
-) Reg64+U64);
-fragment + := λ(: l Literal+Constant+U64)(: r GlobalVariable+U64). (: (
-   (.program( \t 'mov \s '$ (.expression r) , \s '%r15 \n \t 'mov \s '0 \[ '%r15 \] , '%r15 \n \t 'add \s '$ (.expression l) , \s '%r15 \n ))
-   (.expression( 'r15 ))
-) Reg64+U64);
-
-fragment + := λ(: l GlobalVariable+U64)(: r LocalVariable+U64). (: (
-   (.program( \t 'mov \s '$ (.expression l) , \s '%r15 \n
-              \t 'mov \s '0 \[ '%r15 \] , '%r15 \n
-              \t 'mov \s (.expression r) \[ '%rbp \] , '%r14 \n
-              \t 'add \s '%r14 , \s '%r15 \n ))
-   (.expression( 'r15 ))
-) Reg64+U64);
-
 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 ))

STDLIB/default-stdlib.lm

@@ -55,10 +55,25 @@ print := λ(: x String). (: (tail(
    (inc( R15 ))
    (jmp( begin-count ))
    (label end-count)
-   (mov( 1u64 RAX )) # write
-   (mov( 1u64 RDI )) # stdout
-   (mov( x RSI )) # data
-   (syscall())
+   (system-call( 1u64 1u64 (as x U64) (as RDX U64) ))
+   ()
+)) Nil);
+
+eprint := λ(: x String). (: (tail(
+   (mov( x R15 ))
+   (mov( 0u64 RDX )) # data length
+   (gensym-label begin-count)
+   (gensym-label end-count)
+   (label begin-count)
+   (mov( 0u64 R15 R14B ))
+   (cmp( 0u8 R14B ))
+   (je( end-count ))
+   (inc( RDX ))
+   (inc( R15 ))
+   (jmp( begin-count ))
+   (label end-count)
+   (system-call( 1u64 2u64 (as x U64) (as RDX U64) ))
+   ()
 )) Nil);
 
 print := λ(: x U64). (: (tail(
@@ -84,11 +99,7 @@ print := λ(: x U64). (: (tail(
    (mov( DL cs ))
    (add( 48u8 cs ))
    (dec( R14 ))
-   (mov( 1u64 RAX )) # write
-   (mov( 1u64 RDI )) # stdout
-   (mov( (& cs) RSI )) # data
-   (mov( 1u64 RDX )) # length
-   (syscall())
+   (system-call( 1u64 1u64 (as (& cs) U64) 1u64 ))
    (cmp( 0u64 R14 ))
    (jne( pdigits ))
 )) Nil);
@@ -103,11 +114,7 @@ print := λ(: x I64). (: (tail(
    (jge( unsigned ))
    (neg( R15 ))
    (mov( 45u8 cs ))
-   (mov( 1u64 RAX )) # write
-   (mov( 1u64 RDI )) # stdout
-   (mov( (& cs) RSI )) # data
-   (mov( 1u64 RDX )) # length
-   (syscall())
+   (system-call( 1u64 1u64 (as (& cs) U64) 1u64 ))
 
    (label unsigned)
    (mov( R15 RAX ))
@@ -125,11 +132,7 @@ print := λ(: x I64). (: (tail(
    (mov( DL cs ))
    (add( 48u8 cs ))
    (dec( R14 ))
-   (mov( 1u64 RAX )) # write
-   (mov( 1u64 RDI )) # stdout
-   (mov( (& cs) RSI )) # data
-   (mov( 1u64 RDX )) # length
-   (syscall())
+   (system-call( 1u64 1u64 (as (& cs) U64) 1u64 ))
    (cmp( 0u64 R14 ))
    (jne( pdigits ))
 )) Nil);
@@ -224,3 +227,64 @@ malloc := λ (: sz U64) . (: (tail(
    (set cons-page-tail (as R8 U64))
    (as curr ?[])
 )) ?[]);
+
+system-call := λ(: rax U64)(: rdi U64)(: rsi U64)(: rdx U64). (: (tail(
+   (mov( rax RAX ))
+   (mov( rdi RDI ))
+   (mov( rsi RSI ))
+   (mov( rdx RDX ))
+   (syscall())
+   (as RAX U64)
+)) U64);
+
+read-file := λ(: fp String). (: (tail(
+   (let fd (system-call( 2u64 (as fp U64) 0u64 0u64 )))
+   (mov( fd RAX ))
+   (if (==( (as AL U8) 254u8 )) (tail(
+      (eprint 'Unable\sto\sopen\sfile:\s_s)
+      (eprint fp)
+      (eprint '\n_s)
+      (exit 1u64)
+   )) ())
+   (let shead (as (malloc( 0u64 )) U8[]))
+   (let stail shead)
+   (let more Trueu8)
+   (while (==( more Trueu8 )) (tail(
+      (let rdsz (system-call( 0u64 fd (as stail U64) 1024u64 )))
+      (malloc( rdsz ))
+      (print rdsz)
+      (if (==( rdsz 0u64 )) (
+         (set more Falseu8)
+      ) (
+         (set stail (as (
+           (+( (as stail U64) rdsz ))
+         ) U8[]))
+      ))
+   )))
+   (system-call( 3u64 fd 0u64 0u64 ))
+   (let eos (as (malloc( 1u64 )) U8[]))
+   (mov( 0u8 0u64 eos ))
+   (as shead String)
+)) String);
+
+
+#   # move data from buffer into string
+#   'load_file_loop:                       \n
+#   \t 'cmp \s '$0, \s '%r10               \n
+#   \t 'je \s 'load_file_bufempty          \n
+#   (allocate-atom-grow '$1)
+#   \t 'movb \s '0 \[ '%r11 \] , \s '%bl    \n
+#   \t 'mov \s '%bl, \s '0 \[ '%r9 \]      \n
+#   \t 'inc \s '%r9                        \n
+#   \t 'inc \s '%r11                       \n
+#   \t 'dec \s '%r10                       \n
+#   \t 'jmp \s 'load_file_loop             \n
+
+#   # close file
+#   (system-call( '$3 '%rax '$0 '$0 ))
+#   (allocate-atom-grow '$1)
+#   \t 'movb \s '$0, \s '0 \[ '%r9 \]       \n
+#   \t 'inc \s '%r9                        \n
+#   \t 'mov \s '%r8, \s '%r12              \n
+#   \t 'mov \s '$0, \s '%r13               \n
+#   \t 'ret                                \n

STRICT/tokenize.lm

@@ -2,6 +2,8 @@
 type Tokens EOF;
 
 tokenize := λ(: fp String). (: (tail(
-   ()
-   ()
+   (print 'Tokenize:\s_s)
+   (print fp)
+   (print '\n_s)
+   (print (read-file fp))
 )) Nil);