More misc optimizations fdkslrfewl

Makefile

@@ -7,11 +7,8 @@ LSTSFLAGS = MALLOC_CHECK_=3
 # recursion is used fairly heavily
 # recommendation: ulimit -s unlimited
 
-dev: install-bootstrap
-	lm --v23 SRC/index.lsts
-	#lm --v23 --showallocgen tests/promises/lm-typecheck/tc-misc-2.lsts
-	gcc tmp.c
-	./a.out --v23 SRC/index.lsts
+dev: install-production
+	lm --v23 --showalloc SRC/index.lsts > out.txt
 
 build: compile-production
 	time env $(LSTSFLAGS) ./production --v23 --c -o deploy1.c SRC/index.lsts

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

@@ -6,10 +6,10 @@ let std-c-force-import-clib(lib: CString): Nil = (
 );
 
 let std-c-finish-forced-imports(): S = (
-   (if std-c-force-imports.has(c"stdlib.h") then SAtom(c"#include <stdlib.h>\n") else SNil()) +
-   (if std-c-force-imports.has(c"stdio.h") then SAtom(c"#include <stdio.h>\n") else SNil()) +
-   (if std-c-force-imports.has(c"regex.h") then SAtom(c"#include <regex.h>\n") else SNil()) +
-   (if std-c-force-imports.has(c"string.h") then SAtom(c"#include <string.h>\n") else SNil()) +
+   (if std-c-force-imports.has-key(c"stdlib.h") then SAtom(c"#include <stdlib.h>\n") else SNil()) +
+   (if std-c-force-imports.has-key(c"stdio.h") then SAtom(c"#include <stdio.h>\n") else SNil()) +
+   (if std-c-force-imports.has-key(c"regex.h") then SAtom(c"#include <regex.h>\n") else SNil()) +
+   (if std-c-force-imports.has-key(c"string.h") then SAtom(c"#include <string.h>\n") else SNil()) +
    (SAtom(c"#include <malloc.h>\n")) +
    (SAtom(c"#include <unistd.h>\n"))
 );

PLUGINS/FRONTEND/C/c-ast-to-lm-ast.lsts

@@ -19,7 +19,7 @@ let std-c-declare(t: CTerm): Nil = (
                   ))
                );
             );
