Merge pull request #1962 from andrew-johnson-4/more-lmcommon-fdslwelwl

More lmcommon fdslwelwl

Author: andrew4328

BOOTSTRAP/cli.c

@@ -0,0 +1,5 @@
+
+let lone-index = {} : Hashtable<CString,Bool>;
+
+let index-lone-tag(tag: CString): Nil = lone-index = lone-index.bind(tag,true);
+let is-lone-tag(tag: CString): Bool = lone-index.lookup(tag,false);

LM23COMMON/prop-is-lone-tag.lsts

@@ -0,0 +1,2 @@
+
+let .with-only-phi(tt: Type): Type = tt.slot(c"Phi::State",1).l1;

SRC/is-suffixed.lsts LM23COMMON/prop-is-suffixed.lstsSRC/is-suffixed.lsts renamed to LM23COMMON/prop-is-suffixed.lsts

@@ -0,0 +1,24 @@
+
+let substitute-lhs(tctx: TypeContext?, t: AST): AST = substitute-lhs(tctx, t, 0);
+
+let substitute-lhs(tctx: TypeContext?, t: AST, idx: U64): AST = (
+   match t {
+      App{ ps=left, right:App{ left:Lit{key:c":",ctk=token}, right:App{ left:Var{v1=key,vtk1=token}, right:AType{vt1=tt} } } } => (
+         vt1 = substitute-macro(tctx, vt1.accept-interface(idx)).expand-implied-phi.without-phi-keep-state;
+         mk-app( substitute-lhs(tctx,ps,idx+1),
+            mk-app( mk-lit(c":",ctk.unique), mk-app(
+               mk-var(v1,vtk1.unique), mk-atype(vt1)
+            ))
+         )
+      );
+      App{ left:Lit{key:c":",ctk=token}, right:App{ left:Var{v2=key,vtk2=token}, right:AType{vt2=tt} } } => (
+         vt2 = substitute-macro(tctx, vt2.accept-interface(idx)).expand-implied-phi.without-phi-keep-state;
+         mk-app( mk-lit(c":",ctk.unique), mk-app(
+            mk-var(v2,vtk2.unique), mk-atype(tctx.substitute(vt2.accept-interface(idx)))
+         ))
+      );
+      App{ ps=left, right:Var{v3=key,vtk3=token} } => mk-app(substitute-lhs(tctx,ps),mk-var(v3,vtk3.unique));
+      Var{v4=key,vtk4=token} => mk-var(v4,vtk4.unique);
+      ASTNil{} => t;
+   }
+);

LM23COMMON/type-with-only-phi.lsts

@@ -0,0 +1,47 @@
+
+let substitute(tctx: TypeContext?, t: AST): AST = substitute(tctx,t,false);
+
+let substitute(tctx: TypeContext?, t: AST, is-return: Bool): AST = (
+   match t {
+      ASTEOF{} => t;
+      ASTNil{} => t;
+      App{ left:Lit{key:c":",ctk=token}, right:App{ left:Var{v1=key,vtk1=token}, right:AType{vt1=tt} } } => (
+         vt1 = substitute-macro(tctx, vt1).expand-implied-phi.without-phi-keep-state;
+         t = mk-app( mk-lit(c":",ctk.unique), mk-app(mk-var(v1,vtk1.unique), mk-atype(vt1)) );
+         let found = false;
+         for TypeContextRow{tk1=key,ta=def} in tctx.get-or(mk-tctx()).tctx {
+            if not(found) and tk1==v1 {
+               t = mk-app( mk-lit(c":",ctk.unique), mk-app(substitute(tctx,ta), mk-atype(vt1)) );
+               found = true;
+            }
+         }; t
+      );
+      App{ left:Lit{key:c":",ctk=token}, right:App{ inner-t=left, right:AType{vt2=tt} } } => (
+         vt2 = substitute-macro(tctx, vt2).expand-implied-phi.without-phi-keep-state;
+         mk-app( mk-lit(c":",ctk.unique), mk-app(substitute(tctx, inner-t), mk-atype(vt2)) );
+      );
+      Lit{v2=key,vtk2=token} => mk-lit(v2,vtk2.unique);
+      Var{v3=key,vtk3=token} => mk-var(v3,vtk3.unique);
+      Abs{lhs=lhs,rhs=rhs,tt1=tt} => mk-abs(substitute-lhs(tctx,lhs),substitute(tctx,rhs,true),tctx.substitute(tt1));
+      AType{tt2=tt} => mk-atype(tctx.substitute(tt2).sanitize-phi);
+      App{is-cons=is-cons,lt=left,rt=right} => mk-cons-or-app(is-cons,substitute(tctx,lt),substitute(tctx,rt));
+      Seq{seq=seq} => (
+         t = mk-eof();
+         for s in seq { t = t + substitute(tctx,s); };
+         t
+      );
+      Glb{k=key, rt=val} => (
+         let found = false;
+         for TypeContextRow{tk2=key,ta=def} in tctx.get-or(mk-tctx()).tctx {
+            if not(found) and k.key==tk2 {
+               match ta {
+                  Var{tvtk=token} => k = tvtk;
+                  _ => ();
+               };
+               found = true;
+            }
+         };
+         mk-glb(k.unique,substitute(tctx,rt))
+      );
+   }
+);

LM23COMMON/typecheck-tctx-substitute-lhs.lsts

