fixed a problem where cons were being lost

Author: andrew-johnson-4

SRC/std-apply-macro-candidates.lsts

@@ -11,7 +11,7 @@ let std-apply-macro-candidates(tctx: TContext?, mname: CString, margs: AST, cand
       if not(non-zero(t)) {
          (let new-tctx, let mctx) = std-try-destructure-macro(tctx, margs, ctype, mlhs);
          if mctx.is-some then mctx = union(mctx, Some{extract-uuids(mrhs)});
-         if mctx.is-some then t = with-location(substitute(mctx.get-or-panic, mrhs), margs.location);
+         if mctx.is-some then t = with-location-preserve(substitute(mctx.get-or-panic, mrhs), margs.location);
       }
    };
    (tctx, t) = std-infer-expr(tctx, t, false, Used, TAny);
@@ -43,10 +43,18 @@ let std-try-destructure-macro(tctx: TContext?, margs: AST, mtype: Type, mcandida
                App{left:Lit{key:c":"}, right:App{mstruct=left, right:AType{tt=tt}}} => (
                   if non-zero(std-macro-helper-name(tt))
                   then {
-                     (tctx, let helped) = std-apply-macro-weak(tctx, std-macro-helper-name(tt), margs);
-                     if non-zero(helped)
-                     then (tctx, std-direct-destructure-macro(helped, mstruct))
-                     else (tctx, no)
+                     let macro-helper = std-macro-helper-name(tt);
+                     match margs {
+                        App{left:Var{maybe-helper=key}, helper-args=right} => (
+                           if macro-helper==maybe-helper {
+                              (tctx, let helped) = std-apply-macro-weak(tctx, macro-helper, helper-args);
+                              if non-zero(helped)
+                              then (tctx, std-direct-destructure-macro(helped, mstruct))
+                              else (tctx, no)
+                           } else (tctx, no)
+                        );
+                        _ => (tctx, no);
+                     }
                   } else (tctx, std-direct-destructure-macro(margs, mstruct))
                );
                _ => (tctx, no);

SRC/std-apply-macro.lsts

@@ -11,6 +11,7 @@ let std-apply-macro(tctx: Maybe<TContext>, mname: CString, margs: AST): (TContex
 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(tctx: Maybe<TContext>, mname: CString, margs: AST, strong: Bool): (TContext?, AST) = (
+   print("Apply Macro \{mname} \{margs}\n");
    let row = index-macro-table.lookup(mname, [] :: List<(Type,Type,AST)>);
    let peep-holes = TAny;
    let peeped = TAny;
@@ -47,7 +48,7 @@ let std-apply-macro(tctx: Maybe<TContext>, mname: CString, margs: AST, strong: B
    };
    (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);
-   print("Apply Macro \{mname} \{margs}\nResult: \{result}\n");
+   print("Applied Macro \{mname} \{margs}\nResult: \{result}\n");
    (tctx, result)
 );
 

SRC/substitute.lsts

@@ -52,9 +52,7 @@ let substitute(ctx: AContext, term: AST): AST = (
          for vector s in seq { ret = ret.push(substitute(ctx,s)) };
          Seq{ret}
       );
-      App{is-cons=is-cons,left=left,right=right} => if is-cons
-      then mk-cons(substitute(ctx,left), substitute(ctx,right))
-      else mk-app(substitute(ctx,left), substitute(ctx,right));
+      App{is-cons=is-cons,left=left,right=right} => mk-cons-or-app(is-cons,substitute(ctx,left),substitute(ctx,right));
       Typedef{lhs=lhs,rhs=rhs} => mk-typedef(substitute(ctx,lhs), substitute(ctx,rhs));
       Abs{lhs=lhs,rhs=rhs,tt=tt} => mk-abs(substitute(ctx,lhs), substitute(ctx,rhs), tt);
       Glb{key=key,val=val} => mk-glb(key, substitute(ctx,val));

SRC/with-location.lsts

@@ -19,3 +19,20 @@ let with-location(term: AST, loc: SourceLocation): AST = (
 let with-location(t: Token, loc: SourceLocation): Token = (
    if non-zero(t.location) then t else Token{ t.skey, t.key, iuid(), loc }
 );
+
+let with-location-preserve(term: AST, loc: SourceLocation): AST = (
+   match term {
+      Var{key=key,token=token} => Var{key,with-location(token,loc)};
+      Lit{key=key,token=token} => Lit{key,with-location(token,loc)};
+      App{is-cons=is-cons,left=left,right=right} => mk-cons-or-app(is-cons,with-location-preserve(left,loc),with-location-preserve(right,loc));
+      Seq{seq=seq} => (
+         let ret = mk-vector(type(AST), seq.length);
+         for vector s in seq { ret = ret.push(with-location-preserve(s,loc)) };
+         Seq{ret}
+      );
+      Abs{lhs=lhs,rhs=rhs,tt=tt} => Abs{close(with-location-preserve(lhs,loc)),close(with-location-preserve(rhs,loc)),tt};
+      Typedef{lhs=lhs,rhs=rhs} => Typedef{close(with-location-preserve(lhs,loc)),close(with-location-preserve(rhs,loc))};
+      Glb{key=key,val=val} => Glb{with-location(key,loc),close(with-location-preserve(val,loc))};
+      _ => term;
+   }
+);