More misc optimizations flwemfewl

Makefile

@@ -8,7 +8,10 @@ LSTSFLAGS = MALLOC_CHECK_=3
 # recommendation: ulimit -s unlimited
 
 dev: install-production
-	lm --v23 --showalloc SRC/index.lsts > out.txt
+	#lm --showalloc SRC/unit-tctx-core.lsts > out.txt
+	#lm --showalloc SRC/unit-prop-core.lsts > out.txt
+	#lm --showalloc SRC/unit-ascript-core.lsts > out.txt
+	lm --showalloc --v23 SRC/index.lsts > out.txt
 
 build: compile-production
 	time env $(LSTSFLAGS) ./production --v23 --c -o deploy1.c SRC/index.lsts

PLUGINS/BACKEND/C/compile-program-ordered.lsts

@@ -2,6 +2,7 @@
 let compile-program-ordered(global-ctx: FContext, program: AST): Nil = (
    for vector g in program.unroll-seq { match g {
       Glb{ key=key, val=val } => (
+         config-hot-path = key.key == c"std-bind-term";
          if not(typeof-term(def-to-sym(g)).is-open)
          or not(typeof-term(val).is-open) then {
             std-c-compile-global(global-ctx, key.key, val);

PLUGINS/BACKEND/C/std-c-compile-expr.lsts

@@ -309,7 +309,8 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
    };
    if is-stmt and non-zero(f.get(c"expression")) then f = f.set(c"expression", f.get(c"expression") + SAtom(c";"));
    f.context = close(ctx);
-   f.type = typeof-term(t); f
+   f.type = typeof-term(t);
+   f
 );
 
 

PLUGINS/BACKEND/C/std-c-compile-global.lsts

@@ -186,7 +186,7 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
          } else {
             text = SAtom(k) + SAtom(c" = ") + inner-expr.get(c"expression") + SAtom(c";\n");
             assemble-global-initializer-section = assemble-global-initializer-section + text;
-         }
+         };
       );
    }
 );

SRC/ast-constructor.lsts

