Test coverage for lsts frontend fixes fdjksldsll

Makefile

@@ -8,7 +8,7 @@ LSTSFLAGS = MALLOC_CHECK_=3
 # recommendation: ulimit -s unlimited
 
 dev: install-production
-	lm tests/promises/syntax/lhs-while-let.lsts
+	lm tests/promises/syntax/lhs-nested-field-gc.lsts > out.txt
 	gcc tmp.c
 	./a.out
 

PLUGINS/FRONTEND/LSTS/lsts-parse.lsts

@@ -236,6 +236,12 @@ let lsts-parse-typed-macro(tokens: List<Token>): (AST, List<Token>) = (
    lsts-parse-expect(c"typed", tokens); tokens = tail(tokens);
    lsts-parse-expect(c"macro", tokens); tokens = tail(tokens);
 
+   let misc-tt = ta;
+   if lsts-parse-head(tokens)==c":" {
+      lsts-parse-expect(c":", tokens); tokens = tail(tokens);
+      (misc-tt, tokens) = lsts-parse-type(tokens);
+   };
+
    (let mname, tokens) = lsts-parse-identifier(tokens);
    let margs = mk-nil();
    lsts-parse-expect(c"(", tokens); tokens = tail(tokens);
@@ -273,7 +279,7 @@ let lsts-parse-typed-macro(tokens: List<Token>): (AST, List<Token>) = (
    lsts-parse-expect(c";", tokens); tokens = tail(tokens);
    (mk-glb(
       mk-token(mname), 
-      mk-abs(margs, mbody.without-location.ascript(mrett), t0(c"TypedMacro"))
+      mk-abs(margs, mbody.without-location.ascript(mrett), t0(c"TypedMacro") && misc-tt)
    ), tokens);
 );
 

SRC/ast-misc-todo-remove-or-stabilize.lsts

@@ -14,6 +14,12 @@ type ApplyResult = { function-type:Type , return-type:Type };
 type CompileMode = ModeTokenize | ModeParse | ModePreprocess | ModeTypecheck | ModeCompile;
 
 type IsUsed = Used | Unused | Tail | Call { function-name: CString };
+let .function-name(used: IsUsed): CString = (
+   match used {
+      Call{function-name=function-name} => function-name;
+      _ => c"";
+   }
+);
 let .is-call(used: IsUsed): Bool = (
    match used {
       Call{} => true;

SRC/type-constructor.lsts

@@ -35,6 +35,7 @@ let interned-tag-must-not-rewrite = intern-type-tag(c"MustNotRewrite");
 let interned-tag-vararg = intern-type-tag(c"...");
 let interned-tag-any = intern-type-tag(c"Any");
 let interned-tag-nil = intern-type-tag(c"Nil");
+let interned-tag-lazy = intern-type-tag(c"Lazy");
 let interned-tag-typedef = intern-type-tag(c"typedef");
 let interned-tag-tail-position = intern-type-tag(c"TailPosition");
 let interned-tag-const = intern-type-tag(c"const");

SRC/typecheck-infer-expr.lsts

@@ -316,6 +316,7 @@ let std-infer-expr(tctx: Maybe<TypeContext>, term: AST, is-scoped: Bool, used: I
             # TailPosition LocalVariables don't need to be retained because +1/-1 retain/release cancels itself out
             if not(hint.is-t(interned-tag-tail-position,0) and vt.is-t(interned-tag-local-variable,0))
             and not(hint.is-t(interned-tag-must-not-retain,0))
+            and not(used.function-name.is-lazy-macro)
             and not(tctx.get-or(mk-tctx()).is-blob) {
                tctx = tctx.ascript(term, vt);
                (tctx, term) = maybe-retain(tctx, term);
@@ -543,5 +544,7 @@ let std-infer-call-arg(tctx: TypeContext?, term: AST, function-name: CString, hi
          (tctx, term)
       );
       _ => (tctx, term);
-   }} else std-infer-expr(tctx, term, false, Call(function-name), hint);
+   }} else {
+      std-infer-expr(tctx, term, false, Call(function-name), hint);
+   };
 );

SRC/typecheck-infer-global-terms.lsts

@@ -118,6 +118,7 @@ let infer-global-macro(term: AST): Nil = (
          for s in seq { infer-global-macro(s) };
       );
       Glb{ k=key, frhs=val:Abs{lhs=lhs, rhs:App{left:Lit{key:c":"}, right:App{rhs=left, right:AType{return-type=tt}}}, misc-tt=tt} } => (
+         if misc-tt.is-t(interned-tag-lazy,0) then mark-is-lazy-macro(k.key);
          if misc-tt.is-t(interned-tag-typed-macro,0) then bind-new-macro(k.key, frhs)
       );
       _ => ();

