Merge pull request #1129 from andrew-johnson-4/port-more-lm-to-lsts-a…

…flek

Port more lm to lsts aflek

Cargo.toml

@@ -1,6 +1,6 @@
 [package]
 name = "lambda_mountain"
-version = "1.20.30"
+version = "1.20.31"
 authors = ["Andrew <[email protected]>"]
 license = "MIT"
 description = "Typed Macro Assembler (backed by Coq proofs-of-correctness)"

PLUGINS/BACKEND/BLOB/compile-blob.lm

@@ -14,7 +14,7 @@ plugins-backend-blob-compile := λ. (: (
                (set fragment (.set( fragment 'fragment-type_s (SAtom 'Function_s) )))
                (set.term( fragment rhs ))
                (set.type( fragment (typeof rhs) ))
-               (set global-ctx (fragment-context::bind(
+               (set global-ctx (.bind(
                   global-ctx k (typeof rhs) fragment
                )))
             ))

PLUGINS/BACKEND/C/blob-render.lm

@@ -35,7 +35,7 @@ blob-render-simple := λ(: ctx FContext)(: context-key String)(: term AST)(: off
       )) (
          (let vs (fragment-context::lookup-soft( ctx vsk TAny ASTEOF )))
          (for-each (vi in (.vararg vs)) (
-            (let inner-ctx (fragment-context::bind( ctx lhs (.type vs) vi )))
+            (let inner-ctx (.bind( ctx lhs (.type vs) vi )))
             (let fs (blob-render-simple( inner-ctx context-key iter offset )))
             (let s (.1 fs))
             (set r (+( r s )))
@@ -54,7 +54,7 @@ blob-render-simple := λ(: ctx FContext)(: context-key String)(: term AST)(: off
             ()
             ( (SCons( a rst )) (
                (let f (mk-expression a))
-               (let inner-ctx (fragment-context::bind( ctx lhs (t1 'L_s) f )))
+               (let inner-ctx (.bind( ctx lhs (t1 'L_s) f )))
                (let cs (blob-render-simple( inner-ctx context-key iter offset )))
                (let s (.1 cs))
                (set r (+( r s )))
@@ -160,7 +160,7 @@ blob-render-simple := λ(: ctx FContext)(: context-key String)(: term AST)(: off
          (let s (.1 cs))
          (set f (.set( f context-key s )))
          (set f (.set( f 'expression_s s )))
-         (set ctx (fragment-context::bind(
+         (set ctx (.bind(
             ctx lhs (typeof rhs) f
          ))) # TODO, render the binding as non-simple blob?
       ))

PLUGINS/BACKEND/C/compile-c.lm

@@ -12,7 +12,7 @@ plugins-backend-c-compile := λ . (: (
             (if (.is-t( kt 'Blob_s )) (
                (set.term( fragment rhs ))
                (set.type( fragment kt ))
-               (set global-ctx (fragment-context::bind(
+               (set global-ctx (.bind(
                   global-ctx k kt fragment
                )))
             ) (
@@ -22,13 +22,13 @@ plugins-backend-c-compile := λ . (: (
                (set fragment (.set( fragment 'expression_s (SAtom mid) )))
                (if (.is-arrow kt) (
                   (set.type( fragment kt ))
-                  (set global-ctx (fragment-context::bind(
+                  (set global-ctx (.bind(
                      global-ctx k kt fragment
                   )))
                ) (
                   (let repr-tt (&&( clean-tt (t1 'GlobalVariable_s) )))
                   (set.type( fragment (without-constructor repr-tt) ))
-                  (set global-ctx (fragment-context::bind(
+                  (set global-ctx (.bind(
                      global-ctx k (without-constructor repr-tt) fragment
                   )))
                ))

PLUGINS/BACKEND/C/compile-destructure-args.lm

@@ -11,7 +11,7 @@ compile-destructure-args := λ(: tt Type)(: ctx FContext)(: lhs AST)(: offset I6
             ) (
                (set kt (maybe-local-variable(denormalize kt)))
             ))
-            (set ctx (fragment-context::bind(
+            (set ctx (.bind(
                ctx k kt (fragment::local-variable( 0_i64 kt ))
             )))
          ) ())
@@ -22,7 +22,7 @@ compile-destructure-args := λ(: tt Type)(: ctx FContext)(: lhs AST)(: offset I6
          ) (
             (set kt (maybe-local-variable(denormalize kt)))
          ))
-         (set ctx (fragment-context::bind(
+         (set ctx (.bind(
             ctx k kt (fragment::local-variable( 0_i64 kt ))
          )))
       ))

PLUGINS/BACKEND/C/compile-expr-direct.lm

@@ -193,10 +193,10 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
          (let ictx (mk-fragment()))
          (set.type( ictx (t1( 'ImplicitContext_s )) ))
 
-         (set ctx (fragment-context::bind( ctx 'ictx_s (t1 'ImplicitContext_s) ictx )))
-         (set ctx (fragment-context::bind( ctx 'c_s (t1 'BranchConditional_s) ec )))
-         (set ctx (fragment-context::bind( ctx 't_s (typeof t) et )))
-         (set ctx (fragment-context::bind( ctx 'f_s (typeof f) ef )))
+         (set ctx (.bind( ctx 'ictx_s (t1 'ImplicitContext_s) ictx )))
+         (set ctx (.bind( ctx 'c_s (t1 'BranchConditional_s) ec )))
+         (set ctx (.bind( ctx 't_s (typeof t) et )))
+         (set ctx (.bind( ctx 'f_s (typeof f) ef )))
          (let a-tt (t3( 'Cons_s 
             (t3( 'Cons_s 
                (t3( 'Cons_s (t1 'ImplicitContext_s) (typeof f) ))
@@ -213,7 +213,7 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
       ( (App( (Abs( (@( lhs-t (Var( lhs _ )) )) ASTNil tlt )) rhs )) (
          (let rtype (typeof lhs-t))
          (let fr (fragment::local-variable( 0_i64 rtype )))
-         (set ctx (fragment-context::bind( ctx lhs rtype fr )))
+         (set ctx (.bind( ctx lhs rtype fr )))
          (let prepost (mangle-c-declaration rtype))
          (if (is-const-array rtype) (
             (set e (compile-expr( ctx rhs stack-offset Used )))

PLUGINS/BACKEND/C/compile-stack-call.lm

@@ -28,10 +28,10 @@ compile-stack-call := λ(: ctx FContext)(: f Fragment)(: function-name String)(:
          (set ictx (.set( ictx 'function-name_s (SAtom function-name) )))
          (set ictx (.set( ictx 'used_s (SAtom(to-string used)) )))
          (set.type( ictx (t1( 'ImplicitContext_s )) ))
-         (set ctx (fragment-context::bind( ctx 'ictx_s (t1 'ImplicitContext_s) ictx )))
+         (set ctx (.bind( ctx 'ictx_s (t1 'ImplicitContext_s) ictx )))
 
          (let args-tt (.type push-args))
-         (set ctx (fragment-context::bind( ctx 'args_s args-tt push-args )))
+         (set ctx (.bind( ctx 'args_s args-tt push-args )))
 
          (set r (cc-blob( ctx 'primitive::call_s (t3( 'Cons_s (t1 'ImplicitContext_s) args-tt )) offset args )))
 

PLUGINS/BACKEND/C/fragment::chain.lm

@@ -22,17 +22,6 @@ fragment::chain-c := λ(: l Fragment)(: r Fragment). (: (
    l
 ) Fragment);
 
-fragment::chain := λ(: fragment-ctx FragmentList)(: e Fragment). (: (
-   (while (non-zero fragment-ctx) (match fragment-ctx (
-      ()
-      ( (FLSeq( rst cf )) (
-         (set e (fragment::chain( cf e )))
-         (set fragment-ctx rst)
-      ))
-   )))
-   e
-) Fragment);
-
 fragment::chain := λ(: l Fragment)(: r Fragment). (: (
    (set l (fragment::chain-c( l r )))
    l

SRC/bind-vararg.lm

@@ -4,6 +4,6 @@ bind-vararg := λ(: ctx FContext)(: k String)(: kt Type)(: f Fragment). (: (
    (let binding (fragment-context::lookup-soft( ctx k kt ASTEOF )))
    (set.vararg( binding (cons( (close f) (.vararg binding) )) ))
    (set.type( binding kt ))
-   (set ctx (fragment-context::bind( ctx k kt binding )))
+   (set ctx (.bind( ctx k kt binding )))
    ctx
 ) FContext);

SRC/fctx-bind.lsts

@@ -0,0 +1,5 @@
+
+let .bind(ctx: FContext, k: CString, kt: Type, f: Fragment): FContext = (
+   FCtxBind{ close(ctx), k, kt, f }
+);
+

SRC/index-context.lm

@@ -1,8 +1,5 @@
 
-import SRC/fragment-context::new.lm;
 import SRC/fragment-context::lookup.lm;
 import SRC/fragment-context::lookup-soft.lm;
 import SRC/fragment-context::lookups.lm;
-import SRC/fragment-context::lookup-vararg.lm;
-import SRC/fragment-context::bind.lm;
 import SRC/bind-vararg.lm;

SRC/index-definitions.lm

@@ -1,8 +1,6 @@
 
 type CompileMode ModeParse | ModePreprocess | ModeTypecheck | ModeCompile;
 
-type FragmentList (FLEOF) | (FLSeq( FragmentList[] , Fragment )); zero FragmentList FLEOF;
-
 type IsUsed Used | Unused | Tail | Return | Call;
 type IsScoped Scoped | Unscoped;
 

SRC/index-index.lm

@@ -15,7 +15,6 @@ import SRC/index-types.lm;
 import SRC/index-context.lm;
 import SRC/index-ast.lm;
 import SRC/index-preprocess.lm;
-import SRC/index-fragment.lm;
 import SRC/index-plugins.lm;
 
 import SRC/main.lm;

SRC/index-types.lm

@@ -39,7 +39,6 @@ import SRC/deep-hash.lm;
 
 import SRC/ascript.lm;
 import SRC/ascript-normal.lm;
-import SRC/typeof.lm;
 import SRC/to-s.lm;
 import SRC/union.lm;
 import SRC/tag-of.lm;

SRC/mk-fctx.lsts

@@ -0,0 +1,2 @@
+
+let mk-fctx(): FContext = FCtxEOF;

SRC/mk-fragment.lsts

@@ -2,6 +2,6 @@
 let mk-fragment(): Fragment = (
    Fragment {
       ASTEOF, close([] :: List<Tuple<CString,S>>),
-      TAny, close($"fragment-context::new"()), ([] :: List<Fragment[]>)
+      TAny, close(mk-fctx()), ([] :: List<Fragment[]>)
    }
 );

SRC/unit-fragments.lsts

@@ -7,3 +7,5 @@ import SRC/fragment-get.lsts;
 import SRC/fragment-set.lsts;
 import SRC/mk-fragment.lsts;
 import SRC/mk-expression.lsts;
+import SRC/mk-fctx.lsts;
+import SRC/fctx-bind.lsts;