deep-hash -> hash

Makefile

@@ -8,7 +8,7 @@ LSTSFLAGS = MALLOC_CHECK_=3
 # recommendation: ulimit -s unlimited
 
 dev: install-production
-	lm --v23 tests/promises/syntax/logical-not.lsts
+	lm --v23 tests/promises/typechecking/nil-never-variables.lsts
 	$(CC) $(CFLAGS) tmp.c
 	./a.out
 

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

@@ -94,7 +94,7 @@ let std-c-compile-expr(ctx: FContext, t: AST, is-stmt: Bool): Fragment = (
          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 <: t1(c"C",t0(c"void")) {
+         if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: t1(c"C",t0(c"void")) {
          } else if lt <: t1(c"C",t0(c":Label")) {
             f = f.set(c"expression", v.get(c"expression") + SAtom(c":"));
          } else {
@@ -112,7 +112,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 <: t1(c"C",t0(c"void")) {
+               if lt.is-t(c"Nil",0) or lt.is-t(c"Never",0) or lt <: t1(c"C",t0(c"void")) {
                   f = f.set(c"expression", SAtom(c"({") + rf.get(c"expression") + SAtom(c";({});})"));
                } else {
                   f = f.set(c"expression", SAtom(c"({")

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

@@ -17,6 +17,7 @@ let std-c-finish-forced-imports(): S = (
 let compile-global-c-main-term = mk-eof();
 
 let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
+   let kt = typeof-term(term);
    std-c-force-import-clib(c"string.h");
    if k==c"" then ()
    else if k==c"div_t" then std-c-force-import-clib(c"stdlib.h")
@@ -39,13 +40,13 @@ 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 typeof-term(term).is-open or typeof-term(term).is-t(c"Blob",0) or typeof-term(term).is-t(c"FFI",0) or typeof-term(term).is-t(c"Prop",0) then ()
+   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 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)) {
-            let clean-tt = typeof-term(term).weaken.without-phi;
+            let clean-tt = kt.weaken.without-phi;
             k = mangle-identifier(k, clean-tt);
          };
          (let pre-decl, let post-decl) = std-c-mangle-declaration(tt, term);
@@ -55,28 +56,34 @@ 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 can-unify(t1(c"C",t0(c"typedef")), tt) or can-unify(t2(c"Array",t1(c"C",t0(c"typedef")),ta), tt) {
+         if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then ()
+         else if can-unify(t1(c"C",t0(c"typedef")), tt) or can-unify(t2(c"Array",t1(c"C",t0(c"typedef")),ta), 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)) {
-            let clean-tt = typeof-term(term).weaken.without-phi;
+            let clean-tt = kt.weaken.without-phi;
             k = mangle-identifier(k, clean-tt);
          };
          let gend = false;
          if tt.is-t(c"C-Fragment",0) {
             match t {
                Lit{key=key} => (
-                  assemble-gdecl-section = assemble-gdecl-section + SAtom(key);
+                  if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then ()
+                  else assemble-gdecl-section = assemble-gdecl-section + SAtom(key);
                   gend = true;
                );
                _ => ();
             }
          };
-         if not(gend) {
+         if not(gend) and (kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(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;
+         } else if not(gend) {
             (let pre-decl, let post-decl) = std-c-mangle-declaration(tt, term);
             let text = SNil();
             text = text + pre-decl;
@@ -86,7 +93,10 @@ 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 can-unify(t1(c"C",t0(c"typedef")), tt) or can-unify(t2(c"Array",t1(c"C",t0(c"typedef")),ta), tt) {
+            if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then {
+               text = SNil;
+               text = SAtom(k) + SAtom(c" = ") + inner-expr.get(c"expression") + SAtom(c";\n");
+            } else if can-unify(t1(c"C",t0(c"typedef")), tt) or can-unify(t2(c"Array",t1(c"C",t0(c"typedef")),ta), tt) {
                assemble-header-typedef-section = assemble-header-typedef-section + text;
             } else {
                assemble-gdecl-section = assemble-gdecl-section + text;
@@ -96,8 +106,8 @@ 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(typeof-term(term).is-t(c"C-FFI_s",0)) {
-            k = mangle-identifier-function(k, typeof-term(term).without-phi);
+         if k!=c"main" and not(kt.is-t(c"C-FFI_s",0)) {
+            k = mangle-identifier-function(k, kt.without-phi);
          };
          ctx = std-c-compile-destructure-args( ctx, lhs, false );
          let loc = term.location;
@@ -154,8 +164,8 @@ let std-c-compile-global(ctx: FContext, k: CString, term: AST): Nil = (
          };
       );
       t => (
-         let tt = typeof-term(term);
-         if not(typeof-term(term).is-t(c"C-FFI",0)) and not(tt.is-t(c"C-Fragment",0)) {
+         let tt = kt;
+         if not(kt.is-t(c"C-FFI",0)) and not(tt.is-t(c"C-Fragment",0)) {
             k = mangle-identifier(k, tt.without-phi);
          };
 
@@ -166,11 +176,17 @@ 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");
-         assemble-gdecl-section = assemble-gdecl-section + text;
+         if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) then ()
+         else assemble-gdecl-section = assemble-gdecl-section + text;
 
          let inner-expr = std-c-compile-expr( ctx, t, false );
-         text = SAtom(k) + SAtom(c" = ") + inner-expr.get(c"expression") + SAtom(c";\n");
-         assemble-global-initializer-section = assemble-global-initializer-section + text;
+         if kt.is-t(c"Nil",0) or kt.is-t(c"Never",0) or kt <: t1(c"C",t0(c"void")) {
+            text = inner-expr.get(c"expression") + SAtom(c";\n");
+            assemble-global-initializer-section = assemble-global-initializer-section + text;
+         } else {
+            text = SAtom(k) + SAtom(c" = ") + inner-expr.get(c"expression") + SAtom(c";\n");
+            assemble-global-initializer-section = assemble-global-initializer-section + text;
+         }
       );
    }
 );

PLUGINS/FRONTEND/LSTS/lsts-parse.lsts

@@ -309,17 +309,21 @@ let lsts-parse-type(tokens: List<Token>): Tuple<Type,List<Token>> = (
 let lsts-parse-type-conjugate(tokens: List<Token>): Tuple<Type,List<Token>> = (
    let tt = if lsts-parse-head(tokens) == c"(" {
       lsts-parse-expect(c"(", tokens); tokens = tail(tokens);
-      let args-rest = lsts-parse-type(tokens);
-      let args = [ args-rest.first ];
-      tokens = args-rest.second;
+      let args = [] : List<Type>;
+      if lsts-parse-head(tokens)!=c")" {
+         (let arg, tokens) = lsts-parse-type(tokens);
+         args = [ arg ];
+      };
       while lsts-parse-head(tokens) == c"," {
          lsts-parse-expect(c",", tokens); tokens = tail(tokens);
          let tnext-rest = lsts-parse-type(tokens);
          args = cons( tnext-rest.first, args );
          tokens = tnext-rest.second;
       };
       lsts-parse-expect(c")", tokens); tokens = tail(tokens);
-      if args.length==1 then head(args) else TGround ( c"Tuple", close(args) );
+      if args.length==0 then t0(c"Nil")
+      else if args.length==1 then head(args)
+      else TGround ( c"Tuple", close(args) );
    } else if lsts-parse-head(tokens)==c"?" {
       lsts-parse-expect(c"?", tokens); tokens = tail(tokens);
       ta

PLUGINS/FRONTEND/LSTS/lsts-smart-tokenize.lsts

@@ -19,7 +19,6 @@ let lsts-tokenize-string(file-path: String, text: String): List<Token> = (
          text = rest;
       );
 
-      "__".. rest => (tokens = cons(text[:"__".length], tokens); text = rest;);
       "**".. rest => (tokens = cons(text[:"**".length], tokens); text = rest;);
       "\\".. rest => (tokens = cons(text[:"\\".length], tokens); text = rest;);
       "~=".. rest => (tokens = cons(text[:"~=".length], tokens); text = rest;);

SRC/ast-hash.lsts

@@ -0,0 +1,17 @@
+
+let hash(t: AST): U64 = (
+   match t {
+      Meta{ val=val } => hash(val) + 123;
+      ASTEOF{} => 456;
+      ASTNil{} => 789;
+      App{ is-cons=is-cons, left=left, right=right } => hash(is-cons) + hash(left) + hash(right);
+      Var{ key1=key, token=token } => hash(key1);
+      Lit{ key2=key, token=token } => hash(key2);
+      Abs{ lhs=lhs, rhs=rhs, tt=tt } => hash(lhs) + hash(rhs) + hash(tt);
+      AType{ tt=tt } => hash(tt);
+      Seq{ seq=seq } => hash(seq);
+      Glb{ key3=key, val=val } => 012 + hash(val);
+      Typedef{ lhs-type=lhs-type, implies=implies, implements=implements, size=size, alias=alias, opaque-alias=opaque-alias } => 
+      hash(lhs-type) + hash(implies) + hash(implements) + hash(size) + hash(alias) + hash(opaque-alias);
+   }
+);

SRC/type-hash.lsts

@@ -0,0 +1,13 @@
+
+let hash(tt: Type): U64 = (
+   match tt {
+      TAny{} => 0_u64;
+      TVar{name=name} => hash(name);
+      TAnd{conjugate=conjugate} => (
+         let result = 0_u64;
+         for vector c in conjugate { result = result + hash(c) };
+         result
+      );
+      TGround{tag=tag,parameters=parameters} => hash(tag) + hash(parameters);
+   }
+);

SRC/unit-ast-core.lsts

@@ -30,4 +30,4 @@ import SRC/ast-acontext-union.lsts;
 import SRC/ast-substitute-uuids.lsts;
 import SRC/ast-acontext-to-string.lsts;
 import SRC/ast-unroll-seq.lsts;
-import SRC/ast-deep-hash.lsts;
+import SRC/ast-hash.lsts;

SRC/unit-type-core.lsts

@@ -22,7 +22,7 @@ import SRC/type-remove-info.lsts;
 import SRC/type-ground-tag-and-arity.lsts;
 import SRC/type-into-string.lsts;
 import SRC/type-is-any-arg-t.lsts;
-import SRC/type-deep-hash.lsts;
+import SRC/type-hash.lsts;
 import SRC/type-cons-root.lsts;
 import SRC/type-sanitize-phi.lsts;
 import SRC/type-without-phi.lsts;

SRC/unit-util.lsts

@@ -1,6 +1,5 @@
 
 import lib/core/bedrock.lsts;
-import lib/core/compiler-only.lsts;
 
 let safe-alloc-block-count = 0;
 

lib/core/bedrock.lsts

@@ -14,6 +14,3 @@ import lib/core/list.lsts;
 import lib/core/s.lsts;
 import lib/core/hashtable.lsts;
 import lib/core/regex.lsts;
-
-# TODO: remove after V3 release
-let deep-hash(x: t): U64 = hash(x);

lib/core/cstring.lsts

@@ -22,31 +22,32 @@ let $">"(l: CString, r: CString): Bool  = cmp(l, r) >  Equal;
 let $">="(l: CString, r: CString): Bool = cmp(l, r) >= Equal;
 
 let fail(msg: CString): Never = (
-   fputs(msg, stderr);
+   write(2, msg as C<"void">[], msg.length);
    exit(1);
    () as Never
 );
 
 let fail(msg1: CString, msg2: CString): Never = (
-   fputs(msg1, stderr);
-   fputs(msg2, stderr);
+   write(2, msg1 as C<"void">[], msg1.length);
+   write(2, msg2 as C<"void">[], msg2.length);
    exit(1);
    () as Never
 );
 
 let print(msg: CString): Nil = (
-   fputs(msg, stdout); ()
+   write(1, msg as C<"void">[], msg.length);
+   ()
 );
 
 let eprint(msg: CString): Nil = (
-   fputs(msg, stderr); ()
+   write(2, msg as C<"void">[], msg.length);
+   ()
 );
 
 let $"[]"(l: CString, idx: USize): U8 = (
    (l as U8[])[idx]
 );
 
-let deep-hash(key: CString): U64 = hash(key);
 let hash(key: CString): U64 = (
    let i = 0_sz;
    let key-length = key.length;

lib/core/list.lsts

@@ -154,9 +154,9 @@ let .lookup(ls: List<Tuple<k,v1,v2,v3>>, key: k, default: Tuple<v1,v2,v3>): Tupl
    default;
 );
 
-let deep-hash(ts: List<t>): U64 = (
+let hash(ts: List<t>): U64 = (
    let return = 0_u64;
-   for list t0 in ts { return = return + deep-hash(t0); };
+   for list t0 in ts { return = return + hash(t0); };
    return;
 );
 

lib/core/vector.lsts

@@ -186,9 +186,9 @@ let .contains(v: Vector<t>, i: t): Bool = (
    result
 );
 
-let deep-hash(ts: Vector<t>): U64 = (
+let hash(ts: Vector<t>): U64 = (
    let return = 0_u64;
-   for vector t0 in ts { return = return + deep-hash(t0); };
+   for vector t0 in ts { return = return + hash(t0); };
    return;
 );
 

tests/promises/lm-prop/enrich-failure-bisect.lsts

@@ -69,14 +69,14 @@ let $"&&"(lt: Type, rt: Type): Type = (
    };
 );
 
-let deep-hash(tt: Type): U64 = (
+let hash(tt: Type): U64 = (
    match tt {
       TAnd{conjugate=conjugate} => (
          let result = 0_u64;
-         for vector c in conjugate { result = result + deep-hash(c) };
+         for vector c in conjugate { result = result + hash(c) };
          result
       );
-      TGround{tag=tag} => deep-hash(tag);
+      TGround{tag=tag} => hash(tag);
    }
 );
 

tests/promises/syntax/nil-type.lsts

@@ -0,0 +1,7 @@
+
+import lib/core/bedrock.lsts;
+
+let f() = ();
+let f(): () = ();
+
+() : ();

tests/promises/typechecking/nil-never-variables.lsts

@@ -0,0 +1,12 @@
+
+import lib/core/bedrock.lsts;
+
+let f() = (
+   let a = ();
+   let b = () as Never;
+);
+
+let a = ();
+let b = () : ();
+let c = () as Never;
+let d = () as Never : Never;