SRC/typecheck-std-apply-macro.lsts

@@ -93,9 +93,9 @@ let std-apply-macro(tctx: Maybe<TypeContext>, mname: CString, margs: AST, used:
          };
       };
       (let peeped-tctx, peeped-type, margs) = if not(is(strong,MacroSuperWeak)) {
-         std-infer-peeped-arguments(tctx, margs, peep-holes, true);
+         std-infer-peeped-arguments(tctx, mname, margs, peep-holes, true);
       } else {
-         std-infer-peeped-arguments(tctx, margs, peep-holes, false);
+         std-infer-peeped-arguments(tctx, mname, margs, peep-holes, false);
       };
       let peeped-tctx-unwrapped = peeped-tctx.get-or(mk-tctx());
       peeped-tctx-unwrapped.pctx = tctx.get-or(mk-tctx()).pctx; # Phi Variables are irrelevant to peeped arguments
@@ -127,13 +127,13 @@ let std-apply-macro(tctx: Maybe<TypeContext>, mname: CString, margs: AST, used:
 
    if not(is(strong,MacroWeak) or is(strong,MacroSuperWeak)) and not(non-zero(result)) then exit-error("Failed to Apply Macro: \{mname}\nArgs: \{margs} : \{peeped-type}\n", margs);
    if is(strong,MacroTerm) {
-      (tctx, result) = std-infer-expr(tctx, result, false, if return-type==type-lazy then used else Tail, ta);
+      (tctx, result) = std-infer-expr(tctx, result, false, if mname.is-lazy-macro then Call(mname) else if return-type==type-lazy then used else Tail, ta);
       mark-free-and-seen(result);
    };
    (tctx, result)
 );
 
