Merge pull request #2018 from andrew-johnson-4/profile-optimize-type-fsdlslsl

andrew4328 · web-flow · commit 3a48ff719850 · 2026-03-27T13:11:59.000-06:00
Profile optimize type fsdlslsl
diff --git a/Makefile b/Makefile
@@ -7,10 +7,11 @@ LSTSFLAGS = MALLOC_CHECK_=3
 # recursion is used fairly heavily
 # recommendation: ulimit -s unlimited
 
-dev: install-production
-	lm tests/promises/lm-type/can-unify.lsts
+dev: install-bootstrap
+	lm --v23 SRC/index.lsts
+	#lm --v23 --showallocgen tests/promises/lm-typecheck/tc-misc-2.lsts
 	gcc tmp.c
-	./a.out
+	./a.out --v23 SRC/index.lsts
 
 build: compile-production
 	time env $(LSTSFLAGS) ./production --v23 --c -o deploy1.c SRC/index.lsts
diff --git a/PLUGINS/BACKEND/C/std-c-compile-call.lsts b/PLUGINS/BACKEND/C/std-c-compile-call.lsts
@@ -6,7 +6,7 @@ let std-c-compile-call(ctx: FContext, fname: CString, return-hint-if-constructor
                               .expect("std-c-compile-call Function \{fname} was null\nArguments: \{typeof-term(args)}, Return Hint \{return-hint-if-constructor}\nAt \{args.location}\n").blame-or-zero;
    if typeof-term(fterm).is-t(c"Blob",0) {
       if typeof-term(fterm).is-open and fname!=c"open" and fname!=c"mov" then {
-         for list tr in Some(mk-tctx()).lookups(fname) {
+         for vector tr in Some(mk-tctx()).lookups(fname) {
             print("STD C compile call candidate \{fname} : \{tr.dt-or-zero}\n");
          };
          exit-error("STD C compile call is open \{fname} (\{typeof-term(args)})\n\{typeof-term(fterm)}\nArgs \{args}\n", args);
@@ -23,7 +23,7 @@ let std-c-compile-call(ctx: FContext, fname: CString, return-hint-if-constructor
    } else if typeof-term(fterm).is-t(c"Prop",0) { std-c-compile-expr(ctx, args, false)
    } else {
       if typeof-term(fterm).is-open then {
-         for list tr in Some(mk-tctx()).lookups(fname) {
+         for vector tr in Some(mk-tctx()).lookups(fname) {
             print("STD C compile call candidate \{fname} : \{tr.dt-or-zero}\n");
          };
          exit-error("STD C compile call is open \{fname} (\{typeof-term(args)})\n\{typeof-term(fterm)}\nArgs \{args}\n", args);
diff --git a/SRC/prop-core.lsts b/SRC/prop-core.lsts
@@ -1,10 +1,10 @@
 
-let quick-prop = {} : Hashtable<(CString,U64),List<(Type,Type)>>;
+let quick-prop = {} : Hashtable<(CString,U64),Vector<(Type,Type)>>;
 
 let add-quick-prop(pre: Type, pat: Type, post: Type): Nil = (
    let key = pre.ground-tag-and-arity;
-   let val = quick-prop.lookup(key, ([] : List<(Type,Type)>));
-   val = cons( (pat,post), val );
+   let val = quick-prop.lookup(key, mk-vector(type((Type,Type))) );
+   val = val.push( (pat,post) );
    quick-prop = quick-prop.bind( key, val );
 );
 
@@ -54,7 +54,7 @@ let .enrich-strong(base: Type): Type = (
 let enrich-quick-prop(base: Type, pre: Type): Type = (
    match pre {
       TGround { tag=tag, parameters=parameters } => (
-         for list row in quick-prop.lookup( pre.ground-tag-and-arity, ([] : List<(Type,Type)>) ) {
+         for vector row in quick-prop.lookup( pre.ground-tag-and-arity, mk-vector(type((Type,Type))) ) {
             let lt = row.first;
             let rt = row.second;
             if base <: lt then (
@@ -68,7 +68,7 @@ let enrich-quick-prop(base: Type, pre: Type): Type = (
             );
          };
          if tag==c"Array" and parameters.length==2 {
-            for list row in quick-prop.lookup( (c"Array",2_u64), ([] : List<(Type,Type)>) ) {
+            for vector row in quick-prop.lookup( (c"Array",2_u64), mk-vector(type((Type,Type))) ) {
                let lt = row.first;
                let rt = row.second;
                if base <: lt then (
@@ -101,7 +101,7 @@ let enrich-quick-prop(base: Type, pre: Type): Type = (
    pre
 );
 
-let weaken-quick-prop-index = {} : Hashtable<(CString,U64),List<(Type,Type)>>;
+let weaken-quick-prop-index = {} : Hashtable<(CString,U64),Vector<(Type,Type)>>;
 
 # core implicit weakening rules
 add-weaken-quick-prop( t1(c"Constructor",ta), t1(c"Constructor",ta), t1(c"Constructor",ta) );
@@ -124,8 +124,8 @@ add-weaken-quick-prop( t0(c"Tag::"), ta, t0(c"Tag::") );
 
 let add-weaken-quick-prop(pre: Type, pat: Type, post: Type): Nil = (
    let key = pre.ground-tag-and-arity;
-   let val = weaken-quick-prop-index.lookup(key, ([] : List<(Type,Type)>));
-   val = cons( (pat,post), val );
+   let val = weaken-quick-prop-index.lookup(key, mk-vector(type((Type,Type))) );
+   val = val.push( (pat,post) );
    weaken-quick-prop-index = weaken-quick-prop-index.bind( key, val );
 );
 
@@ -137,15 +137,15 @@ let weaken-quick-prop(original-base: Type, base: Type, pre: Type): Type = (
    let early-base = base;
    match pre {
       TGround { tag=tag, parameters=parameters } => (
-         for list row in weaken-quick-prop-index.lookup( pre.ground-tag-and-arity, ([] : List<(Type,Type)>) ) {
+         for vector row in weaken-quick-prop-index.lookup( pre.ground-tag-and-arity, mk-vector(type((Type,Type))) ) {
             let lt = row.first;
             let rt = row.second;
             if can-unify(lt, original-base) then (
                base = remove-info(base, rt);
             );
          };
          if tag==c"Array" and parameters.length==2 {
-            for list row in weaken-quick-prop-index.lookup( (c"Array",2_u64), ([] : List<(Type,Type)>) ) {
+            for vector row in weaken-quick-prop-index.lookup( (c"Array",2_u64), mk-vector(type((Type,Type))) ) {
                let lt = row.first;
                let rt = row.second;
                if can-unify(lt, original-base) then (
@@ -159,7 +159,7 @@ let weaken-quick-prop(original-base: Type, base: Type, pre: Type): Type = (
             let ti = 1_sz;
             while ti < tag-parts.length {
                let tag-part = tag-parts[ti];
-               for list row in weaken-quick-prop-index.lookup( (tag-base, parameters.length as U64), ([] : List<(Type,Type)>) ) {
+               for vector row in weaken-quick-prop-index.lookup( (tag-base, parameters.length as U64), mk-vector(type((Type,Type))) ) {
                   let lt = row.first;
                   let rt = row.second;
                   if can-unify(lt, original-base) then (
@@ -216,15 +216,15 @@ let unenrich-quick-prop(original-base: Type, base: Type, pre: Type): Type = (
    let early-base = base;
    match pre {
       TGround { tag=tag, parameters=parameters } => (
-         for list row in quick-prop.lookup( pre.ground-tag-and-arity, ([] : List<(Type,Type)>) ) {
+         for vector row in quick-prop.lookup( pre.ground-tag-and-arity, mk-vector(type((Type,Type))) ) {
             let lt = row.first;
             let rt = row.second;
             if can-unify(lt, original-base) then (
                base = remove-info(base, rt);
             );
          };
          if tag==c"Array" and parameters.length==2 {
-            for list row in quick-prop.lookup( (c"Array",2_u64), ([] : List<(Type,Type)>) ) {
+            for vector row in quick-prop.lookup( (c"Array",2_u64), mk-vector(type((Type,Type))) ) {
                let lt = row.first;
                let rt = row.second;
                if can-unify(lt, original-base) then (
@@ -238,7 +238,7 @@ let unenrich-quick-prop(original-base: Type, base: Type, pre: Type): Type = (
             let ti = 1_sz;
             while ti < tag-parts.length {
                let tag-part = tag-parts[ti];
-               for list row in quick-prop.lookup( (tag-base, parameters.length as U64), ([] : List<(Type,Type)>) ) {
+               for vector row in quick-prop.lookup( (tag-base, parameters.length as U64), mk-vector(type((Type,Type))) ) {
                   let lt = row.first;
                   let rt = row.second;
                   if can-unify(lt, original-base) then (
diff --git a/SRC/prop-stack-to-specialize.lsts b/SRC/prop-stack-to-specialize.lsts
@@ -1,4 +1,4 @@
 
 type StackToSpecialize = { key:CString, ctx:Maybe<TypeContext>, result-type:Type, term: AST };
 
-let stack-to-specialize = [] : List<StackToSpecialize>;
+let stack-to-specialize = mk-vector(type(StackToSpecialize));
diff --git a/SRC/prop-tctx-apply-callable.lsts b/SRC/prop-tctx-apply-callable.lsts
@@ -34,7 +34,7 @@ let .apply-callable(tctx: TypeContext?, fname: CString, arg-types: Type, blame:
       if f-row.get-or-panic.dt-or-zero.is-open {
          let special-type = apply-tctx.substitute(f-row.get-or-panic.nt-or-zero).without-phi-keep-state;
          if not(is-special(fname,special-type)) {
-            stack-to-specialize = cons( StackToSpecialize(fname,apply-tctx,special-type,f-row.get-or-panic.blame-or-zero), stack-to-specialize );
+            stack-to-specialize = stack-to-specialize.push( StackToSpecialize(fname,apply-tctx,special-type,f-row.get-or-panic.blame-or-zero) );
          }
       }
    };
diff --git a/SRC/prop-tctx-find-callable.lsts b/SRC/prop-tctx-find-callable.lsts
@@ -25,7 +25,7 @@ let .find-callable(tctx: TypeContext?, fname: CString, arg-types: Type, blame: A
    let match-set = mk-vector(type(TypeContextRow));
 
    # Find all accepting function candidates
-   for list tr in tctx.lookups(fname) {
+   for vector tr in tctx.lookups(fname) {
       # can-receive is an additional refinement on top of argument satisfaction
       # it is necessary for nullary or partial constructors that need a full type
       # like, None : TypeContext?
@@ -61,7 +61,7 @@ let .find-callable(tctx: TypeContext?, fname: CString, arg-types: Type, blame: A
    # Fail if function call is ambiguous
    if failable and not(non-zero(result)) then {
       eprint("Unable to find appropriate callable: \{fname} \{arg-types} return hint: \{return-type-hint}\nAt: \{blame.location}\n");
-      for list tr in tctx.lookups(fname) {
+      for vector tr in tctx.lookups(fname) {
          eprint("Candidate: \{tr.dt-or-zero}\n");
       };
       exit(1);
diff --git a/SRC/tctx-bind.lsts b/SRC/tctx-bind.lsts
@@ -19,14 +19,14 @@ let .bind(tctx: TypeContext?, k: CString, nt: Type, dt: Type, blame: AST): TypeC
 );
 
 let .bind-global(tctx: TypeContext?, k: CString, kt: Type, blame: AST): TypeContext? = (
-   let found = global-tctx.lookup(k, [] : List<TypeContextRow>);
-   found = cons( TypeContextRow(k,kt,kt,blame), found );
+   let found = global-tctx.lookup(k, mk-vector(type(TypeContextRow)) );
+   found = found.push( TypeContextRow(k,kt,kt,blame) );
    global-tctx = global-tctx.bind(k, found);
    tctx
 );
 let .bind-global(tctx: TypeContext?, k: CString, nt: Type, dt: Type, blame: AST): TypeContext? = (
-   let found = global-tctx.lookup(k, [] : List<TypeContextRow>);
-   found = cons( TypeContextRow(k,nt,dt,blame), found );
+   let found = global-tctx.lookup(k, mk-vector(type(TypeContextRow)) );
+   found = found.push( TypeContextRow(k,nt,dt,blame) );
    global-tctx = global-tctx.bind(k, found);
    tctx
 );
diff --git a/SRC/tctx-definition.lsts b/SRC/tctx-definition.lsts
@@ -1,5 +1,5 @@
 
-let global-tctx = {} : Hashtable<CString,List<TypeContextRow>>;
+let global-tctx = {} : Hashtable<CString,Vector<TypeContextRow>>;
 let tctx-currently-processing-globals = true;
 
 type TypeContextRow zero NullTypeContextRow implies MustRetain, MustRelease = NullTypeContextRow | TypeContextRow { key: CString, nt: Type, dt: Type, blame: AST };
diff --git a/SRC/tctx-lookup.lsts b/SRC/tctx-lookup.lsts
@@ -10,7 +10,7 @@ let .lookup(trs: List<TypeContextRow>, key: CString): TypeContextRow = (
       }
    }};
    if not(non-zero(default)) {
-      for list tr in global-tctx.lookup(key, [] : List<TypeContextRow>) {
+      for vector tr in global-tctx.lookup(key, mk-vector(type(TypeContextRow)) ) {
          if tr.key-or-zero == key {
             if non-zero(default) {
                eprint("Duplicate Global Symbol \{key}\n");
@@ -25,20 +25,20 @@ let .lookup(trs: List<TypeContextRow>, key: CString): TypeContextRow = (
    default
 );
 
-let .lookups(tctx: TypeContext?, key: CString): List<TypeContextRow> = tctx.get-or(mk-tctx()).tctx.lookups(key);
-let .lookups(trs: List<TypeContextRow>, key: CString): List<TypeContextRow> = (
-   let default = [] : List<TypeContextRow>;
+let .lookups(tctx: TypeContext?, key: CString): Vector<TypeContextRow> = tctx.get-or(mk-tctx()).tctx.lookups(key);
+let .lookups(trs: List<TypeContextRow>, key: CString): Vector<TypeContextRow> = (
+   let default = mk-vector(type(TypeContextRow));
    let continue = true;
    for list tr in trs { if continue {
       if tr.key-or-zero == key {
-         default = cons(tr, default);
+         default = default.push(tr);
          continue = false;
       }
    }};
    if continue {
-      for list tr in global-tctx.lookup(key, [] : List<TypeContextRow>) {
+      for vector tr in global-tctx.lookup(key, mk-vector(type(TypeContextRow)) ) {
          if tr.key-or-zero == key {
-            default = cons(tr, default);
+            default = default.push(tr);
          }
       };
    };
diff --git a/SRC/typecheck-infer-expr.lsts b/SRC/typecheck-infer-expr.lsts
@@ -193,6 +193,7 @@ let std-infer-expr(tctx: Maybe<TypeContext>, term: AST, is-scoped: Bool, used: I
          }};
       );
       Glb{key1=key, val=val} => (
+         let prev-count-history = safe-alloc-block-count-monotonic-history;
          let rough-tt = typeof-term(term);
          if rough-tt.is-arrow and not(rough-tt.is-open) and not(rough-tt.is-t(c"TypedMacro",0)) {
             let tctx-tctx = tctx.get-or(mk-tctx());
diff --git a/SRC/typecheck-typecheck.lsts b/SRC/typecheck-typecheck.lsts
@@ -8,10 +8,9 @@ let typecheck(): Nil = (
    tctx-currently-processing-globals = false;
    (global-flow-tctx, ast-parsed-program) = std-infer-expr(global-flow-tctx, ast-parsed-program, false, Used, ta);
    # TODO: release globals for graceful exit
-   while non-zero(stack-to-specialize) { match stack-to-specialize {
+   while non-zero(stack-to-specialize) { match stack-to-specialize.pop {
       # this can't be a normal for-loop because it gets extended during iteration
-      [StackToSpecialize{ key=key, ctx=ctx, result-type=result-type, term=term }.. rst] => (
-         stack-to-specialize = rst;
+      StackToSpecialize{ key=key, ctx=ctx, result-type=result-type, term=term } => (
          specialize(key, ctx, result-type, term);
       );
    }};
diff --git a/profile-promises.sh b/profile-promises.sh
@@ -2,7 +2,7 @@
 
 rm -rf promises.prof
 
-for fp in `ls tests/promises/lm-type/*.lsts`;
+for fp in `ls tests/promises/lm-tctx/*.lsts`;
 do
 	echo "Processing promise file $fp"
 	rm -f tmp.c a.out
diff --git a/tests/promises/lm-type/destructor.lsts b/tests/promises/lm-type/destructor.lsts
@@ -135,3 +135,4 @@ assert( t0(c"B").without-slot(c"A",0) == t0(c"B") );
 assert( (t0(c"A") && t0(c"B")).without-slot(c"A",0) == t0(c"B") );
 assert( (t0(c"A") && t0(c"B") && t0(c"C")).without-slot(c"A",0) == (t0(c"B") && t0(c"C")) );
 assert( safe-alloc-block-count == 0 );
+
diff --git a/tests/promises/lm-typecheck/tc-misc-1-target.lsts b/tests/promises/lm-typecheck/tc-misc-1-target.lsts
@@ -0,0 +1,2 @@
+
+import lib/core/bedrock.lsts;
diff --git a/tests/promises/lm-typecheck/tc-misc-1-target.lsts.skip b/tests/promises/lm-typecheck/tc-misc-1-target.lsts.skip
diff --git a/tests/promises/lm-typecheck/tc-misc-1.lsts b/tests/promises/lm-typecheck/tc-misc-1.lsts
@@ -0,0 +1,9 @@
+
+import SRC/unit-backend-core.lsts;
+import PLUGINS/FRONTEND/LSTS/index.lsts;
+import PLUGINS/BACKEND/C/index.lsts;
+import PLUGINS/FRONTEND/C/index.lsts;
+
+lsts-frontend(c"tests/promises/lm-typecheck/tc-misc-1-target.lsts");
+preprocess();
+typecheck();
diff --git a/tests/promises/lm-typecheck/tc-misc-2-target.lsts b/tests/promises/lm-typecheck/tc-misc-2-target.lsts
@@ -0,0 +1,55 @@
+
+type opaque alias I64 suffix _i64 = C<"int64_t">;
+type String suffix _ss implies MustRetain, MustRelease
+          = { start-offset:USize, end-offset:USize, data:OwnedData<U8>[] };
+type OwnedData<t> = {
+   reference-count: USize,
+   occupied: USize,
+   capacity: USize,
+   data: t[]+FlexibleArrayMember
+};
+
+let mk-owned-data(tt: Type<t>, capacity: USize, occupied: USize): OwnedData<t>[] = (
+   let od = safe-alloc-impl(
+      # TODO: make sizeof return USize
+      (sizeof(OwnedData<t>) as USize) + (sizeof(t) as USize) * capacity,
+      type(OwnedData<t>)
+   );
+   od.reference-count = 1;
+   od.occupied = occupied;
+   od.capacity = capacity;
+   od
+);
+
+let mk-owned-data(tt: Type<t>, capacity: USize): OwnedData<t>[] = (
+   mk-owned-data(tt, capacity, 0)
+);
+
+let .into(i: I64, tt: Type<String>): String = (
+   let od = mk-owned-data(type(U8), 20_sz);
+   let cs-length = 0_sz;
+   let is-negative = false;
+   if i < 0_i64 {
+      is-negative = true;
+      od.push(45);
+      cs-length = cs-length + 1;
+   } else if i == 0_i64 {
+      od.push(48);
+      cs-length = cs-length + 1;
+   };
+   while i != 0_i64 {
+      od.push(48 + (abs(i % 10) as U8));
+      cs-length = cs-length + 1;
+      i = i / 10;
+   };
+   let start-i = if is-negative then 1_sz else 0_sz;
+   let end-i = cs-length - 1_sz;
+   while start-i < end-i {
+      let tmpc = od.data[start-i];
+      od.data[start-i] = od.data[end-i];
+      od.data[end-i] = tmpc;
+      start-i = start-i + 1_sz;
+      end-i = end-i - 1_sz;
+   };
+   String(0 as USize, cs-length, od)
+);
diff --git a/tests/promises/lm-typecheck/tc-misc-2-target.lsts.skip b/tests/promises/lm-typecheck/tc-misc-2-target.lsts.skip
diff --git a/tests/promises/lm-typecheck/tc-misc-2.lsts b/tests/promises/lm-typecheck/tc-misc-2.lsts
@@ -0,0 +1,9 @@
+
+import SRC/unit-backend-core.lsts;
+import PLUGINS/FRONTEND/LSTS/index.lsts;
+import PLUGINS/BACKEND/C/index.lsts;
+import PLUGINS/FRONTEND/C/index.lsts;
+
+lsts-frontend(c"tests/promises/lm-typecheck/tc-misc-2-target.lsts");
+preprocess();
+typecheck();

Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,4 @@`
`1`	`1`
`2`	`2`	`type StackToSpecialize = { key:CString, ctx:Maybe<TypeContext>, result-type:Type, term: AST };`
`3`	`3`
`4`		`-let stack-to-specialize = [] : List<StackToSpecialize>;`
	`4`	`+let stack-to-specialize = mk-vector(type(StackToSpecialize));`
Original file line number	Diff line number	Diff line change
`@@ -34,7 +34,7 @@ let .apply-callable(tctx: TypeContext?, fname: CString, arg-types: Type, blame:`
`34`	`34`	`if f-row.get-or-panic.dt-or-zero.is-open {`
`35`	`35`	`let special-type = apply-tctx.substitute(f-row.get-or-panic.nt-or-zero).without-phi-keep-state;`
`36`	`36`	`if not(is-special(fname,special-type)) {`
`37`		`- stack-to-specialize = cons( StackToSpecialize(fname,apply-tctx,special-type,f-row.get-or-panic.blame-or-zero), stack-to-specialize );`
	`37`	`+ stack-to-specialize = stack-to-specialize.push( StackToSpecialize(fname,apply-tctx,special-type,f-row.get-or-panic.blame-or-zero) );`
`38`	`38`	`}`
`39`	`39`	`}`
`40`	`40`	`};`