Merge pull request #1027 from andrew-johnson-4/vector-primitive

Vector primitive

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "lambda_mountain"
-version = "1.19.33"
+version = "1.19.34"
 authors = ["Andrew <[email protected]>"]
 license = "MIT"
 description = "Typed Macro Assembler (backed by Coq proofs-of-correctness)"

Makefile

@@ -1,6 +1,6 @@
 
 dev: install-production
-	lm EXAMPLES/type-declarations.lsts
+	lm t.lsts
 	cc -O3 tmp.c
 	./a.out
 

PLATFORM/C/LIB/common-macros.lm

@@ -7,6 +7,15 @@ macro ( ('let x y) )
 macro ( ('set lhs rhs) )
       ( (mov( rhs lhs )) );
 
+macro ( ('set ('macro::lhs-field( base field )) rhs) )
+      ( (macro::concat( set. field )) (base rhs) );
+
+macro ( ('set ('macro::lhs-index( base index )) rhs) )
+      ( set[] (base index rhs) );
+
+macro ( ('set ('macro::lhs-index( (macro:lhs-field( base field )) index )) rhs) )
+      ( set[] ( ((macro::concat( . field )) base) index rhs) );
+
 macro ( ('while cond body) )
       ( (primitive::while( (as body Nil) (into-branch-conditional cond) )) );
 

PLATFORM/C/LIB/default.lm

@@ -21,6 +21,7 @@ import PLATFORM/C/LIB/s.lm;
 import PLATFORM/C/LIB/tuple.lm;
 import PLATFORM/C/LIB/list.lm;
 import PLATFORM/C/LIB/list.lsts;
+import PLATFORM/C/LIB/vector.lsts;
 import PLATFORM/C/LIB/hashtable.lm;
 import PLATFORM/C/LIB/array.lm;
 import PLATFORM/C/LIB/io.lm;

PLATFORM/C/LIB/hashtable.lm

@@ -73,6 +73,10 @@ type HashtableIs<k,v> (HashtableIs( occupied:U64 , capacity:U64 , contents:Tuple
 
 type HashtableEq<k,v> (HashtableEq( occupied:U64 , capacity:U64 , contents:Tuple<k,v>[] )) | HashtableEqEOF;
 
+set[] := λ(: table HashtableEq<k,v>)(: key k)(: value v). (: (
+   (.bind( table key value ))
+) HashtableEq<k,v>);
+
 .bind := λ(: table HashtableEq<k,v>)(: key k)(: value v). (: (
    (if (is( table (: HashtableEqEOF HashtableEq<k,v>) )) (
       (set table (HashtableEq( 0_u64 0_u64 (as 0_u64 Tuple<k,v>[]) )))

PLATFORM/C/LIB/vector.lsts

@@ -0,0 +1,20 @@
+
+type Vector<t> = Vector { data: t[], length: U64, capacity: U64 };
+
+let mk-vector(type: Type<t>, capacity: U64): Vector<t> = (
+   let data-sz = sizeof(t) * capacity;
+   Vector { (malloc(data-sz) as t[]), 0, capacity }
+);
+
+let .push(v: Vector<t>, i: t): Vector<t> = (
+   if v.length >= v.capacity {
+      fail("Vector Overflow during .push")
+   };
+#   v.data[v.length] = i;
+   v.length = v.length + 1;
+   v
+);
+
+#let .sort(v: Vector<t>): Vector<t> = (
+#   v
+#);

PLUGINS/FRONTEND/LSTS/lsts-parse.lsts

@@ -219,17 +219,44 @@ let lsts-parse-lhs(tokens: List<Token>): Tuple<AST,List<Token>> = (
          base-rest.first;         
       );
    };
-   while non-zero(tokens) && lsts-parse-head(tokens)==c"." {
-      let loc = head(tokens).location;
-      lsts-parse-expect(c".", tokens); tokens = tail(tokens);
-      lsts-parse-expect(c".", tokens); tokens = tail(tokens);
-      let next-rest = lsts-parse-lhs-one(tokens);
-      let next = next-rest.first;
-      tokens = next-rest.second;
-      base = App {
-         close(Var{ c"macro::lhs-prefix-or-suffix", with-location(mk-token("macro::lhs-prefix-or-suffix"),loc) }),
-         close(App{ close(base), close(next) })
-      };
+   while non-zero(tokens) && (lsts-parse-head(tokens)==c"." || lsts-parse-head(tokens)=="[") {
+      match tokens {
+         [Token{key:c"."}.. Token{key:c"."}.. rest] => (
+            let loc = head(tokens).location;
+            lsts-parse-expect(c".", tokens); tokens = tail(tokens);
+            lsts-parse-expect(c".", tokens); tokens = tail(tokens);
+            let next-rest = lsts-parse-lhs-one(tokens);
+            let next = next-rest.first;
+            tokens = next-rest.second;
+            base = App {
+               close(Var{ c"macro::lhs-prefix-or-suffix", with-location(mk-token("macro::lhs-prefix-or-suffix"),loc) }),
+               close(App{ close(base), close(next) })
+            };
+         );
+         [Token{key:c"."}.. rest] => (
+            let loc = head(tokens).location;
+            lsts-parse-expect(c".", tokens); tokens = tail(tokens);
+            let next-rest = lsts-parse-lhs-one(tokens);
+            let next = next-rest.first;
+            tokens = next-rest.second;
+            base = App {
+               close(Var{ c"macro::lhs-field", with-location(mk-token("macro::lhs-field"),loc) }),
+               close(App{ close(base), close(next) })
+            };
+         );
+         [Token{key:c"["}.. rest] => (
+            let loc = head(tokens).location;
+            lsts-parse-expect(c"[", tokens); tokens = tail(tokens);
+            let next-rest = lsts-parse-lhs-one(tokens);
+            let next = next-rest.first;
+            tokens = next-rest.second;
+            lsts-parse-expect(c"]", tokens); tokens = tail(tokens);
+            base = App {
+               close(Var{ c"macro::lhs-index", with-location(mk-token("macro::lhs-index"),loc) }),
+               close(App{ close(base), close(next) })
+            };
+         );
+      }
    };
    Tuple { base, tokens }
 );
@@ -864,6 +891,13 @@ let lsts-parse-atom(tokens: List<Token>): Tuple<AST,List<Token>> = (
       tokens = term-rest.second;
       term = term-rest.first;
    } else match tokens {
+      [Token{key:c"type"}.. Token{key:c"("}.. rest] => (
+         tokens = rest;
+         let term-rest = lsts-parse-type(tokens);
+         tokens = term-rest.second;
+         lsts-parse-expect(c")", tokens); tokens = tail(tokens);
+         term = AType{ t2(c"Type", term-rest.first) };
+      );
       [Token{key:c"("}.. rest] => (
          lsts-parse-expect(c"(", tokens); tokens = tail(tokens);
          if lsts-parse-head(tokens)==c")" {

SRC/preprocess-apply.lm

@@ -24,6 +24,30 @@ preprocess-apply-one := λ(: program AST). (: (
    (let r program)
    (match program (
       ()
+      ( (App( (App( (Var( 'macro::concat_s ctk )) (App( (Var( lk _ )) (Var( rk _ )) )) )) nt )) (
+         (set r (App(
+            (close(Var( (+( lk rk )) (unique ctk) )))
+            (close(preprocess-apply( nt )))
+         )))
+      ))
+      ( (App( (App( (Var( 'macro::concat_s ctk )) (App( (Var( lk _ )) (Lit( rk _ )) )) )) nt )) (
+         (set r (App(
+            (close(Var( (+( lk rk )) (unique ctk) )))
+            (close(preprocess-apply( nt )))
+         )))
+      ))
+      ( (App( (App( (Var( 'macro::concat_s ctk )) (App( (Lit( lk _ )) (Var( rk _ )) )) )) nt )) (
+         (set r (App(
+            (close(Var( (+( lk rk )) (unique ctk) )))
+            (close(preprocess-apply( nt )))
+         )))
+      ))
+      ( (App( (App( (Var( 'macro::concat_s ctk )) (App( (Lit( lk _ )) (Lit( rk _ )) )) )) nt )) (
+         (set r (App(
+            (close(Var( (+( lk rk )) (unique ctk) )))
+            (close(preprocess-apply( nt )))
+         )))
+      ))
       ( (App( (App( (Lit( ':_s ctk )) (App( t (AType tt) )) )) nt )) (
          (set r (App(
             (close(App( (close(Lit( ':_s (unique ctk) ))) (close(App( (close(preprocess-apply t)) (close(AType tt)) ))) )))

tests/regress/vector-sort.lsts

@@ -0,0 +1,4 @@
+
+import LIB/default.lm;
+
+#print([ 3, 1, 4, 8 ].to-vector().sort());