@@ -0,0 +1,71 @@
+
+let try-destructure-macro(loc: SourceLocation, lhs: AST, term: AST): AContext? = (
+   let r = None : AContext?;
+   let yes = Some([] : AContext);
+   match (lhs, term) {
+      Tuple{first:ASTNil{}, second:ASTNil{}} => r = yes;
+      Tuple{
+         first:App{left:App{left:Var{}, right:Var{}}, right:Var{}},
+         second:App{left:App{left:Lit{}}}
+      } => ();
+      Tuple{
+         first:App{left:Lit{key:c":Literal:"},right:Var{pv=key}},
+         second:App{left:Lit{key:c":",ctk=token}, right:App{left:Lit{},right:AType{}}}
+      } => r = r.bind(pv,term.with-location(ctk.location));
+      Tuple{
+         first:App{left:Var{},right:Var{}},
+         second:App{left:Lit{tag=key}}
+      } => (
+         if is-lone-tag(tag) or tag.is-suffixed {
+            match (lhs,term) {
+               Tuple{first:App{pl=left,pr=right}, second:App{el=left,er=right}} => (
+                  let ll = try-destructure-macro(loc,pl,el);
+                  if non-zero(ll) {
+                     let rl = try-destructure-macro(loc,pr,er);
+                     if non-zero(rl) then r = union(ll,rl);
+                  }
+               );
+            }
+         }
+      );
+      Tuple{ first:App{pl1=left,pr1=right}, second:App{el1=left,er1=right} } => (
+         let ll1 = try-destructure-macro(loc,pl1,el1);
+         if non-zero(ll1) {
+            let rl1 = try-destructure-macro(loc,pr1,er1);
+            if non-zero(rl1) then r = union(ll1,rl1);
+         }
+      );
+      Tuple{ first:Abs{pl2=lhs,pr2=rhs,ptlt2=tt}, second:Abs{el2=lhs,er2=rhs,etlt2=tt} } => (
+         let ll2 = try-destructure-macro(loc,pl2,el2);
+         if non-zero(ll2) {
+            let rl2 = try-destructure-macro(loc,pr2,er2);
+            if non-zero(rl2) then r = union(ll2,rl2);
+         }
+      );
+      Tuple{ first:Lit{key:c":Any:"}, second:Var{key:c"_"} } => r = yes;
+      Tuple{ first:Lit{pl3=key}, second:Var{el3=key} } => if pl3==el3 then r = yes;
+      Tuple{ first:Lit{pl4=key}, second:Lit{el4=key} } => if pl4==el4 then r = yes;
+      Tuple{ first:App{left:Lit{key:c":Literal:"}, right:Var{pv5=key}}, second:Lit{el5=key,eltk5=token} } => (
+         if index-of-tag(el5)==unknown-index-of-tag then r = r.bind(pv5,term.with-location(eltk5.location));
+      );
+      Tuple{ first:App{left:Lit{key:c":Field:"}, right:Var{pv6=key}}, second:Lit{el6=key,eltk6=token} } => (
+         if el6.has-prefix(c".") then r = r.bind(pv6,term.with-location(eltk6.location));
+      );
+      Tuple{ first:App{left:Lit{key:c":Variable:"}, right:Var{pv7=key}}, second:Var{key:c"_"} } => (
+      );
+      Tuple{ first:App{left:Lit{key:c":Variable:"}, right:Var{pv8=key}}, second:Var{el8=key,eltk8=token} } => (
+         r = r.bind(pv8,term.with-location(eltk8.location));
+      );
+      Tuple{ first:App{ left:App{ left:Lit{key:c":Tag:"}, right:Var{pv9=key} }, right:Var{pt9=key} }, second:Lit{el9=key,eltk9=token} } => (
+         if index-of-tag(el9)!=unknown-index-of-tag {
+            r = yes;
+            let tag-i = index-of-tag(el9).into(type(CString));
+            r = r.bind(pv9, mk-app( mk-lit(c":",with-key(eltk9,c":")), mk-app( mk-lit(tag-i,with-key(eltk9,tag-i)), mk-atype(t0(c"Constant") && t0(c"Literal") && t0(c"U64")) ) ));
+            let tag-tt = c"Tag::" + el9;
+            r = r.bind(pt9, mk-lit(tag-tt,with-key(eltk9,tag-tt)));
+         }
+      );
+      Tuple{ first:Var{pv10=key}, t10=second } => r = r.bind(pv10,term.with-location(t10.location));
+      _ => ();
+   }; r
+);

LM23COMMON/typecheck-tctx-substitute.lsts

@@ -22,3 +22,5 @@ import LM23COMMON/prop-tctx-substitute.lsts;
 import LM23COMMON/prop-typeof-var-raw.lsts;
 import LM23COMMON/prop-typeof-tag.lsts;
 import LM23COMMON/prop-type-datatype.lsts;
+import LM23COMMON/prop-is-lone-tag.lsts;
+import LM23COMMON/prop-is-suffixed.lsts;

LM23COMMON/typecheck-try-destructure-macro.lsts

@@ -38,3 +38,4 @@ import LM23COMMON/type-as-return-hint.lsts;
 import LM23COMMON/type-resurrect.lsts;
 import LM23COMMON/type-cons-tail-or-self.lsts;
 import LM23COMMON/type-without-modifiers.lsts;
+import LM23COMMON/type-with-only-phi.lsts;

LM23COMMON/unit-prop-core.lsts

@@ -23,3 +23,6 @@ import LM23COMMON/typecheck-std-maybe-release-after-call.lsts;
 import LM23COMMON/typecheck-index-of-tag.lsts;
 import LM23COMMON/typecheck-extract-uuids.lsts;
 import LM23COMMON/typecheck-std-direct-destructure-macro.lsts;
+import LM23COMMON/typecheck-tctx-substitute-lhs.lsts;
+import LM23COMMON/typecheck-tctx-substitute.lsts;
+import LM23COMMON/typecheck-try-destructure-macro.lsts;