@@ -50,15 +50,15 @@ let .is-var-or-ascripted-var(t: AST): Bool = (
 let .with-implies(term: AST, implies: Vector<Type>): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implements = (term as Tag::Typedef).implements;
-         let size = (term as Tag::Typedef).size;
-         let alias = (term as Tag::Typedef).alias;
-         let opaque-alias = (term as Tag::Typedef).opaque-alias;
-         let cases = (term as Tag::Typedef).cases;
-         let misc-type = (term as Tag::Typedef).misc-type;
-         let implied-phi = (term as Tag::Typedef).implied-phi;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implements = open((term as Tag::Typedef).td).implements;
+         let size = open((term as Tag::Typedef).td).size;
+         let alias = open((term as Tag::Typedef).td).alias;
+         let opaque-alias = open((term as Tag::Typedef).td).opaque-alias;
+         let cases = open((term as Tag::Typedef).td).cases;
+         let misc-type = open((term as Tag::Typedef).td).misc-type;
+         let implied-phi = open((term as Tag::Typedef).td).implied-phi;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;
@@ -67,15 +67,15 @@ let .with-implies(term: AST, implies: Vector<Type>): AST = (
 let .with-implements(term: AST, implements: Vector<Type>): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implies = (term as Tag::Typedef).implies;
-         let size = (term as Tag::Typedef).size;
-         let alias = (term as Tag::Typedef).alias;
-         let opaque-alias = (term as Tag::Typedef).opaque-alias;
-         let cases = (term as Tag::Typedef).cases;
-         let misc-type = (term as Tag::Typedef).misc-type;
-         let implied-phi = (term as Tag::Typedef).implied-phi;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implies = open((term as Tag::Typedef).td).implies;
+         let size = open((term as Tag::Typedef).td).size;
+         let alias = open((term as Tag::Typedef).td).alias;
+         let opaque-alias = open((term as Tag::Typedef).td).opaque-alias;
+         let cases = open((term as Tag::Typedef).td).cases;
+         let misc-type = open((term as Tag::Typedef).td).misc-type;
+         let implied-phi = open((term as Tag::Typedef).td).implied-phi;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;
@@ -84,15 +84,15 @@ let .with-implements(term: AST, implements: Vector<Type>): AST = (
 let .with-size(term: AST, size: Type): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implies = (term as Tag::Typedef).implies;
-         let implements = (term as Tag::Typedef).implements;
-         let alias = (term as Tag::Typedef).alias;
-         let opaque-alias = (term as Tag::Typedef).opaque-alias;
-         let cases = (term as Tag::Typedef).cases;
-         let misc-type = (term as Tag::Typedef).misc-type;
-         let implied-phi = (term as Tag::Typedef).implied-phi;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implies = open((term as Tag::Typedef).td).implies;
+         let implements = open((term as Tag::Typedef).td).implements;
+         let alias = open((term as Tag::Typedef).td).alias;
+         let opaque-alias = open((term as Tag::Typedef).td).opaque-alias;
+         let cases = open((term as Tag::Typedef).td).cases;
+         let misc-type = open((term as Tag::Typedef).td).misc-type;
+         let implied-phi = open((term as Tag::Typedef).td).implied-phi;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;
@@ -101,15 +101,15 @@ let .with-size(term: AST, size: Type): AST = (
 let .with-alias(term: AST, alias: Type): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implies = (term as Tag::Typedef).implies;
-         let implements = (term as Tag::Typedef).implements;
-         let size = (term as Tag::Typedef).size;
-         let opaque-alias = (term as Tag::Typedef).opaque-alias;
-         let cases = (term as Tag::Typedef).cases;
-         let misc-type = (term as Tag::Typedef).misc-type;
-         let implied-phi = (term as Tag::Typedef).implied-phi;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implies = open((term as Tag::Typedef).td).implies;
+         let implements = open((term as Tag::Typedef).td).implements;
+         let size = open((term as Tag::Typedef).td).size;
+         let opaque-alias = open((term as Tag::Typedef).td).opaque-alias;
+         let cases = open((term as Tag::Typedef).td).cases;
+         let misc-type = open((term as Tag::Typedef).td).misc-type;
+         let implied-phi = open((term as Tag::Typedef).td).implied-phi;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;
@@ -118,15 +118,15 @@ let .with-alias(term: AST, alias: Type): AST = (
 let .with-opaque-alias(term: AST, opaque-alias: Type): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implies = (term as Tag::Typedef).implies;
-         let implements = (term as Tag::Typedef).implements;
-         let size = (term as Tag::Typedef).size;
-         let alias = (term as Tag::Typedef).alias;
-         let cases = (term as Tag::Typedef).cases;
-         let misc-type = (term as Tag::Typedef).misc-type;
-         let implied-phi = (term as Tag::Typedef).implied-phi;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implies = open((term as Tag::Typedef).td).implies;
+         let implements = open((term as Tag::Typedef).td).implements;
+         let size = open((term as Tag::Typedef).td).size;
+         let alias = open((term as Tag::Typedef).td).alias;
+         let cases = open((term as Tag::Typedef).td).cases;
+         let misc-type = open((term as Tag::Typedef).td).misc-type;
+         let implied-phi = open((term as Tag::Typedef).td).implied-phi;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;
@@ -135,15 +135,15 @@ let .with-opaque-alias(term: AST, opaque-alias: Type): AST = (
 let .with-cases(term: AST, cases: Vector<(CString,Vector<(CString,Type)>)>): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implies = (term as Tag::Typedef).implies;
-         let implements = (term as Tag::Typedef).implements;
-         let size = (term as Tag::Typedef).size;
-         let alias = (term as Tag::Typedef).alias;
-         let opaque-alias = (term as Tag::Typedef).opaque-alias;
-         let misc-type = (term as Tag::Typedef).misc-type;
-         let implied-phi = (term as Tag::Typedef).implied-phi;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implies = open((term as Tag::Typedef).td).implies;
+         let implements = open((term as Tag::Typedef).td).implements;
+         let size = open((term as Tag::Typedef).td).size;
+         let alias = open((term as Tag::Typedef).td).alias;
+         let opaque-alias = open((term as Tag::Typedef).td).opaque-alias;
+         let misc-type = open((term as Tag::Typedef).td).misc-type;
+         let implied-phi = open((term as Tag::Typedef).td).implied-phi;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;
@@ -152,15 +152,15 @@ let .with-cases(term: AST, cases: Vector<(CString,Vector<(CString,Type)>)>): AST
 let .with-misc(term: AST, misc-type: Type): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implies = (term as Tag::Typedef).implies;
-         let implements = (term as Tag::Typedef).implements;
-         let size = (term as Tag::Typedef).size;
-         let alias = (term as Tag::Typedef).alias;
-         let opaque-alias = (term as Tag::Typedef).opaque-alias;
-         let cases = (term as Tag::Typedef).cases;
-         let implied-phi = (term as Tag::Typedef).implied-phi;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implies = open((term as Tag::Typedef).td).implies;
+         let implements = open((term as Tag::Typedef).td).implements;
+         let size = open((term as Tag::Typedef).td).size;
+         let alias = open((term as Tag::Typedef).td).alias;
+         let opaque-alias = open((term as Tag::Typedef).td).opaque-alias;
+         let cases = open((term as Tag::Typedef).td).cases;
+         let implied-phi = open((term as Tag::Typedef).td).implied-phi;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;
@@ -169,15 +169,15 @@ let .with-misc(term: AST, misc-type: Type): AST = (
 let .with-implied-phi(term: AST, implied-phi: Type): AST = (
    match term {
       Typedef{} => (
-         let location = (term as Tag::Typedef).location;
-         let lhs-type = (term as Tag::Typedef).lhs-type;
-         let implies = (term as Tag::Typedef).implies;
-         let implements = (term as Tag::Typedef).implements;
-         let size = (term as Tag::Typedef).size;
-         let alias = (term as Tag::Typedef).alias;
-         let opaque-alias = (term as Tag::Typedef).opaque-alias;
-         let cases = (term as Tag::Typedef).cases;
-         let misc-type = (term as Tag::Typedef).misc-type;
+         let location = open((term as Tag::Typedef).td).location;
+         let lhs-type = open((term as Tag::Typedef).td).lhs-type;
+         let implies = open((term as Tag::Typedef).td).implies;
+         let implements = open((term as Tag::Typedef).td).implements;
+         let size = open((term as Tag::Typedef).td).size;
+         let alias = open((term as Tag::Typedef).td).alias;
+         let opaque-alias = open((term as Tag::Typedef).td).opaque-alias;
+         let cases = open((term as Tag::Typedef).td).cases;
+         let misc-type = open((term as Tag::Typedef).td).misc-type;
          Typedef( location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi );
       );
       _ => term;

SRC/ast-definition.lsts

@@ -2,6 +2,28 @@
 type SourceLocation = { filename: CString, line: U64, column: U64 };
 type Token = { key: CString, nonce: U64, location: SourceLocation };
 
+# This AST row is very fat, so we move it into an indirect data
+# TODO: do this optimization automatically or with a simple annotation
+type ASTTypedef = { location: SourceLocation, lhs-type: Type, implies: Vector<Type>, implements: Vector<Type>,
+                    size: Type, alias: Type, opaque-alias: Type, cases: Vector<(CString,Vector<(CString,Type)>)>,
+                    misc-type: Type, implied-phi: Type };
+
+let $"Typedef"(location: SourceLocation, lhs-type: Type, implies: Vector<Type>, implements: Vector<Type>,
+                    size: Type, alias: Type, opaque-alias: Type, cases: Vector<(CString,Vector<(CString,Type)>)>,
+                    misc-type: Type, implied-phi: Type): AST = (
+   Typedef(close(ASTTypedef(location, lhs-type, implies, implements, size, alias, opaque-alias, cases, misc-type, implied-phi)))
+);
+
+let .lhs-type(t: AST+Tag::Typedef): Type = open((t as Tag::Typedef).td).lhs-type;
+let .implies(t: AST+Tag::Typedef): Vector<Type> = open((t as Tag::Typedef).td).implies;
+let .implements(t: AST+Tag::Typedef): Vector<Type> = open((t as Tag::Typedef).td).implements;
+let .size(t: AST+Tag::Typedef): Type = open((t as Tag::Typedef).td).size;
+let .alias(t: AST+Tag::Typedef): Type = open((t as Tag::Typedef).td).alias;
+let .opaque-alias(t: AST+Tag::Typedef): Type = open((t as Tag::Typedef).td).opaque-alias;
+let .cases(t: AST+Tag::Typedef): Vector<(CString,Vector<(CString,Type)>)> = open((t as Tag::Typedef).td).cases;
+let .misc-type(t: AST+Tag::Typedef): Type = open((t as Tag::Typedef).td).misc-type;
+let .implied-phi(t: AST+Tag::Typedef): Type = open((t as Tag::Typedef).td).implied-phi;
+
 type AST zero ASTEOF implies MustRetain, MustRelease
          = Meta { val: OwnedData<AST>[] }
          | ASTEOF
@@ -13,12 +35,23 @@ type AST zero ASTEOF implies MustRetain, MustRelease
          | AType { tt: Type }
          | Seq { seq: Vector<AST> }
          | Glb { key: Token , val: OwnedData<AST>[] }
-         | Typedef { location: SourceLocation, lhs-type: Type, implies: Vector<Type>, implements: Vector<Type>,
-                      size: Type, alias: Type, opaque-alias: Type, cases: Vector<(CString,Vector<(CString,Type)>)>,
-                      misc-type: Type, implied-phi: Type };
+         | Typedef { td: OwnedData<ASTTypedef>[] };
 
 let $"App"(left: OwnedData<AST>[], right: OwnedData<AST>[]): AST = App ( false, left, right );
 
+let .retain(t: ASTTypedef): ASTTypedef = (
+   mark-as-released(t.lhs-type.retain);
+   mark-as-released(t.implies.retain);
+   mark-as-released(t.implements.retain);
+   mark-as-released(t.size.retain);
+   mark-as-released(t.alias.retain);
+   mark-as-released(t.opaque-alias.retain);
+   mark-as-released(t.cases.retain);
+   mark-as-released(t.misc-type.retain);
+   mark-as-released(t.implied-phi.retain);
+   t
+);
+
 let .retain(t: AST): AST = (
    if t.discriminator-case-tag==(t as Tag::Meta).discriminator-case-tag {
       (t as Tag::Meta).val.retain;
@@ -42,19 +75,23 @@ let .retain(t: AST): AST = (
       (t as Tag::Glb).val.retain;
    };
    if t.discriminator-case-tag==(t as Tag::Typedef).discriminator-case-tag {
-      mark-as-released((t as Tag::Typedef).lhs-type.retain);
-      mark-as-released((t as Tag::Typedef).implies.retain);
-      mark-as-released((t as Tag::Typedef).implements.retain);
-      mark-as-released((t as Tag::Typedef).size.retain);
-      mark-as-released((t as Tag::Typedef).alias.retain);
-      mark-as-released((t as Tag::Typedef).opaque-alias.retain);
-      mark-as-released((t as Tag::Typedef).cases.retain);
-      mark-as-released((t as Tag::Typedef).misc-type.retain);
-      mark-as-released((t as Tag::Typedef).implied-phi.retain);
+      mark-as-released((t as Tag::Typedef).td.retain);
    };
    t
 );
 
+let .release(t: ASTTypedef): Nil = (
+   t.lhs-type.release;
+   t.implies.release;
+   t.implements.release;
+   t.size.release;
+   t.alias.release;
+   t.opaque-alias.release;
+   t.cases.release;
+   t.misc-type.release;
+   t.implied-phi.release;
+);
+
 let .release(t: AST): Nil = (
    if t.discriminator-case-tag==(t as Tag::Meta).discriminator-case-tag {
       (t as Tag::Meta).val.release;
@@ -78,15 +115,7 @@ let .release(t: AST): Nil = (
       (t as Tag::Glb).val.release;
    };
    if t.discriminator-case-tag==(t as Tag::Typedef).discriminator-case-tag {
-      (t as Tag::Typedef).lhs-type.release;
-      (t as Tag::Typedef).implies.release;
-      (t as Tag::Typedef).implements.release;
-      (t as Tag::Typedef).size.release;
-      (t as Tag::Typedef).alias.release;
-      (t as Tag::Typedef).opaque-alias.release;
-      (t as Tag::Typedef).cases.release;
-      (t as Tag::Typedef).misc-type.release;
-      (t as Tag::Typedef).implied-phi.release;
+      (t as Tag::Typedef).td.release;
    };
    mark-as-released(t);
 );

SRC/ast-location.lsts

@@ -11,7 +11,7 @@ let .location(term: AST): SourceLocation = (
          for vector s in seq { loc = loc || s.location };
          loc
       );
-      Typedef{ location=location } => location;
+      Typedef{ td=td } => open(td).location;
       _ => mk-location();
    }
 );

SRC/typecheck-var-to-def-index.lsts

@@ -1,4 +1,6 @@
 
+let config-hot-path = false;
+
 let var-to-def-index = mk-hashtable-is(type(AST), type(AST));
 
 let var-to-def(k: AST): AST = (

lib/core/array.lsts

@@ -55,6 +55,11 @@ let safe-alloc-semaphore = false;
 #);
 
 let safe-alloc-impl(nb: USize, tt: Type<t>): t[] = (
+   # TODO: wrap counter adjustments in conditional compilation
+   safe-alloc-block-count = safe-alloc-block-count + 1;
+   safe-alloc-block-count-monotonic = safe-alloc-block-count-monotonic + 1;
+   safe-alloc-block-count-monotonic-history = safe-alloc-block-count-monotonic-history + 1;
+
    #let tk = type(t).into(type(CString));
    #if tk != c"SparseOwnedData<Tuple<U64,C<\"char\">[],HashtableRowExists>>" {
    #   alloc-type-counter = alloc-type-counter.bind(tk, alloc-type-counter.lookup(tk,0_u64) + 1);
@@ -74,11 +79,6 @@ let safe-alloc-impl(nb: USize, tt: Type<t>): t[] = (
 
    mark-memory-as-safe(ptr as U8[], nb);
 
-   # TODO: wrap counter adjustments in conditional compilation
-   safe-alloc-block-count = safe-alloc-block-count + 1;
-   safe-alloc-block-count-monotonic = safe-alloc-block-count-monotonic + 1;
-   safe-alloc-block-count-monotonic-history = safe-alloc-block-count-monotonic-history + 1;
-
    ptr
 );