Merge pull request #2030 from andrew4328/more-compiler-optimizations-towards-full-gc-fdsjkdsl

All tests passing. Down to 7.8 minutes for all tests to run from 9.5 minutes previously.

Author: andrew4328

BOOTSTRAP/cli.c

@@ -8,15 +8,13 @@ LSTSFLAGS = MALLOC_CHECK_=3
 # recommendation: ulimit -s unlimited
 
 dev: install-production
-	lm tests/promises/vector/constructor.lsts
+	lm --v23 --showastcount SRC/index.lsts
 	#time lm --showalloc SRC/unit-type-core.lsts > out.txt
 	#time lm --showalloc SRC/unit-tctx-core.lsts > out.txt
 	#time lm --showalloc SRC/unit-prop-core.lsts > out.txt
 	#time lm --showalloc SRC/unit-ascript-core.lsts > out.txt
 	#time lm --showalloc SRC/index.lsts > out.txt
 	#time lm --showalloc SRC/dev-index.lsts > out.txt
-	gcc tmp.c
-	./a.out
 
 build: compile-production
 	time env $(LSTSFLAGS) ./production --v23 --c -o deploy1.c SRC/index.lsts

Makefile

@@ -1882,13 +1882,13 @@ let lsts-parse-atom-without-tail(tokens: List<Token>): Tuple<AST,List<Token>> =
       tokens = rhs-rest.second;
       lsts-parse-expect(c"}", tokens); tokens = tail(tokens);
       term = mk-app(
-         mk-app(
-            Var( c"while", with-location(mk-token("while"),loc) ),
-            c-rest.first
-         ),
-         mk-app(
-            Var( c"scope", with-location(mk-token("scope"),loc) ),
-            rhs-rest.first
+         Var( c"macro::while", with-location(mk-token("macro::while"),loc) ),
+         mk-cons(
+            c-rest.first,
+            mk-app(
+               Var( c"scope", with-location(mk-token("scope"),loc) ),
+               rhs-rest.first
+            )
          )
       );         
    } else if lsts-parse-head(tokens)==c"match2" {

PLUGINS/FRONTEND/LSTS/lsts-parse.lsts

@@ -1,25 +1,33 @@
 
+let ast-count = 0_sz;
+
 let mk-app(f: AST, a: AST): AST = (
+   ast-count = ast-count + 1;
    App( close(f), close(a) )
 );
 
 let mk-cons-or-app(is-cons: Bool, f: AST, a: AST): AST = (
+   ast-count = ast-count + 1;
    App( is-cons, close(f), close(a) )
 );
 
 let mk-cons(f: AST, a: AST): AST = (
+   ast-count = ast-count + 1;
    App( true, close(f), close(a) )
 );
 
 let mk-glb(k: Token, v: AST): AST = (
+   ast-count = ast-count + 1;
    Glb( k, close(v) )
 );
 
 let mk-seq(): AST = (
+   ast-count = ast-count + 1;
    Seq( mk-vector(type(AST)) )
 );
 
 let mk-typedef(loc: SourceLocation, lhs-type: Type): AST = (
+   ast-count = ast-count + 1;
    Typedef( loc, lhs-type, mk-vector(type(Type)), mk-vector(type(Type)),
              ta, ta, ta, mk-vector(type((CString,Vector<(CString,Type)>))), ta, ta )
 );
@@ -185,10 +193,12 @@ let .with-implied-phi(term: AST, implied-phi: Type): AST = (
 );
 
 let mk-abs(l: AST, r: AST, t: Type): AST = (
+   ast-count = ast-count + 1;
    Abs( close(l), close(r), t )
 );
 
 let mk-meta(l: AST): AST = (
+   ast-count = ast-count + 1;
    Meta( close(l) )
 );
 
@@ -204,34 +214,47 @@ let .is-ascript(t: AST): Bool = (
 );
 
 let mk-var(val: CString): AST = (
+   ast-count = ast-count + 1;
    Var( val, mk-token(val) )
 );
 
 let mk-var(val: String): AST = (
+   ast-count = ast-count + 1;
    Var( val.into(type(CString)), mk-token(val) )
 );
 
 let mk-var(val: Token): AST = (
+   ast-count = ast-count + 1;
    Var( val.key, val )
 );
 
-let mk-var(v: CString, vtk: Token): AST = Var(v,vtk);
+let mk-var(v: CString, vtk: Token): AST = (
+   ast-count = ast-count + 1;
+   Var(v,vtk);
+);
 
 let mk-lit(val: CString): AST = (
+   ast-count = ast-count + 1;
    Lit( val, mk-token(val) )
 );
 
 let mk-lit(val: String): AST = (
+   ast-count = ast-count + 1;
    Lit( val.into(type(CString)), mk-token(val) )
 );
 
 let mk-lit(val: Token): AST = (
+   ast-count = ast-count + 1;
    Lit( val.key, val )
 );
 
-let mk-lit(v: CString, vtk: Token): AST = Lit(v,vtk);
+let mk-lit(v: CString, vtk: Token): AST = (
+   ast-count = ast-count + 1;
+   Lit(v,vtk);
+);
 
 let mk-atype(tt: Type): AST = (
+   ast-count = ast-count + 1;
    AType(tt)
 );
 

SRC/ast-constructor.lsts

@@ -20,6 +20,9 @@ let t2(tag: CString, p1: Type, p2: Type): Type = TGround(tag, mk-vector(type(Typ
 # new allocations = 0
 let tv(name: CString): Type = TVar(name);
 
+# new allocations = 0
+let type-any-arrow = t2(c"Arrow", t0(c"Any"), t0(c"Any"));
+
 # new allocations = 0 if either argument is ?
 #                 | 1
 let $"&&"(lt: Type, rt: Type): Type = (

SRC/type-constructor.lsts

@@ -85,14 +85,19 @@ let std-infer-expr(tctx: Maybe<TypeContext>, term: AST, is-scoped: Bool, used: I
             add-concrete-type-instance(tt, term);
             (tctx, let new-t) = std-infer-expr(tctx, t, false, Tail, tt);
             if not(is(t,new-t)) then { t = new-t; term = mk-app(asc, mk-app(t, mk-atype(tt))); };
+            let is-nullary = false;
             if typeof-term(t).is-arrow and not(tt.is-arrow) and non-zero(var-name-if-var-or-lit(t)) {
+               # This case exists for nullary constructors like TAny : Type
                let ftype = tctx.find-callable( var-name-if-var-or-lit(t), t0(c"Nil"), term, tt ).direct-type;
                tctx = tctx.ascript(term, ftype);
+               is-nullary = true;
+            } else if typeof-term(t) == type-any-arrow {
+               tctx = tctx.ascript(term, tt);
             } else {
                tctx = tctx.ascript(term, typeof-term(t));
             };
             let direct-tctx = tctx.get-or(mk-tctx());
-            if not(direct-tctx.is-blob or typeof-term(t).is-arrow) {
+            if not(direct-tctx.is-blob or is-nullary) {
                # TODO: remove the special exception for "Arrows" here, which is a workaround for raw constructors
                # frontend is producing ((None : TContext?)()) instead of (None() : TContext?)
                # the return hint stuff is working, so all the hard work is done. I think only the frontend needs to change
@@ -225,29 +230,55 @@ let std-infer-expr(tctx: Maybe<TypeContext>, term: AST, is-scoped: Bool, used: I
          };
       );
       Var{key2=key, token=token} => (
-         (tctx, let vt) = typeof-var(term, tctx, key2, hint.is-t(c"MustNotFresh",0) or hint.is-t(c"TailPosition",0));
-         vt = tctx.with-phi(vt, term);
-         mark-var-to-def-todo(tctx, key2, ta, term);
-         # TailPosition LocalVariables don't need to be retained because +1/-1 retain/release cancels itself out
-         if not(hint.is-t(c"TailPosition",0) and vt.is-t(c"LocalVariable",0))
-         and not(hint.is-t(c"MustNotRetain",0))
-         and not(tctx.get-or(mk-tctx()).is-blob) {
-            tctx = tctx.ascript(term, vt);
-            (tctx, term) = maybe-retain(tctx, term);
-         } else {
-            tctx = tctx.ascript(term, vt);
+         let rewritten = false;
+         if not non-zero(hint) {
+            for list Tuple{sfxs1=first, sfxtt1=second} in parse-suffixes {
+               if key2.has-suffix(sfxs1) {
+                  let lpfx1 = key2.remove-suffix(sfxs1).get-or(c"");
+                  term = mk-app( mk-lit(c":",with-key(token,c":")), mk-app( mk-lit(lpfx1,with-key(token,lpfx1)), mk-atype(sfxtt1) ) );
+                  (tctx, term) = std-infer-expr(tctx, term, is-scoped, used, ta);
+                  rewritten = true;
+               }
+            }
+         };
+         if not rewritten {
+            (tctx, let vt) = typeof-var(term, tctx, key2, hint.is-t(c"MustNotFresh",0) or hint.is-t(c"TailPosition",0));
+            vt = tctx.with-phi(vt, term);
+            mark-var-to-def-todo(tctx, key2, ta, term);
+            # TailPosition LocalVariables don't need to be retained because +1/-1 retain/release cancels itself out
+            if not(hint.is-t(c"TailPosition",0) and vt.is-t(c"LocalVariable",0))
+            and not(hint.is-t(c"MustNotRetain",0))
+            and not(tctx.get-or(mk-tctx()).is-blob) {
+               tctx = tctx.ascript(term, vt);
+               (tctx, term) = maybe-retain(tctx, term);
+            } else {
+               tctx = tctx.ascript(term, vt);
+            };
          };
       );
       Lit{key3=key, token=token} => (
-         if hint.is-t(c"Literal",0) {
-            tctx = tctx.ascript(term,hint);
-         } else if not(non-zero(typeof-term(term))) {
-            if hint.is-t(c"HashtableEq",2) and hint.is-datatype and key3==c"HashtableEqEOF"
-            then {
-               (tctx, let lit-tt) = tctx.apply-callable(key3, t0(c"Nil"), term, hint);
-               tctx = tctx.ascript(term, lit-tt);
-            } else {
-               tctx = tctx.ascript(term, t2(c"Arrow",t0(c"Any"),t0(c"Any")));
+         let rewritten = false;
+         if not non-zero(hint) {
+            for list Tuple{sfxs2=first, sfxtt2=second} in parse-suffixes {
+               if key3.has-suffix(sfxs2) {
+                  let lpfx2 = key3.remove-suffix(sfxs2).get-or(c"");
+                  term = mk-app( mk-lit(c":",with-key(token,c":")), mk-app( mk-lit(lpfx2,with-key(token,lpfx2)), mk-atype(sfxtt2) ) );
+                  (tctx, term) = std-infer-expr(tctx, term, is-scoped, used, ta);
+                  rewritten = true;
+               }
+            }
+         };
+         if not rewritten {
+            if hint.is-t(c"Literal",0) {
+              tctx = tctx.ascript(term,hint);
+            } else if not(non-zero(typeof-term(term))) {
+               if hint.is-t(c"HashtableEq",2) and hint.is-datatype and key3==c"HashtableEqEOF"
+               then {
+                  (tctx, let lit-tt) = tctx.apply-callable(key3, t0(c"Nil"), term, hint);
+                  tctx = tctx.ascript(term, lit-tt);
+               } else {
+                  tctx = tctx.ascript(term, type-any-arrow);
+               }
             }
          }
       );

SRC/typecheck-infer-expr.lsts

@@ -58,6 +58,7 @@ let std-apply-macro-location(tctx: Maybe<TypeContext>, mname: CString, margs: AS
 
 let std-apply-macro(tctx: Maybe<TypeContext>, mname: CString, margs: AST, used: IsUsed, strong: Bool): (TypeContext?, AST) = (
    let result = mk-eof();
+   let peeped-type = ta;
    if mname==c"macro::concat" then (tctx, result) = std-apply-macro-concat(tctx, mname, margs)
    else if mname==c"macro::location" then (tctx, result) = std-apply-macro-location(tctx, mname, margs)
    else if mname==c"macro::variable" then (tctx, result) = std-apply-macro-variable(tctx, mname, margs)
@@ -76,7 +77,7 @@ let std-apply-macro(tctx: Maybe<TypeContext>, mname: CString, margs: AST, used:
             peeped = mtype;
          };
       };
-      (tctx, let peeped-type, margs) = std-infer-peeped-arguments(tctx, margs, peep-holes);
+      (tctx, peeped-type, margs) = std-infer-peeped-arguments(tctx, margs, peep-holes);
 
       let matched = [] : List<(Type,AST)>;
       for list Tuple{mtype=first, mterm=third} in row {
@@ -102,7 +103,7 @@ let std-apply-macro(tctx: Maybe<TypeContext>, mname: CString, margs: AST, used:
       (tctx, result) = std-apply-macro-candidates(tctx, mname, margs, candidates);
    };
 
-   if strong and not(non-zero(result)) then exit-error("Failed to Apply Macro: \{mname}\nArgs: \{margs}\n", margs);
+   if strong and not(non-zero(result)) then exit-error("Failed to Apply Macro: \{mname}\nArgs: \{margs} : \{peeped-type}\n", margs);
    if strong {
       (tctx, result) = std-infer-expr(tctx, result, false, used, ta);
       mark-free-and-seen(result);

SRC/typecheck-std-apply-macro.lsts

@@ -31,6 +31,10 @@ let print-toks-json(fp: CString): Nil = (
 let show-alloc-count = false;
 let show-alloc-count-in-program = false;
 
+let show-ast-count = false;
+let ast-parsed-count = 0_sz;
+let ast-typed-count = 0_sz;
+
 let main(argc: C_int, argv: CString[]): Nil = (
    config-v23 = false;
    let argi = 1_sz;
@@ -61,6 +65,7 @@ let main(argc: C_int, argv: CString[]): Nil = (
          c"--stripdebug" => config-strip-debug = true;
          c"--showalloc" => show-alloc-count = true;
          c"--showallocgen" => show-alloc-count-in-program = true;
+         c"--showastcount" => show-ast-count = true;
          c"--profile-ast" => config-profile-ast = true;
          c"-o" => (
             argi = argi + 1;
@@ -128,10 +133,12 @@ let main(argc: C_int, argv: CString[]): Nil = (
                )
             );
          };
+         ast-parsed-count = ast-count;
          match config-mode {
             ModeTypecheck{} => (preprocess(); typecheck(););
             ModeCompile{} => (preprocess(); typecheck(); plugin-current-backend(); );
          };
+         ast-typed-count = ast-count;
       );
    };
    if show-alloc-count then {
@@ -140,6 +147,10 @@ let main(argc: C_int, argv: CString[]): Nil = (
    if config-profile-ast then {
       profile-print-ast()
    };
+   if show-ast-count then {
+      print("AST Count After Parse = \{ast-parsed-count}\n");
+      print("AST Count After Typecheck = \{ast-typed-count}\n");
+   };
    #print("Worse Phi Length \{worst-phi-length}\n");
    #print-allocation-counts()
 );