-let std-infer-peeped-arguments(tctx: Maybe<TypeContext>, t: AST, peep: Type, strong: Bool): (TypeContext?, Type, AST) = (
+let std-infer-peeped-arguments(tctx: Maybe<TypeContext>, mname: CString, t: AST, peep: Type, strong: Bool): (TypeContext?, Type, AST) = (
    let o-t = t;
    let rewritten = false;
    match t {
@@ -159,8 +159,8 @@ let std-infer-peeped-arguments(tctx: Maybe<TypeContext>, t: AST, peep: Type, str
       TGround{tag:interned-tag-cons, parameters:[p2.. p1..]} => (
          match t {
             App{is-cons=is-cons, left=left, right=right} => (
-               (tctx, let lt, let new-left) = std-infer-peeped-arguments(tctx, left, p1, strong);
-               (tctx, let rt, let new-right) = std-infer-peeped-arguments(tctx, right, p2, strong);
+               (tctx, let lt, let new-left) = std-infer-peeped-arguments(tctx, mname, left, p1, strong);
+               (tctx, let rt, let new-right) = std-infer-peeped-arguments(tctx, mname, right, p2, strong);
                if not(is(left,new-left)) or not(is(right,new-right))
                then t = mk-cons-or-app(is-cons,new-left,new-right);
                (tctx, t2(interned-tag-cons,lt,rt), t)
@@ -172,7 +172,7 @@ let std-infer-peeped-arguments(tctx: Maybe<TypeContext>, t: AST, peep: Type, str
       _ => (
          if strong {
             if not rewritten {
-               (let protected-tctx, t) = std-infer-expr(tctx, t, false, Used(), ta);
+               (let protected-tctx, t) = std-infer-expr(tctx, t, false, if mname.is-lazy-macro then Call(mname) else Used(), ta);
                mark-free-and-seen(t);
                tctx = tctx.with-pctx( protected-tctx.get-or(mk-tctx()).pctx );
             };

SRC/unit-util.lsts

@@ -4,3 +4,4 @@ import lib/core/bedrock.lsts;
 let safe-alloc-block-count = 0;
 
 import SRC/util-uuid.lsts;
+import SRC/util-is-lazy-macro.lsts;

SRC/util-is-lazy-macro.lsts

@@ -0,0 +1,10 @@
+
+let is-lazy-macro-index = mk-set(type(CString));
+
+let mark-is-lazy-macro(c: CString): Nil = (
+   is-lazy-macro-index = is-lazy-macro-index.bind(c);
+);
+
+let .is-lazy-macro(c: CString): Bool = (
+   is-lazy-macro-index.has(c)
+);

lib/core/common-macros.lsts

@@ -38,8 +38,6 @@ typed macro macro::let(lhs: macro::set-binding, rhs: lazy): lazy = (
 );
 
 typed macro macro::lhs-index(base: lazy, index: lazy): lazy = (base; index);
-typed macro macro::lhs-field(base: lazy, field: lazy): lazy = (base; field);
-typed macro macro::lhs-field(base field1: macro::lhs-field, field2: lazy): lazy = (macro::concat($".", field1)(base); field2);
 
 typed macro macro::assign(tag-guard fields-guard: macro::lhs-tagged, rhs: lazy): Nil = (
    let uuid(term) = rhs;
@@ -60,10 +58,10 @@ typed macro macro::fallible-bind(lhs-base lhs-index: macro::lhs-index, rhs: lazy
 );
 
 typed macro macro::assign(lhs-base lhs-field-name: macro::lhs-field, rhs: lazy): Nil = (
-   macro::concat($"set.", lhs-field-name)(lhs-base, rhs)
+   macro::concat($"set.", lhs-field-name)(macro::lhs-as-rhs(lhs-base), rhs)
 );
 typed macro macro::fallible-bind(lhs-base lhs-field-name: macro::lhs-field, rhs: lazy): Bool = (
-   macro::concat($"set.", lhs-field-name)(lhs-base, rhs); true
+   macro::concat($"set.", lhs-field-name)(macro::lhs-as-rhs(lhs-base), rhs); true
 );
 
 typed macro macro::assign(lhs: macro::variable, rhs: lazy): Nil = (
@@ -103,17 +101,25 @@ typed macro macro::set(base index: macro::lhs-index, rhs: lazy): lazy = (
 );
 
 typed macro macro::set(base field: macro::lhs-field, rhs: lazy): lazy = (
-   macro::concat($"set.", field) (base, rhs)
+   macro::concat($"set.", field) (macro::lhs-as-rhs(base), rhs)
 );
 
-typed macro macro::lhs-as-rhs(v: macro::variable): lazy = (
+typed macro :Lazy macro::lhs-as-rhs(v: macro::variable): lazy = (
    v
 );
 
-typed macro macro::lhs-as-rhs(base: macro::lhs-address-of): lazy = (
+typed macro :Lazy macro::lhs-as-rhs(base idx: macro::lhs-index): lazy = (
+   macro::lhs-as-rhs(base)[idx]
+);
+
+typed macro :Lazy macro::lhs-as-rhs(base: macro::lhs-address-of): lazy = (
    &v
 );
 
+typed macro :Lazy macro::lhs-as-rhs(base field: macro::lhs-field): lazy = (
+   macro::concat($".", field)(macro::lhs-as-rhs(base))
+);
+
 typed macro macro::lhs-address-of(base: lazy): lazy = (
    base
 );
@@ -122,10 +128,6 @@ typed macro macro::lhs-field(base: lazy, field: lazy): lazy = (
    base; field
 );
 
-typed macro macro::lhs-as-rhs(base field: macro::lhs-index): lazy = (
-   macro::concat(l".", field)(base)
-);
-
 typed macro macro::lhs-index(base: lazy, index: lazy): lazy = (
    base; index
 );

tests/promises/syntax/lhs-nested-field-gc.lsts

@@ -0,0 +1,12 @@
+
+import lib/core/bedrock.lsts;
+
+let xs = (1,2);
+
+assert( xs.first == 1 );
+assert( xs.second == 2 );
+
+xs.first = 3;
+
+assert( xs.first == 3 );
+assert( xs.second == 2 );

tests/promises/syntax/lhs-nested-field.lsts

@@ -0,0 +1,11 @@
+
+import lib/core/bedrock.lsts;
+
+type A = { x: U8 };
+type B = { a: A };
+
+let b = B(A(1));
+assert( b.a.x == 1 );
+
+b.a.x = 2;
+assert( b.a.x == 2 );

tests/promises/syntax/lhs-nested-index.lsts

@@ -0,0 +1,31 @@
+
+import lib/core/bedrock.lsts;
+
+type A = { x: U8, y: U8 };
+
+let xs = safe-alloc(2, type(A));
+xs[0] = A(1,2);
+xs[1] = A(2,3);
+
+assert( xs[0].x == 1 );
+assert( xs[0].y == 2 );
+
+assert( xs[1].x == 2 );
+assert( xs[1].y == 3 );
+
+xs[0] = A(3,4);
+
+assert( xs[0].x == 3 );
+assert( xs[0].y == 4 );
+
+assert( xs[1].x == 2 );
+assert( xs[1].y == 3 );
+
+xs[0].x = 5;
+
+assert( xs[0].x == 5 );
+assert( xs[0].y == 4 );
+
+assert( xs[1].x == 2 );
+assert( xs[1].y == 3 );
+