Scan pre destructure ast macros

SRC/macro-table.lsts

@@ -1,9 +1,40 @@
 
-let index-macro-table = {} :: HashtableEq<CString,List<AST>>;
+let index-macro-table = {} :: HashtableEq<CString,List<(Type,Type,AST)>>;
 
 let bind-new-macro(mname: CString, mterm: AST): Nil = (
    print("Bind New Macro: \{mname} = \{mterm}\n");
-   let row = index-macro-table.lookup(mname, [] :: List<AST>);
-   row = cons(mterm, row);
+   let row = index-macro-table.lookup(mname, [] :: List<(Type,Type,AST)>);
+   let mtype = param-types-of-macro(mterm);
+   row = cons( (mtype, macro-type-peep-holes(mtype), mterm), row);
    index-macro-table = index-macro-table.bind(mname, row);
 );
+
+let param-types-of-macro(mterm: AST): Type = (
+   match mterm {
+      Abs{lhs=lhs} => param-types-of-macro(lhs);
+      App{ rst=left, right:App{left:Lit{key:c":"}, right:App{right:AType{tt=tt}}}  } => t3(c"Cons",param-types-of-macro(rst),tt);
+      App{left:Lit{key:c":"}, right:App{right:AType{tt=tt}}} => tt;
+   }
+);
+
+# A peep-hole determines whether an expression needs to be typechecked or not
+# Yes => means needs to be typechecked
+# ?   => means does not need to be typechecked
+# Rules for whether a type needs to be typechecked
+# a     => no
+# T     => yes
+# T+... => yes
+let macro-type-peep-holes(mtype: Type): Type = (
+   match mtype {
+      TGround{tag:c"Cons", parameters:[p2.. p1..]} => t3(c"Cons",macro-type-peep-holes(p1),macro-type-peep-holes(p2));
+      TGround{} => t1(c"Yes");
+      TAnd{conjugate=conjugate} => (
+         let peep = ta;
+         for vector c in conjugate {
+            peep = peep || macro-type-peep-holes(c);
+         };
+         peep;
+      );
+      _ => ta;
+   }
+);

SRC/std-infer-expr.lsts

@@ -23,11 +23,15 @@ let std-infer-expr(tctx: Maybe<TContext>, term: AST, is-scoped: Bool, used: IsUs
                _ => ();
             }};
 
-            tctx = infer-expr(tctx, l, Unscoped, TAny, used);
-            if typeof(l).is-arrow {
-               tctx = infer-expr(tctx, r, Unscoped, TAny, Call);            
+            if index-macro-table.has(var-name-if-var(l)) {
+               tctx = std-infer-macro(tctx, term);
             } else {
-               tctx = infer-expr(tctx, r, Unscoped, TAny, Used);
+               tctx = infer-expr(tctx, l, Unscoped, TAny, used);
+               if typeof(l).is-arrow {
+                  tctx = infer-expr(tctx, r, Unscoped, TAny, Call);            
+               } else {
+                  tctx = infer-expr(tctx, r, Unscoped, TAny, Used);
+               };
             };
 
             rt = if typeof(l).is-arrow && non-zero(var-name-if-var(l)) {

SRC/std-infer-macro.lsts

@@ -0,0 +1,52 @@
+
+let std-infer-macro(tctx: Maybe<TContext>, t: AST): Maybe<TContext> = (
+   print("Infer macro: \{t}\n");
+   match t {
+      App{left:Var{mname=key}, r=right} => (
+         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 = std-infer-peeped-arguments(tctx, r, peep-holes);
+         print("Peep: \{peep-holes}\n");
+         print("Peeped Type: \{peeped-type}\n");
+         #let dominant-type = TAny;
+         #let candidates = [] :: List<(Type,AST)>;
+         #for Tuple{mtype=first, mterm=second} in row {
+         #   if non-zero(dominant-type) {
+         #   } else {
+         #      dominant-type = 
+         #   }
+         #};
+         #for Tuple{mtype=first, mterm=second} in candidates {
+         #   print("Candidate: \{mname}(\{mtype}) => \{mterm}\n");
+         #}
+      );
+   };
+   tctx
+);
+
+let std-infer-peeped-arguments(tctx: Maybe<TContext>, t: AST, peep: Type): Type = (
+   match peep {
+      TGround{tag:c"Cons", parameters:[p2.. p1..]} => (
+         match t {
+            App{left=left, right=right} => (
+               t3(c"Cons",
+                  std-infer-peeped-arguments(tctx, left, p1),
+                  std-infer-peeped-arguments(tctx, right, p2)
+               )
+            );
+            _ => fail("std-infer-peeped-arguments expected cons term: \{t}\n");
+         }
+      );
+      TAny{} => ta;
+      _ => ( infer-expr(tctx, t, Unscoped, TAny, Used); typeof(t) );
+   }
+);

SRC/unit-orphans.lsts

@@ -13,3 +13,4 @@ import SRC/std-infer-expr.lsts;
 import SRC/apply-and-specialize.lsts;
 import SRC/decorate-var-to-def.lsts;
 import SRC/macro-table.lsts;
+import SRC/std-infer-macro.lsts;