Merge pull request #1029 from andrew-johnson-4/vector-sort-2

Vector sort 2

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "lambda_mountain"
-version = "1.19.34"
+version = "1.19.35"
 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 t.lsts
+	lm tests/regress/vector-sort.lsts
 	cc -O3 tmp.c
 	./a.out
 

PLATFORM/C/LIB/common-macros.lm

@@ -11,10 +11,13 @@ 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) );
+      ( set[] ((macro::lhs-as-rhs base) index rhs) );
 
-macro ( ('set ('macro::lhs-index( (macro:lhs-field( base field )) index )) rhs) )
-      ( set[] ( ((macro::concat( . field )) base) index rhs) );
+macro ( ('macro::lhs-as-rhs (:Variable: v)) )
+      ( v );
+
+macro ( ('macro::lhs-as-rhs ('macro::lhs-field( base field )) ) )
+      ( (macro::concat( . field )) base );
 
 macro ( ('while cond body) )
       ( (primitive::while( (as body Nil) (into-branch-conditional cond) )) );

PLATFORM/C/LIB/vector.lsts

@@ -10,11 +10,64 @@ 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.data[v.length] = i;
    v.length = v.length + 1;
    v
 );
 
-#let .sort(v: Vector<t>): Vector<t> = (
-#   v
-#);
+let .to-vector(l: List<t>): Vector<t> = (
+   let v = mk-vector(type(t), l.length);
+   for i in l {
+      v = v.push(i);
+   };
+   v
+);
+
+let $"[]"( v: Vector<t>, i: U64 ): t = (
+   if i >= v.length {
+      fail("Vector Index Out of Bounds");
+   };
+   v.data[i]
+);
+
+let $"set[]"( v: Vector<t>, i: U64, val: t ): Nil = (
+   if i >= v.length {
+      fail("Vector Index Out of Bounds");
+   };
+   v.data[i] = val; 
+   ()
+);
+
+let .sort(v: Vector<t>): Vector<t> = (
+   let n = v.length;
+   let i = 0;
+   while i < n - 1 {
+      let swapped = 0;
+      let j = 0;
+      while j < n - i - 1 {
+         if v[j + 1] < v[j] {
+            let tmp = v[j];
+            v[j] = v[j + 1];
+            v[j + 1] = tmp;
+            swapped = 1;
+         };
+         j = j + 1;
+      };
+      i = i + 1;
+      if not(swapped) {
+         i = n;
+      };
+   };
+   v
+);
+
+let print(v: Vector<x>): Nil = (
+   let vi = 0;
+   print(c"[");
+   while vi < v.length {
+      if vi > 0 then print(c",");
+      print(v.data[vi]);
+      vi = vi + 1;
+   };
+   print(c"]");
+);

PLUGINS/BACKEND/C/compile-expr-direct.lm

@@ -6,6 +6,9 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
    (set.context( e (close ctx) ))
    (match term (
       ()
+      ( (AType _) (
+         (set e (fragment::set( e 'expression_s (SAtom '0_s) )))
+      ))
       ( ASTNil (
          (set.type( e (denormalize(t1 'Nil_s)) ))
          (set e (fragment::set( e 'expression_s (SAtom '\[{}\]_s) )))

PLUGINS/BACKEND/C/compile-push-rvalue.lm

@@ -27,6 +27,7 @@ compile-push-rvalue := λ(: ctx FContext)(: rval AST)(: offset I64)(: count U64)
          ))
       ))
       ( _ (
+         (let p2 (typeof rval))
          (set r (compile-expr( ctx rval offset Used )))
       ))
    ))

PLUGINS/BACKEND/C/mangle-c-type.lm

@@ -15,6 +15,7 @@ mangle-c-type-internal := λ(: tt Type). (: (
       ))
       ( TAny (set r (SAtom 'void_s)) )
       ( (TVar _) () )
+      ( (TGround( 'Type_s (LCons( _ LEOF )) )) (set r (SAtom 'int_s)) )
       ( (TGround( 'Nil_s _ )) (set r (SAtom 'void_s)) )
       ( (TGround( 'Never_s _ )) (set r (SAtom 'void_s)) )
       ( (TGround( 'U8_s _ )) (set r (SAtom 'char_s)) )

PLUGINS/FRONTEND/LSTS/lsts-parse.lsts

@@ -247,7 +247,7 @@ let lsts-parse-lhs(tokens: List<Token>): Tuple<AST,List<Token>> = (
          [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-rest = lsts-parse-expression(tokens);
             let next = next-rest.first;
             tokens = next-rest.second;
             lsts-parse-expect(c"]", tokens); tokens = tail(tokens);
@@ -882,7 +882,14 @@ let lsts-parse-lit(tokens: List<Token>): Tuple<AST,List<Token>> = (
 
 let lsts-parse-atom(tokens: List<Token>): Tuple<AST,List<Token>> = (
    let term = ASTEOF {};
-   if lsts-is-ident-head(lsts-parse-head(tokens)) {
+   if lsts-parse-head(tokens)==c"type" {
+      tokens = tail(tokens);
+      lsts-parse-expect(c"(", tokens); tokens = tail(tokens);
+      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) };
+   } else if lsts-is-ident-head(lsts-parse-head(tokens)) {
       let term-rest = lsts-make-maybe-var(tokens);
       tokens = term-rest.second;
       term = term-rest.first;
@@ -891,13 +898,6 @@ 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/infer-expr.lm

@@ -324,6 +324,7 @@ infer-expr-one := λ(: tctx TContext)(: term AST)(: scoped IsScoped)(: hint Type
          ))
       ))
       ( (Meta( _ )) (ascript-normal( term (t1 'Nil_s) )) )
+      ( (AType( tt )) (ascript-normal( term tt )) )
       ( _ (
          (print 'Unknown\sTerm\sIn\sType\sInference\n_s)
          (print term)

tests/regress.rs

@@ -100,6 +100,19 @@ fn regression_tests() {
          }
       }
    }
+   for entry in glob("tests/regress/*.lsts").unwrap() {
+      let path = entry.unwrap().display().to_string();
+      if !std::path::Path::new(&(path.clone() + ".skip")).exists() {
+         let expected = std::fs::read_to_string(path.clone() + ".out")
+                       .expect(&format!("Could not load expected output {}.out", path));
+         let expected = expected.trim().to_string();
+         let actual = run_bootstrap(&path);
+         let actual = actual.trim().to_string();
+         if expected != actual {
+            failures.push(( "--compile", path, expected, actual ));
+         }
+      }
+   }
    for entry in glob("EXAMPLES/*.lsts").unwrap() {
       let path = entry.unwrap().display().to_string();
       if !std::path::Path::new(&(path.clone() + ".skip")).exists() {

tests/regress/vector-sort.lsts

@@ -1,4 +1,6 @@
 
 import LIB/default.lm;
 
-#print([ 3, 1, 4, 8 ].to-vector().sort());
+let main(): Nil = (
+   print([ 3, 1, 4, 8 ].to-vector().sort());
+);

tests/regress/vector-sort.lsts.out

@@ -0,0 +1 @@
+[1,3,4,8]