-            CIdentifier{name2=value} => (if not(std-c-declare-dedup-index.has(name2)) {
+            CIdentifier{name2=value} => (if not(std-c-declare-dedup-index.has-key(name2)) {
                std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name2, true);
                if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
                   std-c-typedef-name-index = std-c-typedef-name-index.bind(name2, true);
@@ -36,7 +36,7 @@ let std-c-declare(t: CTerm): Nil = (
             });
             CUnaryPrefix{op:"Declarator(", arg=arg} => (
                (let name3, let body) = std-c-sig-of-declarator(return-type, arg, ta, (None : Maybe<CTerm>)());
-               if not(std-c-declare-dedup-index.has(name3.into(type(String)))) {
+               if not(std-c-declare-dedup-index.has-key(name3.into(type(String)))) {
                   std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name3.into(type(String)), true);
                   if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
                      std-c-typedef-name-index = std-c-typedef-name-index.bind(name3.into(type(String)), true);
@@ -48,7 +48,7 @@ let std-c-declare(t: CTerm): Nil = (
             );
             CBinaryOp{op:"Declarator(", arg1=arg1, arg2=arg2 } => (
                (let name4, let body) = std-c-sig-of-declarator(return-type, arg1, ta, Some(arg2));
-               if not(std-c-declare-dedup-index.has(name4.into(type(String)))) {
+               if not(std-c-declare-dedup-index.has-key(name4.into(type(String)))) {
                   std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name4.into(type(String)), true);
                   if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
                      std-c-typedef-name-index = std-c-typedef-name-index.bind(name4.into(type(String)), true);
@@ -61,7 +61,7 @@ let std-c-declare(t: CTerm): Nil = (
             CBinaryOp{op:"Declarator*", ptr=arg1, arg2:CBinaryOp{op:"Declarator(", arg1=arg1, arg2=arg2 } } => (
                return-type = std-c-decorate-pointer(return-type, ptr);
                (let name5, let body) = std-c-sig-of-declarator(return-type, arg1, ta, Some(arg2));
-               if not(std-c-declare-dedup-index.has(name5.into(type(String)))) {
+               if not(std-c-declare-dedup-index.has-key(name5.into(type(String)))) {
                   std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name5.into(type(String)), true);
                   if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
                      std-c-typedef-name-index = std-c-typedef-name-index.bind(name5.into(type(String)), true);
@@ -72,7 +72,7 @@ let std-c-declare(t: CTerm): Nil = (
                }
             );
             CBinaryOp{op:"Declarator*", ptr=arg1, arg2:CIdentifier{name6=value} } => (
-               if not(std-c-declare-dedup-index.has(name6)) {
+               if not(std-c-declare-dedup-index.has-key(name6)) {
                   std-c-declare-dedup-index = std-c-declare-dedup-index.bind(name6, true);
                   if can-unify( t1(c"C",t0(c"typedef")), return-type ) {
                      std-c-typedef-name-index = std-c-typedef-name-index.bind(name6, true);

PLUGINS/FRONTEND/C/c-parse.lsts

@@ -157,7 +157,7 @@ let std-c-has-class(tks: String, cls: String): Bool = (
       "floating" => tk == r/^[0-9]+([.][0-9]+)?([eE][0-9]+)?[fF]?/                                        # decimal constant
                  or tk == r/^[0][x][0-9a-fA-F]+([.][0-9a-fA-F]+)?([eE][0-9a-fA-F]+)?([pP][0-9]+)[fF]?/;   # hexadecimal constant
       "string" => tk == r/^[RLuU8]*["]([^"\\]|([\\].))*["]/;
-      "enumeration" => std-c-enumeration-constant-index.has(tks);
+      "enumeration" => std-c-enumeration-constant-index.has-key(tks);
       _ => tks == cls;
    }
 );
@@ -704,7 +704,7 @@ std-c-typedef-name-index = std-c-typedef-name-index.bind("__builtin_va_list", tr
 
 let std-c-parse-typedef-name(tokens: List<Token>): Tuple<Maybe<CTerm>,List<Token>> = (
    let no = (None : Maybe<CTerm>)();
-   if non-zero(tokens) and std-c-typedef-name-index.has(head(tokens).skey) {
+   if non-zero(tokens) and std-c-typedef-name-index.has-key(head(tokens).skey) {
       Tuple( Some(CType1(head(tokens).skey)), tail(tokens) )
    } else Tuple( no, tokens )
 );

SRC/ascript-datatype-index.lsts

@@ -14,7 +14,7 @@ let .is-datatype(tt: Type): Bool = (
       );
       _ => (
          let gta = tt.ground-tag-and-arity;
-         datatype-index.has(gta)
+         datatype-index.has-key(gta)
       );
    }
 );

SRC/prop-core.lsts

@@ -153,21 +153,17 @@ let weaken-quick-prop(original-base: Type, base: Type, pre: Type): Type = (
                );
             }
          };
-         if tag.contains(c"::") {
-            let tag-parts = tag.split(c"::").into(type(Vector<CString>));
-            let tag-base = tag-parts[0] + c"::";
-            let ti = 1_sz;
-            while ti < tag-parts.length {
-               let tag-part = tag-parts[ti];
-               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 (
-                     base = remove-info(base, rt);
-                  );
-               };
-               tag-base = tag-base + tag-part + c"::";
-               ti = ti + 1;
+         if tag.has-prefix(c"Tag::") or tag.has-prefix(c"Field::") {
+            # TODO: generalize to all :: types, temporary semantic regression
+            let tag-base = if tag.has-prefix(c"Tag::") then c"Tag::"
+                      else if tag.has-prefix(c"Field::") then c"Field::"
+                      else c"";
+            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 (
+                  base = remove-info(base, rt);
+               );
             };
          };
       );
@@ -233,20 +229,15 @@ let unenrich-quick-prop(original-base: Type, base: Type, pre: Type): Type = (
             }
          };
          if tag.contains(c"::") {
-            let tag-parts = tag.split(c"::").into(type(Vector<CString>));
-            let tag-base = tag-parts[0] + c"::";
-            let ti = 1_sz;
-            while ti < tag-parts.length {
-               let tag-part = tag-parts[ti];
-               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 (
-                     base = remove-info(base, rt);
-                  );
-               };
-               tag-base = tag-base + tag-part + c"::";
-               ti = ti + 1;
+            let tag-base = if tag.has-prefix(c"Tag::") then c"Tag::"
+                      else if tag.has-prefix(c"Field::") then c"Field::"
+                      else c"";
+            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 (
+                  base = remove-info(base, rt);
+               );
             };
          };
       );

SRC/prop-is-phi-type.lsts

@@ -2,5 +2,5 @@
 let phi-type-index = {} : Hashtable<(CString,U64),Bool>;
 
 let .is-phi-type(tt: Type): Bool = (
-   phi-type-index.has(tt.ground-tag-and-arity)
+   phi-type-index.has-key(tt.ground-tag-and-arity)
 );

SRC/prop-tctx-apply.lsts

@@ -18,7 +18,7 @@ let .apply(tctx: TypeContext?, fname: CString, ft: Type, at: Type, blame: AST, r
    # Assert that all equal type variables also have equal datatype
    let apply-type-variables = {} : Hashtable<CString,Type>;
    for list tr in apply-tctx.get-or-panic.tctx {
-      if apply-type-variables.has(tr.key-or-zero) {
+      if apply-type-variables.has-key(tr.key-or-zero) {
          let previous-seen-tt = apply-type-variables.lookup(tr.key-or-zero, ta).datatype;
          let current-seen-tt = tr.direct-type.datatype;
          if previous-seen-tt != current-seen-tt {

SRC/tctx-lookup.lsts

@@ -3,12 +3,13 @@ let .lookup(tctx: TypeContext?, key: CString): TypeContextRow = tctx.get-or(mk-t
 let .lookup(trs: List<TypeContextRow>, key: CString): TypeContextRow = (
    let default = NullTypeContextRow;
    let continue = true;
-   for list tr in trs { if continue {
+   while non-zero(trs) and continue {
+      let tr = head(trs); trs = tail(trs);
       if tr.key-or-zero == key {
          default = tr;
          continue = false;
       }
-   }};
+   };
    if not(non-zero(default)) {
       for vector tr in global-tctx.lookup(key, mk-vector(type(TypeContextRow)) ) {
          if tr.key-or-zero == key {
@@ -29,12 +30,13 @@ let .lookups(tctx: TypeContext?, key: CString): Vector<TypeContextRow> = tctx.ge
 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 {
+   while non-zero(trs) and continue {
+      let tr = head(trs); trs = tail(trs);
       if tr.key-or-zero == key {
          default = default.push(tr);
          continue = false;
       }
-   }};
+   };
    if continue {
       for vector tr in global-tctx.lookup(key, mk-vector(type(TypeContextRow)) ) {
          if tr.key-or-zero == key {
@@ -49,11 +51,12 @@ let .lookup-phi(tctx: TypeContext?, key: CString): PhiContextRow = tctx.get-or(m
 let .lookup(trs: List<PhiContextRow>, key: CString): PhiContextRow = (
    let default = NullPhiContextRow;
    let continue = true;
-   for list tr in trs { if continue {
+   while non-zero(trs) and continue {
+      let tr = head(trs); trs = tail(trs);
       if tr.phi-id-or-zero == key {
          default = tr;
          if not(tr.dead-on-arrival-or-zero) then continue = false;
       }
-   }};
+   };
    default
 );

SRC/tctx-phi-append.lsts

@@ -10,7 +10,7 @@ let .phi-append-dead-on-arrival(tctx-primary: TypeContext?, tctx-secondary: Type
 let .phi-append(tctx-primary: List<PhiContextRow>, tctx-secondary: List<PhiContextRow>, dead-on-arrival: Bool): List<PhiContextRow> = (
    let seen = {} : Hashtable<CString,Bool>;
    for list pr1 in tctx-secondary {
-      if not(seen.has(pr1.phi-id-or-zero)) {
+      if not(seen.has-key(pr1.phi-id-or-zero)) {
          let pr2 = tctx-primary.lookup(pr1.phi-id-or-zero);
          if dead-on-arrival then pr1 = PhiContextRow(pr1.phi-id-or-zero, pr1.phi-tt-or-zero, pr1.blame-or-zero, dead-on-arrival, pr1.is-global-or-zero);
          if not(is(pr1,pr2)) and not(dead-on-arrival and non-zero(pr2)) {

SRC/tctx-phi-move-all.lsts

@@ -2,7 +2,7 @@
 let .phi-move-all(tctx: TypeContext?): TypeContext? = (
    let seen = {} : Hashtable<CString,Bool>;
    for list pr in tctx.get-or(mk-tctx()).pctx {
-      if not(seen.has(pr.phi-id-or-zero)) {
+      if not(seen.has-key(pr.phi-id-or-zero)) {
          if pr.phi-tt-or-zero.is-linear-live {
             tctx = tctx.bind-phi(pr.phi-id-or-zero, pr.phi-tt-or-zero.move-linear, pr.blame-or-zero);
          };

SRC/typecheck-accept-interface.lsts

@@ -12,7 +12,7 @@ let .should-accept-interface(tt: Type): Bool = (
          for vector c in conjugate { result = result and c.should-accept-interface };
          result
       );
-      TGround{tag=tag} => interface-index.has(tt.ground-tag-and-arity);
+      TGround{tag=tag} => interface-index.has-key(tt.ground-tag-and-arity);
       _ => false;
    }
 );

SRC/typecheck-index-plugins.lsts

@@ -4,13 +4,13 @@ let plugin-current-backend = &plugin-null-backend;
 let frontend-has-seen = {} : Hashtable<CString,Bool>;
 
 let frontend(fp: CString): Nil = (
-   if not(frontend-has-seen.has(fp)) {
+   if not(frontend-has-seen.has-key(fp)) {
       frontend-has-seen = frontend-has-seen.bind(fp,true);
       if fp.has-prefix(c"core/") then fp = config-platform-prefix + fp;
       if fp.has-prefix(c"std/") then fp = config-platform-prefix + fp;
       let found-file = false;
       if fp.has-suffix(c".h") then found-file = true;
-      if plugins-frontends-index.has(fp.file-extension) then found-file = true;
+      if plugins-frontends-index.has-key(fp.file-extension) then found-file = true;
       if not(found-file) {
          if file-exists(fp) {
             found-file = true

SRC/typecheck-infer-expr.lsts

@@ -285,7 +285,7 @@ let std-infer-expr(tctx: Maybe<TypeContext>, term: AST, is-scoped: Bool, used: I
             tctx = tctx.ascript(term, if used.is-tail then typeof-term(r) else t2(c"Cons", typeof-term(l), typeof-term(r)));
          } else {
             let rt = ta;
-            if index-macro-table.has(var-name-if-var(l)) {
+            if index-macro-table.has-key(var-name-if-var(l)) {
                (tctx, term) = std-apply-macro(tctx, term, used);
                is-macro = true;
             } else {

SRC/typecheck-release-locals.lsts

@@ -50,7 +50,7 @@ let release-locals(tctx-before: TypeContext?, tctx-after: TypeContext?, term: AS
    };
    while non-zero(tctx-after-pctx) and not(is(tctx-before-pctx, tctx-after-pctx)) {
       let tr = head(tctx-after-pctx);
-      if tr.dead-on-arrival-or-zero and not(pid-seen.has(tr.phi-id-or-zero)) and tr.phi-tt-or-zero.is-linear-live {
+      if tr.dead-on-arrival-or-zero and not(pid-seen.has-key(tr.phi-id-or-zero)) and tr.phi-tt-or-zero.is-linear-live {
          pid-seen = pid-seen.bind(tr.phi-id-or-zero,true);
          tctx-after = tctx-after.bind-phi(tr.phi-id-or-zero, tr.phi-tt-or-zero.move-linear, tr.blame-or-zero);
       };

SRC/typecheck-std-apply-macro-candidates.lsts

@@ -54,7 +54,7 @@ let std-try-destructure-macro(tctx: TypeContext?, margs: AST, mtype: Type, mcand
                            } else (tctx, no)
                         );
                         _ => (
-                           if index-macro-meta.has(macro-helper) {
+                           if index-macro-meta.has-key(macro-helper) {
                               (tctx, let helped) = std-apply-macro-weak(tctx, macro-helper, margs, Used());
                               if non-zero(helped)
                               then (tctx, std-direct-destructure-macro(helped, mstruct))

SRC/typecheck-validate-pctx-del.lsts

@@ -2,7 +2,7 @@
 let validate-pctx-release(tctx: TypeContext?): Nil = (
    let ps-seen = {} : Hashtable<CString,Bool>;
    for list pr in tctx.get-or(mk-tctx()).pctx {
-      if not(pr.is-global-or-zero) and not(ps-seen.has(pr.phi-id-or-zero)) {
+      if not(pr.is-global-or-zero) and not(ps-seen.has-key(pr.phi-id-or-zero)) {
          if pr.phi-tt-or-zero.is-linear-live
          then exit-error("Linear Variables Must Be Used: #\{pr.phi-id-or-zero} \{pr.phi-tt-or-zero} \{pr.blame-or-zero}", pr.blame-or-zero);
          ps-seen = ps-seen.bind(pr.phi-id-or-zero,true);

SRC/unit-main-core.lsts

@@ -65,7 +65,7 @@ let main(argc: C_int, argv: CString[]): Nil = (
             config-target = argv[argi];
          );
          fp1 => (
-            if plugins-backends-index.has(fp1) {
+            if plugins-backends-index.has-key(fp1) {
                plugin-current-backend = plugins-backends-index.lookup(fp1,&plugin-null-backend);
             } else { input = cons(fp1, input); };
          );
@@ -138,6 +138,7 @@ let main(argc: C_int, argv: CString[]): Nil = (
    if config-profile-ast then {
       profile-print-ast()
    };
+   #print-allocation-counts()
 );
 
 let doby-say(): Nil = (

lib/core/array.lsts

@@ -39,7 +39,28 @@ let safe-alloc-block-count-monotonic-history = 0_u64;
 
 let safe-alloc-semaphore = false;
 
+#let alloc-type-counter = {} : Hashtable<CString,U64>;
+
+#let print-allocation-counts() = (
+#   print("Allocation Counts\n");
+#   let h-capacity = alloc-type-counter.data.capacity;
+#   let h-i = 0_sz;
+#   while h-i < h-capacity {
+#      let h-row = alloc-type-counter.data[h-i];
+#      if mem-is-non-zero(h-row) {
+#         print("\{h-row.second} : \{h-row.third}\n");
+#      };
+#      h-i = h-i + 1;
+#   };
+#);
+
 let safe-alloc-impl(nb: USize, tt: Type<t>): t[] = (
+   #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);
+   #};
+   # TODO: config flag or remove
+
    # BEFORE CHANGING THIS: talk to alex
 
    let ptr = malloc(nb) as t[];

lib/core/hashtable.lsts

@@ -171,7 +171,7 @@ let .find-row-index-by-key(h: Hashtable<k,v>, key: k): USize = (
 let .lookup(h: Hashtable<k,v>, key: k, default: v): v = h[key].get-or(default);
 
 # new allocations = 0
-let .has(h: Hashtable<k,v>, key: k): Bool = h[key].is-some;
+let .has-key(h: Hashtable<k,v>, key: k): Bool = h[key].is-some;
 
 let .as-vector(table: Hashtable<Sized<k>,v>): Vector<(k,v)> = (
    let v = mk-vector(type((k,v)));

tests/promises/hashtable/bound-has.lsts

@@ -1,12 +1,12 @@
 
 import lib/core/bedrock.lsts;
 
-assert( mk-hashtable(type(U8), type(U8), 0).bind(8,9).has(8) );
+assert( mk-hashtable(type(U8), type(U8), 0).bind(8,9).has-key(8) );
 assert( safe-alloc-block-count == 0 );
 if not(config-v23) then assert( safe-alloc-block-count-monotonic == 1 );
 safe-alloc-block-count-monotonic = 0;
 
-assert( not(mk-hashtable(type(U8), type(U8), 0).bind(8,9).has(9)) );
+assert( not(mk-hashtable(type(U8), type(U8), 0).bind(8,9).has-key(9)) );
 assert( safe-alloc-block-count == 0 );
 if not(config-v23) then assert( safe-alloc-block-count-monotonic == 1 );
 safe-alloc-block-count-monotonic = 0;