Intern type tag dsfklsdl

Makefile

@@ -8,7 +8,7 @@ LSTSFLAGS = MALLOC_CHECK_=3
 # recommendation: ulimit -s unlimited
 
 dev: install-production
-	lm --print-ast tests/promises/lm-ast/constructor.lsts > out.txt
+	lm tests/promises/lm-type/intern-type-tag.lsts
 	gcc tmp.c
 	./a.out
 

PLUGINS/BACKEND/C/compile-c.lsts

@@ -6,7 +6,7 @@ let plugins-backend-c-compile(): Nil = (
          let fragment = mk-fragment();
          let kt = typeof-term(rhs);
          if not(kt.is-open) {
-            if kt.is-t(c"Blob",0) {
+            if kt.is-t(interned-tag-blob,0) {
                fragment.term = rhs;
                global-ctx = global-ctx.bind(key.key, kt, fragment);
                std-c-fragment-context = std-c-fragment-context.bind(def-to-sym(program-term), fragment);

PLUGINS/BACKEND/C/mangle-identifier.lsts

@@ -37,7 +37,7 @@ let mangle-identifier(kt: Type): S = (
       TAny{} => mangle-identifier(c"?");
       TVar{name=name} => mangle-identifier(name);
       TGround{tag=tag, parameters=parameters} => (
-         let r = mangle-identifier(tag);
+         let r = mangle-identifier(untern(tag));
          if parameters.length > 0 then r = r + mangle-identifier(c"<");
          let c-has-prev = false;
          for c in parameters {

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

@@ -3,11 +3,11 @@
 let std-c-compile-args(callee-ctx: FContext, caller-ctx: FContext, lhs: AST, rhs: AST, f: Fragment): Tuple<Fragment,FContext,FContext> = (
    match lhs {
       App{lhs-rst=left, right:App{ left:Lit{key:c":"}, right:App{left-lhs=left:Var{k1=key}, right:AType{kt=tt}} }} => (
-         if typeof-term(rhs).is-t(c"Cons",2) {
+         if typeof-term(rhs).is-t(interned-tag-cons,2) {
             match rhs {
                App{le=left, re=right} => (
-                  if kt.is-t(c"...",0) {
-                     kt = kt.slot(c"...",0).r1;
+                  if kt.is-t(interned-tag-vararg,0) {
+                     kt = kt.slot(interned-tag-vararg,0).r1;
                      if can-unify(kt, typeof-term(re)) {
                         if kt.is-open { callee-ctx = union(callee-ctx, unify(kt, typeof-term(re), rhs)); };
                         let c1 = std-c-compile-expr(caller-ctx, re, false);
@@ -30,8 +30,8 @@ let std-c-compile-args(callee-ctx: FContext, caller-ctx: FContext, lhs: AST, rhs
                );
             }
          } else {
-            if kt.is-t(c"...",0) {
-               kt = kt.slot(c"...",0).r1;
+            if kt.is-t(interned-tag-vararg,0) {
+               kt = kt.slot(interned-tag-vararg,0).r1;
                if can-unify(kt, typeof-term(rhs)) {
                   if kt.is-open { callee-ctx = union(callee-ctx, unify(kt, typeof-term(rhs), rhs)); };
                   let c1 = std-c-compile-expr(caller-ctx, rhs, false);
@@ -53,11 +53,11 @@ let std-c-compile-args(callee-ctx: FContext, caller-ctx: FContext, lhs: AST, rhs
          (f, callee-ctx, caller-ctx)
       );
       App{ left:Lit{key:c":"}, right:App{left-lhs=left:Var{k2=key}, right:AType{kt=tt}} } => (
-         if typeof-term(rhs).is-t(c"Cons",2) {
+         if typeof-term(rhs).is-t(interned-tag-cons,2) {
             match rhs {
                App{le=left, re=right} => (
-                  if kt.is-t(c"...",0) {
-                     kt = kt.slot(c"...",0).r1;
+                  if kt.is-t(interned-tag-vararg,0) {
+                     kt = kt.slot(interned-tag-vararg,0).r1;
                      if kt.is-open { callee-ctx = union(callee-ctx, unify(kt, typeof-term(re), rhs)); };
                      let c1 = std-c-compile-expr(caller-ctx, re, false);
                      caller-ctx = open(c1.context);
@@ -70,8 +70,8 @@ let std-c-compile-args(callee-ctx: FContext, caller-ctx: FContext, lhs: AST, rhs
                );
             }
          } else {
-            if kt.is-t(c"...",0) {
-               kt = kt.slot(c"...",0).r1;
+            if kt.is-t(interned-tag-vararg,0) {
+               kt = kt.slot(interned-tag-vararg,0).r1;
                if can-unify(kt, typeof-term(rhs)) {
                   if kt.is-open { callee-ctx = union(callee-ctx, unify(kt, typeof-term(rhs), rhs)); };
                   let c1 = std-c-compile-expr(caller-ctx, rhs, false);

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

@@ -4,7 +4,7 @@ let std-c-compile-call(ctx: FContext, fname: CString, args: AST): Fragment = std
 let std-c-compile-call(ctx: FContext, fname: CString, return-hint-if-constructor: Type, args: AST): Fragment = (
    let fterm = Some(mk-tctx()).maybe-find-callable(fname, typeof-term(args), args, 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-t(interned-tag-blob,0) {
       if typeof-term(fterm).is-open and fname!=c"open" and fname!=c"mov" then {
          for tr in Some(mk-tctx()).lookups(fname) {
             print("STD C compile call candidate \{fname} : \{tr.dt-or-zero}\n");
@@ -20,7 +20,7 @@ let std-c-compile-call(ctx: FContext, fname: CString, return-hint-if-constructor
          );
          _ => fail("Unexpected fterm in std-c-compile-call: \{fname}\n\{fterm}\n");
       }; r
-   } else if typeof-term(fterm).is-t(c"Prop",0) { std-c-compile-expr(ctx, args, false)
+   } else if typeof-term(fterm).is-t(interned-tag-prop,0) { std-c-compile-expr(ctx, args, false)
    } else {
       if typeof-term(fterm).is-open then {
          for tr in Some(mk-tctx()).lookups(fname) {
@@ -29,7 +29,7 @@ let std-c-compile-call(ctx: FContext, fname: CString, return-hint-if-constructor
          exit-error("STD C compile call is open \{fname} (\{typeof-term(args)})\n\{typeof-term(fterm)}\nArgs \{args}\n", args);
       };
       let push-args = std-c-compile-push-args(ctx, args);
-      let function-id = if typeof-term(fterm).is-t(c"FFI",0) or typeof-term(fterm).is-t(c"C-FFI",0)
+      let function-id = if typeof-term(fterm).is-t(interned-tag-ffi,0) or typeof-term(fterm).is-t(interned-tag-cffi,0)
                         then fname else mangle-identifier-function(fname, typeof-term(fterm));
       let ictx = mk-fragment().set(c"function-id", SAtom(function-id));
       let inner-ctx = mk-fctx().bind(c"ictx", t0(c"ImplicitContext"), ictx)

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

@@ -70,7 +70,7 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
       Var{ key=key } => (
          if typeof-term(t) <: type-c-void {
             mk-fragment().set(c"expression",SAtom(c"({})"));
-         } else if typeof-term(t).is-t(c"C-FFI",0) {
+         } else if typeof-term(t).is-t(interned-tag-cffi,0) {
             mk-fragment().set(c"expression",SAtom(key.replace(c"-",c"_").rewrite-if-reserved));
          } else {
             let def = var-to-def(t);
@@ -81,20 +81,20 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
          }
       );
       AType{ tt=tt } => (
-         if tt.is-t(c"Type",1) {
+         if tt.is-t(interned-tag-type,1) {
             mk-fragment().set(c"expression",SAtom(c"0"));
          } else {
             mk-fragment().set(c"expression",std-c-mangle-type(tt, t));
          }
       );
       App{ left:Abs{lhs=lhs:Var{name=key}, rhs:ASTNil{}}, rhs=right } => (
          let lt = typeof-term(lhs).without-modifiers;
-         let vid = if lt.is-t(c"Nil",0) or lt <: type-c-void then SAtom(c"({})") else if std-c-is-ctype(lt) then SAtom(name.replace(c"-",c"_").rewrite-if-reserved) else SAtom(uuid());
+         let vid = if lt.is-t(interned-tag-nil,0) or lt <: type-c-void then SAtom(c"({})") else if std-c-is-ctype(lt) then SAtom(name.replace(c"-",c"_").rewrite-if-reserved) else SAtom(uuid());
          let v = mk-fragment().set(c"expression",vid);
          let f = mk-fragment();
          std-c-fragment-context = std-c-fragment-context.bind( lhs, v );
          ctx = ctx.bind( name, lt, v );
-         if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: type-c-void {
+         if lt.is-t(interned-tag-nil,0) or lt.is-t(interned-tag-never,0) or lt <: type-c-void {
          } else if lt <: type-c-label {
             f = f.set(c"expression", v.get(c"expression") + SAtom(c":"));
          } else {
@@ -110,7 +110,7 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
             _ => (
                let rf = std-c-compile-expr(ctx, rhs, false);
                f = f.set(c"frame", f.get(c"frame") + rf.get(c"frame"));
-               if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: type-c-void {
+               if lt.is-t(interned-tag-nil,0) or lt.is-t(interned-tag-never,0) or lt <: type-c-void {
                   f = f.set(c"expression", SAtom(c"({") + rf.get(c"expression") + SAtom(c";({});})"));
                } else {
                   f = f.set(c"expression", SAtom(c"({")
@@ -129,13 +129,13 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
          );
       );
       App{ left:App{left:App{left:Var{key:c"if"}, cond=right}, tr=right}, fa=right } => (
-         let ec = if typeof-term(cond).is-t(c"Bool",0)
+         let ec = if typeof-term(cond).is-t(interned-tag-bool,0)
          then std-c-compile-expr(ctx, cond, false )
          else std-c-compile-call(ctx, c"into-branch-conditional", cond);
          let et = std-c-compile-expr( open(ec.context), tr, false );
-         if typeof-term(tr).is-t(c"Never",0) then et = never-as-expr(et, typeof-term(t), t);
+         if typeof-term(tr).is-t(interned-tag-never,0) then et = never-as-expr(et, typeof-term(t), t);
          let ef = std-c-compile-expr( open(ec.context), fa, false );
-         if typeof-term(fa).is-t(c"Never",0) then ef = never-as-expr(ef, typeof-term(t), t);
+         if typeof-term(fa).is-t(interned-tag-never,0) then ef = never-as-expr(ef, typeof-term(t), t);
 
          let ictx = mk-fragment();
          ctx = ctx.bind(c"c", t0(c"Bool"), ec);
@@ -148,10 +148,10 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
       );
       App{ o-t=left:Var{key:c"open"}, inner-term=right } => (
          let tt = typeof-term(inner-term);
-         if tt.is-t(c"Array",2) { match tt.slot(c"Array",2) {
-            TGround{ tag:c"Array", parameters:[_..TAny{}..] } => std-c-compile-expr(ctx, inner-term, false);
-            TGround{ tag:c"Array", parameters:[TAny{}..inner-tt..] } => std-c-compile-call(ctx, c"open", inner-term);
-            TGround{ tag:c"Array", parameters:[array-length..inner-tt..] } => std-c-compile-expr(ctx, inner-term, false);
+         if tt.is-t(interned-tag-array,2) { match tt.slot(interned-tag-array,2) {
+            TGround{ tag:interned-tag-array, parameters:[_..TAny{}..] } => std-c-compile-expr(ctx, inner-term, false);
+            TGround{ tag:interned-tag-array, parameters:[TAny{}..inner-tt..] } => std-c-compile-call(ctx, c"open", inner-term);
+            TGround{ tag:interned-tag-array, parameters:[array-length..inner-tt..] } => std-c-compile-expr(ctx, inner-term, false);
          }} else std-c-compile-call(ctx, c"open", inner-term)
       );
       App{ o-t=left:Var{key:c"sizeof"}, right:AType{tt=tt} } => (
@@ -160,30 +160,17 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
       );
       Lit{val=key} => (
          let tt = typeof-term(t);
-         if tt.is-t(c"C",1) and tt.r1.is-t(c"uint8_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c"uint06_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c"uint22_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c"uint64_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c"int8_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c"int06_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c"int22_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c"int64_t",0) then mk-expression(val)
-         else if tt.is-t(c"C",1) and tt.r1.is-t(c":Label",0) then mk-expression(val)
-         else if tt.is-t(c"L",0) then mk-expression(val)
-         else if tt.is-t(c"CString",0) then mk-expression(val.escape-as-cstring)
-         else if tt.slot(c"Array",2).l1.slot(c"C",1).l1.is-t(c"char",0) then mk-expression(val.escape-as-cstring)
-         else if tt.is-t(c"Regex",0) {
+         if tt.is-t(interned-tag-l,0) then mk-expression(val)
+         else if tt.is-t(interned-tag-cstring,0) then mk-expression(val.escape-as-cstring)
+         else if tt.slot(interned-tag-array,2).l1.slot(interned-tag-c,1).l1.is-t(interned-tag-char,0) then mk-expression(val.escape-as-cstring)
+         else if tt.is-t(interned-tag-regex,0) {
             let rgx-id = uuid();
             assemble-header-section = assemble-header-section +
             SAtom(c"regex_t ") + SAtom(rgx-id) + SAtom(c";\n");            
             assemble-global-initializer-section = assemble-global-initializer-section +
             SAtom(c"{int return_code = regcomp(&") + SAtom(rgx-id) + SAtom(c", ") +
             val.escape-as-cstring + SAtom(c", REG_EXTENDED); if(return_code){ fprintf(stderr,\"Could not compile regex.\"); exit(1);}};\n");
             mk-expression(rgx-id);
-         } else if tt.is-datatype and tt.is-t(c"List",1) and val==c"LEOF" {
-            std-c-compile-call(ctx, val, typeof-term(t), mk-nil());
-         } else if tt.is-datatype and tt.is-t(c"HashtableEq",2) and val==c"HashtableEqEOF" {
-            std-c-compile-call(ctx, val, typeof-term(t), mk-nil());
          } else { match val {
             c"True" => mk-expression(c"(1)");
             c"False" => mk-expression(c"(0)");
@@ -236,9 +223,9 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
                       App{ lt=left, rt=right } => (
                          let lt-tt = typeof-term(lt);
                          let rt-tt = typeof-term(rt);
-                         if lt-tt.is-t(c"Type",1) and rt-tt <: t1(c"Type",t0(c"CString")).rewrite-type-alias
+                         if lt-tt.is-t(interned-tag-type,1) and rt-tt <: t1(c"Type",t0(c"CString")).rewrite-type-alias
                          then (
-                            let lt-val = lt-tt.slot(c"Type",1).l1.into(type(String)).into(type(CString));
+                            let lt-val = lt-tt.slot(interned-tag-type,1).l1.into(type(String)).into(type(CString));
                             mk-expression(lt-val.escape-as-cstring)
                          ) else std-c-compile-call(ctx, fname2, right);
                       );

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

@@ -40,12 +40,12 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
    else if k==c"bsearch" then std-c-force-import-clib(c"stdlib.h")
    else if k==c"qsort" then std-c-force-import-clib(c"stdlib.h")
    else if k==c"__compar_fn_t" then std-c-force-import-clib(c"stdlib.h")
-   else if kt.is-open or kt.is-t(c"Blob",0) or kt.is-t(c"FFI",0) or kt.is-t(c"Prop",0) then ()
+   else if kt.is-open or kt.is-t(interned-tag-blob,0) or kt.is-t(interned-tag-ffi,0) or kt.is-t(interned-tag-prop,0) then ()
    else if k==c"main" and not(non-zero(compile-global-c-main-term)) then {
       compile-global-c-main-term = term;
    } else match term {
       App{left:Lit{key:c":"}, right:App{left:ASTNil{}, right:AType{tt=tt}}} => (
-         if not(tt.is-t(c"C-FFI",0)) and not(tt.is-t(c"C-Fragment",0)) {
+         if not(tt.is-t(interned-tag-cffi,0)) and not(tt.is-t(interned-tag-cfragment,0)) {
             let clean-tt = kt.weaken.without-phi;
             k = mangle-identifier(k, clean-tt);
          };
@@ -56,30 +56,30 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
          text = text + SAtom(k);
          text = text + post-decl;
          text = text + SAtom(c";\n");
-         if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then ()
+         if kt.is-t(interned-tag-nil,0) or kt.is-t(interned-tag-never,0) or kt <: type-c-void then ()
          else if can-unify(type-c-typedef, tt) or can-unify(type-array-c-typedef, tt) {
             assemble-header-typedef-section = assemble-header-typedef-section + text;
          } else {
             assemble-gdecl-section = assemble-gdecl-section + text;
          }
       );
       App{left:Lit{key:c":"}, right:App{t=left, right:AType{tt=tt}}} => (
-         if not(tt.is-t(c"C-FFI",0)) and not(tt.is-t(c"C-Fragment",0)) {
+         if not(tt.is-t(interned-tag-cffi,0)) and not(tt.is-t(interned-tag-cfragment,0)) {
             let clean-tt = kt.weaken.without-phi;
             k = mangle-identifier(k, clean-tt);
          };
          let gend = false;
-         if tt.is-t(c"C-Fragment",0) {
+         if tt.is-t(interned-tag-cfragment,0) {
             match t {
                Lit{key=key} => (
-                  if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then ()
+                  if kt.is-t(interned-tag-nil,0) or kt.is-t(interned-tag-never,0) or kt <: type-c-void then ()
                   else assemble-gdecl-section = assemble-gdecl-section + SAtom(key);
                   gend = true;
                );
                _ => ();
             }
          };
-         if not(gend) and (kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void) {
+         if not(gend) and (kt.is-t(interned-tag-nil,0) or kt.is-t(interned-tag-never,0) or kt <: type-c-void) {
             let inner-expr = std-c-compile-expr( ctx, t, false );
             let text = inner-expr.get(c"expression") + SAtom(c";\n");
             assemble-global-initializer-section = assemble-global-initializer-section + text;
@@ -93,7 +93,7 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
             text = text + SAtom(c";\n");
 
             let inner-expr = std-c-compile-expr( ctx, t, false );
-            if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then {
+            if kt.is-t(interned-tag-nil,0) or kt.is-t(interned-tag-never,0) or kt <: type-c-void then {
                text = SNil;
                text = SAtom(k) + SAtom(c" = ") + inner-expr.get(c"expression") + SAtom(c";\n");
             } else if can-unify(type-c-typedef, tt) or can-unify(type-array-c-typedef, tt) {
@@ -106,13 +106,13 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
          }
       );
       Abs{lhs=lhs,rhs=rhs,tt=tt} => (
-         if k!=c"main" and not(kt.is-t(c"C-FFI_s",0)) {
+         if k!=c"main" and not(kt.is-t(interned-tag-cffi,0)) {
             k = mangle-identifier-function(k, kt.without-phi);
          };
          ctx = std-c-compile-destructure-args( ctx, lhs, false );
          let loc = term.location;
          let initialized = match rhs {
-            App{ left:Lit{key:c":"}, right:App{ left:ASTNil{}, right:AType{asc-tt=tt} } } => asc-tt.is-t(c"Nil",0);
+            App{ left:Lit{key:c":"}, right:App{ left:ASTNil{}, right:AType{asc-tt=tt} } } => asc-tt.is-t(interned-tag-nil,0);
             _ => true;
          };
          if initialized or can-unify(type-c-typedef, tt) {
@@ -166,7 +166,7 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
       );
       t => (
          let tt = kt;
-         if not(kt.is-t(c"C-FFI",0)) and not(tt.is-t(c"C-Fragment",0)) {
+         if not(kt.is-t(interned-tag-cffi,0)) and not(tt.is-t(interned-tag-cfragment,0)) {
             k = mangle-identifier(k, tt.without-phi);
          };
 
@@ -177,11 +177,11 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
          text = text + SAtom(k);
          text = text + post-decl;
          text = text + SAtom(c";\n");
-         if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void then ()
+         if kt.is-t(interned-tag-nil,0) or kt.is-t(interned-tag-never,0) or kt <: type-c-void then ()
          else assemble-gdecl-section = assemble-gdecl-section + text;
 
          let inner-expr = std-c-compile-expr( ctx, t, false );
-         if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: type-c-void {
+         if kt.is-t(interned-tag-nil,0) or kt.is-t(interned-tag-never,0) or kt <: type-c-void {
             text = inner-expr.get(c"expression") + SAtom(c";\n");
             assemble-global-initializer-section = assemble-global-initializer-section + text;
          } else {