Merge pull request #1510 from andrew-johnson-4/port-more-macros-to-lsts

Port more macros to lsts

Author: andrew-johnson-4

BOOTSTRAP/cli.c

@@ -11,9 +11,9 @@ typed macro macro::set(base index: macro::lhs-index, rhs: lazy): lazy = (
    $"set[]"( base, index, rhs )
 );
 
-#typed macro macro::set(base field: macro::lhs-field, rhs: lazy): lazy = (
-#   macro::concat(l"set.", field) (base, rhs)
-#);
+typed macro macro::set(base field: macro::lhs-field, rhs: lazy): lazy = (
+   macro::concat($"set.", field) (base, rhs)
+);
 
 typed macro macro::lhs-as-rhs(v: macro::variable): lazy = (
    v
@@ -27,12 +27,20 @@ typed macro macro::lhs-address-of(base: lazy): lazy = (
    base
 );
 
+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, field: lazy): lazy = (
-   base; field
+typed macro macro::lhs-index(base: lazy, index: lazy): lazy = (
+   base; index
+);
+
+typed macro macro::lhs-index(base field: macro::lhs-field, index: lazy): lazy = (
+   macro::concat($".", field)(base); index
 );
 
 typed macro macro::for(item: lazy, iter: List<?>, loop: lazy): lazy = (

PLATFORM/C/LIB/common-macros.lsts

@@ -35,7 +35,7 @@ let lsts-parse-identifier(tokens: List<Token>): Tuple<CString, List<Token>> = (
    if lsts-parse-head(tokens)==c"." { name = c"."; tokens = tail(tokens); };
    lsts-parse-expect(c"Identifier", lsts-is-ident-head(lsts-parse-head(tokens)), tokens);
    name = name + lsts-unwrap-identifier(lsts-parse-head(tokens)); tokens = tail(tokens);
-   while lsts-parse-head(tokens)==c":" && lsts-parse-head(tail(tokens))==c":" {
+   while lsts-parse-head(tokens)==c":" && lsts-parse-head(tail(tokens))==c":" && lsts-is-ident-head(lsts-parse-head(tail(tail(tokens)))) {
       name = name + c"::"; tokens = tail(tokens); tokens = tail(tokens);
       lsts-parse-expect(c"Identifier", lsts-is-ident-head(lsts-parse-head(tokens)), tokens);
       name = name + lsts-unwrap-identifier(lsts-parse-head(tokens)); tokens = tail(tokens);
@@ -497,12 +497,10 @@ 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 = next-rest.first;
-            tokens = next-rest.second;
+            (let field-name, tokens) = lsts-parse-identifier(tokens);
             base = mk-app(
                Var{ c"macro::lhs-field", with-location(mk-token("macro::lhs-field"),loc) },
-               mk-cons(base, next)
+               mk-cons(base, mk-var(field-name))
             );
          );
          [Token{key:c"["}.. rest] => (
@@ -527,10 +525,14 @@ let lsts-make-maybe-var(tokens: List<Token>): Tuple<AST,List<Token>> = (
       lsts-parse-lit(tokens)
    } else {
       if not(non-zero(tokens)) { lsts-parse-expect(c"Identifier", tokens); };
-      let t = head(tokens);
-      let base = Var { lsts-unwrap-identifier(t.key), lsts-unwrap-identifier(t) };
-      if lsts-is-lit(t.key) { base = lsts-make-lit(t); };
-      tokens = tail(tokens);
+      let base = ASTEOF;
+      if lsts-is-lit(head(tokens).key) {
+         base = lsts-make-lit(head(tokens));
+         tokens = tail(tokens);
+      } else {
+         (let var-name, tokens) = lsts-parse-identifier(tokens);
+         base = mk-var(var-name);
+      };
       Tuple { base, tokens }
    }
 );
@@ -1235,12 +1237,9 @@ let lsts-parse-assign(tokens: List<Token>): Tuple<AST,List<Token>> = (
                ASTOrIdentIgnore {} => ();
 
                ASTOrIdentAST { ast=ast } => (
-                  let x = mk-cons(
-                     mk-cons(
-                        Var{ c"set", with-location(mk-token("set"),loc) },
-                        ast
-                     ),
-                     rexpr
+                  let x = mk-app(
+                     Var{ c"macro::set", with-location(mk-token("macro::set"),loc) },
+                     mk-cons(ast, rexpr)
                   );
                   base = mk-cons(base, x);
                );
@@ -1261,12 +1260,12 @@ let lsts-parse-assign(tokens: List<Token>): Tuple<AST,List<Token>> = (
          lsts-parse-expect(c"=", tokens); tokens = tail(tokens);
          let rhs-rest = lsts-parse-small-expression(tokens);
          tokens = rhs-rest.second;
-         base = mk-cons(
+         base = mk-app(
+            Var{ c"macro::set", with-location(mk-token("macro::set"),loc) },
             mk-cons(
-               Var{ c"set", with-location(mk-token("set"),loc) },
-               lhs-rest.first
-            ),
-            rhs-rest.first
+               lhs-rest.first,
+               rhs-rest.first
+            )
          );
       };
    } else {

PLUGINS/FRONTEND/LSTS/lsts-parse.lsts

@@ -1,5 +1,6 @@
 
 let index-macro-table = {} :: HashtableEq<CString,List<(Type,Type,AST)>>;
+index-macro-table = index-macro-table.bind(c"macro::concat", [] :: List<(Type,Type,AST)>);
 
 let bind-new-macro(mname: CString, mterm: AST): Nil = (
    let row = index-macro-table.lookup(mname, [] :: List<(Type,Type,AST)>);

SRC/macro-table.lsts

@@ -10,43 +10,54 @@ let std-apply-macro(tctx: Maybe<TContext>, t: AST): (TContext?, AST) = (
 let std-apply-macro(tctx: Maybe<TContext>, mname: CString, margs: AST): (TContext?, AST) = std-apply-macro(tctx, mname, margs, true);
 let std-apply-macro-weak(tctx: Maybe<TContext>, mname: CString, margs: AST): (TContext?, AST) = std-apply-macro(tctx, mname, margs, false);
 
+let std-apply-macro-concat(tctx: Maybe<TContext>, mname: CString, margs: AST): (TContext?, AST) = (
+   match margs {
+      App{ left:Var{left-key=key}, right:Var{right-key=key} } => (tctx, mk-var(left-key + right-key));
+      _ => (tctx, ASTEOF);
+   }
+);
+
 let std-apply-macro(tctx: Maybe<TContext>, mname: CString, margs: AST, strong: Bool): (TContext?, AST) = (
-   let row = index-macro-table.lookup(mname, [] :: List<(Type,Type,AST)>);
-   let peep-holes = TAny;
-   let peeped = TAny;
-   for Tuple{mtype=first, peep=second, mterm=third} in row {
-      if non-zero(peep-holes) {
-         if peep-holes != peep then fail("Error: Macros must have the same pre-inference expectation.\n\{mname} : \{peeped}\n\{mname} : \{mtype}\n");
-      } else {
-         peep-holes = peep;
-         peeped = mtype;
+   let result = ASTEOF;
+   if mname==c"macro::concat" then (tctx, result) = std-apply-macro-concat(tctx, mname, margs)
+   else {
+      let row = index-macro-table.lookup(mname, [] :: List<(Type,Type,AST)>);
+      let peep-holes = TAny;
+      let peeped = TAny;
+      for Tuple{mtype=first, peep=second, mterm=third} in row {
+         if non-zero(peep-holes) {
+            if peep-holes != peep then fail("Error: Macros must have the same pre-inference expectation.\n\{mname} : \{peeped}\n\{mname} : \{mtype}\n");
+         } else {
+            peep-holes = peep;
+            peeped = mtype;
+         };
       };
-   };
-   (let peeped-type, margs) = std-infer-peeped-arguments(tctx, margs, peep-holes);
+      (let peeped-type, margs) = std-infer-peeped-arguments(tctx, margs, peep-holes);
 
-   let matched = [] :: List<(Type,AST)>;
-   for Tuple{mtype=first, mterm=third} in row {
-      if can-unify(mtype, peeped-type) then matched = cons( (mtype,mterm), matched );
-   }; 
+      let matched = [] :: List<(Type,AST)>;
+      for Tuple{mtype=first, mterm=third} in row {
+         if can-unify(mtype, peeped-type) then matched = cons( (mtype,mterm), matched );
+      }; 
 
-   let dominant-type = TAny;
-   let candidates = [] :: List<(Type,AST)>;
-   for Tuple{mtype=first, mterm=second} in matched {
-      if non-zero(dominant-type) {
-         if can-unify(mtype,dominant-type) && can-unify(dominant-type,mtype) {
-            candidates = cons( (mtype,mterm), candidates );
-         } else if can-unify(dominant-type,mtype) {
+      let dominant-type = TAny;
+      let candidates = [] :: List<(Type,AST)>;
+      for Tuple{mtype=first, mterm=second} in matched {
+         if non-zero(dominant-type) {
+            if can-unify(mtype,dominant-type) && can-unify(dominant-type,mtype) {
+               candidates = cons( (mtype,mterm), candidates );
+            } else if can-unify(dominant-type,mtype) {
+               dominant-type = mtype;
+               candidates = [(mtype,mterm)];
+            } else if can-unify(mtype,dominant-type) { # existing is dominant, keep existing and ignore new
+            } else fail("Conflicting type candidates encountered during macro specialization:\n\{mname} : \{dominant-type}\n\{mname} : \{mtype}\n");
+         } else {
             dominant-type = mtype;
             candidates = [(mtype,mterm)];
-         } else if can-unify(mtype,dominant-type) { # existing is dominant, keep existing and ignore new
-         } else fail("Conflicting type candidates encountered during macro specialization:\n\{mname} : \{dominant-type}\n\{mname} : \{mtype}\n");
-      } else {
-         dominant-type = mtype;
-         candidates = [(mtype,mterm)];
-      }
+         }
+      };
+      (tctx, result) = std-apply-macro-candidates(tctx, mname, margs, candidates);
    };
-   (tctx, let result) = std-apply-macro-candidates(tctx, mname, margs, candidates);
-   if strong && not(non-zero(result)) then exit-error("Failed to Apply Macro: \{mname}", margs);
+   if strong && not(non-zero(result)) then exit-error("Failed to Apply Macro: \{mname}\nArgs: \{margs}\n", margs);
    if strong then (tctx, result) = std-infer-expr(tctx, result, false, Used, TAny);
    (tctx, result)
 );

SRC/std-apply-macro.lsts

@@ -3,10 +3,7 @@ let std-direct-destructure-macro(margs: AST, mstruct: AST): AContext? = (
    let no = None :: AContext?;
    match (margs, mstruct) {
       Tuple{ val=first, second:Var{key=key} } => Some{[(key,val)]};
-      Tuple{
-         first:App{is-cons:1_u8, lrest=left, val=right },
-         second:App{is-cons:1_u8, rrest=left, right:Var{key=key} }
-      } => (
+      Tuple{ first:App{lrest=left, val=right}, second:App{rrest=left, right:Var{key=key}} } => (
          let ctx = std-direct-destructure-macro(lrest, rrest);
          if ctx.is-some then Some{cons((key,val), ctx.get-or-panic)} else no;
       );

SRC/std-direct-destructure-macro.lsts

@@ -18,5 +18,12 @@ assert( ast-macros-test-add(2_i64, 3_i64) == 5_i64 );
    print(x);
 );
 
+type A = A{a:U64};
+(
+   let a = A{1};
+   $"macro::set"($"macro::lhs-field"(a,a), 2);
+   print(a.a);
+);
+
 #$"macro::for"(x, [1, 2], print(x));
 #$"macro::for"(x, mk-vector(type(U64)).push(3).push(4), print(x));

tests/unit/ast-macros.lsts

@@ -1 +1 @@
-[3,4]
+[3,4]2