Merge pull request #1121 from andrew-johnson-4/fragment-get

Fragment get

Cargo.toml

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

Makefile

@@ -5,12 +5,12 @@ dev: install-production
 	./a.out
 
 build: compile-production
-	time ./production --c -o deploy.c SRC/index-index.lm
-	cc -O3 deploy.c -o deploy
-	time ./deploy --c -o deploy2.c SRC/index-index.lm
-	diff deploy.c deploy2.c
-	mv deploy.c BOOTSTRAP/cli.c
-	rm -f deploy.c deploy2.c
+	time ./production --c -o deploy1.c SRC/index-index.lm
+	cc -O3 deploy1.c -o deploy1
+	time ./deploy1 --c -o deploy2.c SRC/index-index.lm
+	diff deploy1.c deploy2.c
+	mv deploy1.c BOOTSTRAP/cli.c
+	rm -f deploy1 deploy1.c deploy2.c
 	cargo test regression_tests
 
 deploy: build smoke-test
@@ -69,13 +69,3 @@ else
 endif
 	mkdir -p $${HOME}/.lm/
 	cp -rf PLATFORM $${HOME}/.lm/
-	#lm LMV/cli.lm -o lmv.s
-	#as -o lmv.o lmv.s
-	#ld -o lmv   lmv.o
-	#mv lmv /usr/local/bin
-	#rm lmv.s lmv.o
-	#lm DOBY/cli.lm -o doby.s
-	#as -o doby.o doby.s
-	#ld -o doby   doby.o
-	#mv doby /usr/local/bin
-	#rm doby.s doby.o

PLUGINS/BACKEND/BLOB/compile-blob.lm

@@ -11,7 +11,7 @@ plugins-backend-blob-compile := λ. (: (
             ()
             ( (Abs( _ _ _ )) (
                (let fragment (fragment::new()))
-               (set fragment (fragment::set( fragment 'fragment-type_s (SAtom 'Function_s) )))
+               (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(

PLUGINS/BACKEND/C/blob-render.lm

@@ -8,7 +8,7 @@ blob-render-simple := λ(: ctx FContext)(: context-key String)(: term AST)(: off
       ( ASTEOF () )
       ( (Var( id _ )) (
          (let e (fragment-context::lookup( ctx id (typeof term) term )))
-         (set r (fragment::get( e context-key )))
+         (set r (.get( e context-key )))
       ))
       ( (Lit( val _ )) (
          (set r (SAtom val))
@@ -164,8 +164,8 @@ blob-render-simple := λ(: ctx FContext)(: context-key String)(: term AST)(: off
          (let f (fragment::new()))
          (let cs (blob-render-simple( ctx context-key rhs offset )))
          (let s (.1 cs))
-         (set f (fragment::set( f context-key s )))
-         (set f (fragment::set( f 'expression_s s )))
+         (set f (.set( f context-key s )))
+         (set f (.set( f 'expression_s s )))
          (set ctx (fragment-context::bind(
             ctx lhs (typeof rhs) f
          ))) # TODO, render the binding as non-simple blob?
@@ -180,7 +180,7 @@ blob-render-simple := λ(: ctx FContext)(: context-key String)(: term AST)(: off
                      (set r (.1 e1))
                   ) (
                      (let e (cc-blob( ctx fname a offset )))
-                     (set r (fragment::get( e context-key )))
+                     (set r (.get( e context-key )))
                   ))
                ))
             ))
@@ -211,29 +211,29 @@ blob-render := λ(: ctx FContext)(: term AST)(: f Fragment)(: offset I64). (: (
          (if (.has-prefix( k ':_s )) (            
             (let cs1 (blob-render-simple( ctx (tail-string k) a offset )))
             (let s1 (.1 cs1))
-            (set f (fragment::set( f (tail-string k) s1 )))
+            (set f (.set( f (tail-string k) s1 )))
          ) (
             (let cs2 (blob-render-simple( ctx 'expression_s term offset )))
             (let s2 (.1 cs2))
-            (set f (fragment::set( f 'expression_s s2 )))
+            (set f (.set( f 'expression_s s2 )))
          ))
       ))
       ( (App( rst (App( (Var( k _ )) a )) )) (
          (set f (blob-render( ctx rst f offset )))
          (if (.has-prefix( k ':_s )) (            
             (let cs1 (blob-render-simple( ctx (tail-string k) a offset )))
             (let s1 (.1 cs1))
-            (set f (fragment::set( f (tail-string k) s1 )))
+            (set f (.set( f (tail-string k) s1 )))
          ) (
             (let cs2 (blob-render-simple( ctx 'expression_s term offset )))
             (let s2 (.1 cs2))
-            (set f (fragment::set( f 'expression_s s2 )))
+            (set f (.set( f 'expression_s s2 )))
          ))
       ))
       ( _ (
          (let cs2 (blob-render-simple( ctx 'expression_s term offset )))
          (let s2 (.1 cs2))
-         (set f (fragment::set( f 'expression_s s2 )))
+         (set f (.set( f 'expression_s s2 )))
       ))
    ))
    f

PLUGINS/BACKEND/C/compile-c-function-args.lm

@@ -10,15 +10,15 @@ compile-c-function-args := λ(: ctx FContext)(: lhs AST). (: (
          (set r (+( r (.first decl) )))
          (set r (+( r (SAtom '\s_s) )))
          (let kf (fragment-context::lookup( ctx k TAny lhs )))
-         (set r (+( r (fragment::get( kf 'expression_s)) )))
+         (set r (+( r (.get( kf 'expression_s)) )))
          (set r (+( r (.second decl) )))
       ))
       ( (App( (Lit( ':_s _ )) (App( (Var( k _ )) (AType kt) )) )) (
          (let decl (mangle-c-declaration kt))
          (set r (.first decl))
          (set r (+( r (SAtom '\s_s) )))
          (let kf (fragment-context::lookup( ctx k TAny lhs )))
-         (set r (+( r (fragment::get( kf 'expression_s)) )))
+         (set r (+( r (.get( kf 'expression_s)) )))
          (set r (+( r (.second decl) )))
       ))
       ( _ () )

PLUGINS/BACKEND/C/compile-c.lm

@@ -18,8 +18,8 @@ plugins-backend-c-compile := λ . (: (
             ) (
                (let clean-tt (without-representation kt))
                (let mid (mangle-identifier( k clean-tt )))
-               (set fragment (fragment::set( fragment 'fragment-type_s (SAtom 'Global_s) )))
-               (set fragment (fragment::set( fragment 'expression_s (SAtom mid) )))
+               (set fragment (.set( fragment 'fragment-type_s (SAtom 'Global_s) )))
+               (set fragment (.set( fragment 'expression_s (SAtom mid) )))
                (if (.is-arrow kt) (
                   (set.type( fragment kt ))
                   (set global-ctx (fragment-context::bind(

PLUGINS/BACKEND/C/compile-constructor.lm

@@ -4,12 +4,12 @@ compile-constructor := λ(: ctx FContext)(: tag-name String)(: return-type Type)
    (let bare-ordinal (with-only-class return-type))
    (let case-number (index-of-tag tag-name))
    (set r (initialize-c-struct( ctx args case-number 1_u64 )))
-   (set r (fragment::set( r 'expression_s (
+   (set r (.set( r 'expression_s (
       (+(
          (+( (+( (SAtom '\[{_s) (mangle-c-type(normalize bare-ordinal)) )) (SAtom '\srvalue={.field_0=_s) ))
          (+(
             (+( (SAtom(to-string case-number)) (SAtom '}\:_s) ))
-            (+( (fragment::get( r 'expression_s )) (SAtom 'rvalue\:}\]_s) ))
+            (+( (.get( r 'expression_s )) (SAtom 'rvalue\:}\]_s) ))
          ))
       ))
    ))))

PLUGINS/BACKEND/C/compile-declare-cstring.lm

@@ -7,7 +7,7 @@ compile-declare-cstring := λ(: val String). (: (
 
 compile-declare-cstring-c := λ(: val String). (: (
    (let r (fragment::new()))
-   (set r (fragment::set( r 'expression_s (
+   (set r (.set( r 'expression_s (
       (+(
          (SAtom '"_s)
          (+(

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

@@ -7,11 +7,11 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
    (match term (
       ()
       ( (AType _) (
-         (set e (fragment::set( e 'expression_s (SAtom '0_s) )))
+         (set e (.set( e 'expression_s (SAtom '0_s) )))
       ))
       ( ASTNil (
          (set.type( e (denormalize(t1 'Nil_s)) ))
-         (set e (fragment::set( e 'expression_s (SAtom '\[{}\]_s) )))
+         (set e (.set( e 'expression_s (SAtom '\[{}\]_s) )))
       ))
       ( ASTEOF () )
       ( (Var( id _ )) (
@@ -28,10 +28,10 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
             (if (.is-t( ltype 'SmartString_s )) (
                (let guid (.lookup( compile-smart-string-index val '_s )))
                (if (non-zero guid) (
-                  (set e (fragment::set( e 'expression_s (SAtom guid) )))
+                  (set e (.set( e 'expression_s (SAtom guid) )))
                ) (
                   (set guid (uuid()))
-                  (set e (fragment::set( e 'expression_s (SAtom guid) )))
+                  (set e (.set( e 'expression_s (SAtom guid) )))
                   (set compile-smart-string-index (.bind( compile-smart-string-index val guid )))
                   (let lit (Lit( val (token::new val) )))
                   (ascript-normal( lit (t1 'String_s) ))
@@ -47,7 +47,7 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
                      assemble-string-initializer-section
                      (+(
                         (+( (SAtom guid) (SAtom '=_s) ))
-                        (+( (fragment::get( intern-ss 'expression_s )) (SAtom '\:\n_s) ))
+                        (+( (.get( intern-ss 'expression_s )) (SAtom '\:\n_s) ))
                      ))
                   )))
                ))
@@ -73,7 +73,7 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
             ) (
                (if (non-zero(class-of-tag val)) (
                   (let tag-index (index-of-tag val))
-                  (set e (fragment::set( e 'expression_s (
+                  (set e (.set( e 'expression_s (
                      (+(
                         (+(
                            (SAtom '\[{_s)
@@ -103,9 +103,9 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
                      ( '\\:_s (set e (fragment::expression '\[59\]_s)) )
                      ( _ (
                         (if (.is-t( ltype 'L_s )) (
-                           (set e (fragment::set( e 'expression_s (SAtom val) )))
+                           (set e (.set( e 'expression_s (SAtom val) )))
                         ) (
-                           (set e (fragment::set( e 'expression_s (
+                           (set e (.set( e 'expression_s (
                               (+( (+( (SAtom '\[_s) (SAtom val) )) (SAtom '\]_s) ))
                            ))))
                         ))
@@ -162,7 +162,7 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
       ( (App( (Var( 'as_s _ )) (App( t (AType tt) )) )) (
          (set e (compile-expr( ctx t stack-offset used )))
          (set.type( e (typeof term) ))
-         (set e (fragment::set( e 'expression_s (
+         (set e (.set( e 'expression_s (
             (+(
                (+(
                   (SAtom '\[\[_s)
@@ -171,7 +171,7 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
                (+(
                   (SAtom '\]\[_s)
                   (+(
-                     (fragment::get( e 'expression_s ))
+                     (.get( e 'expression_s ))
                      (SAtom '\]\]_s)
                   ))
                ))
@@ -217,61 +217,61 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
          (let prepost (mangle-c-declaration rtype))
          (if (is-const-array rtype) (
             (set e (compile-expr( ctx rhs stack-offset Used )))
-            (set e (fragment::set( e 'frame_s (
+            (set e (.set( e 'frame_s (
                (+(
                   (+(
                      (.first prepost)
                      (SAtom '\s_s)
                   ))
                   (+(
-                     (fragment::get( fr 'expression_s ))
+                     (.get( fr 'expression_s ))
                      (+(
                         (+(
                            (.second prepost)
                            (SAtom '=_s)
                         ))
                         (+(
-                           (fragment::get( e 'expression_s ))
+                           (.get( e 'expression_s ))
                            (SAtom '\:\n_s)
                         ))
                      ))
                   ))
                ))
             ))))
-            (set e (fragment::set( e 'expression_s SNil )))
+            (set e (.set( e 'expression_s SNil )))
          ) (
             (match rhs (
                ()
                ( (App( (Lit( ':_s _ )) (App( (Var( '__uninitialized_s _ )) (AType tt) )) )) () )
                ( _ (
                   (set e (compile-expr( ctx rhs stack-offset Used )))
-                  (set e (fragment::set( e 'expression_s (
+                  (set e (.set( e 'expression_s (
                      (+(
                         (+(
                            (SAtom '\[{_s)
-                           (fragment::get( fr 'expression_s ))
+                           (.get( fr 'expression_s ))
                         ))
                         (+(
                            (SAtom '=_s)
                            (+(
-                              (fragment::get( e 'expression_s ))
+                              (.get( e 'expression_s ))
                               (SAtom '\:\[{}\]\:}\]\n_s)
                            ))
                         ))
                      ))
                   ))))
                ))
             ))
-            (set e (fragment::set( e 'frame_s (
+            (set e (.set( e 'frame_s (
                (+(
-                  (fragment::get( e 'frame_s ))
+                  (.get( e 'frame_s ))
                   (+(
                      (+(
                         (.first prepost)
                         (SAtom '\s_s)
                      ))
                      (+(
-                        (fragment::get( fr 'expression_s ))
+                        (.get( fr 'expression_s ))
                         (+(
                            (.second prepost)
                            (SAtom '\:\n_s)
@@ -304,9 +304,9 @@ compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used
                   (let call (compile-expr( ctx f stack-offset Unused )))
                   (let args (compile-push-rvalue( ctx a stack-offset )))
                   (set e (fragment::chain( call args )))
-                  (set e (fragment::set( e 'expression_s (+(
-                     (+( (fragment::get( call 'expression_s )) (SAtom '\[_s) ))
-                     (+( (fragment::get( args 'expression_s )) (SAtom '\]_s) ))
+                  (set e (.set( e 'expression_s (+(
+                     (+( (.get( call 'expression_s )) (SAtom '\[_s) ))
+                     (+( (.get( args 'expression_s )) (SAtom '\]_s) ))
                   )))))
                ))
             ))

PLUGINS/BACKEND/C/compile-global.lm

@@ -20,8 +20,8 @@ compile-global-c := λ(: ctx FContext)(: k String)(: term AST). (: (
             (set e (compile-expr( ctx rhs 0_i64 Return )))
             (set function-name (mangle-identifier( k kt )))
          ))
-         (let program (fragment::get( e 'expression_s )))
-         (let frame (fragment::get( e 'frame_s )))
+         (let program (.get( e 'expression_s )))
+         (let frame (.get( e 'frame_s )))
          (let text SNil)
 
          (let loc (location-of(term)))
@@ -106,7 +106,7 @@ compile-global-c := λ(: ctx FContext)(: k String)(: term AST). (: (
 
          (set text (SAtom mid))
          (set text (SCons( (close text) (close(SAtom '=_s)) )))
-         (set text (SCons( (close text) (close(fragment::get( e 'expression_s ))) )))
+         (set text (SCons( (close text) (close(.get( e 'expression_s ))) )))
          (set text (SCons( (close text) (close(SAtom '\:\n_s)) )))
          (set assemble-global-initializer-section (SCons( (close assemble-global-initializer-section) (close text) )))
       ))

PLUGINS/BACKEND/C/compile-program-ordered.lm

@@ -22,7 +22,7 @@ compile-program-ordered := λ(: global-ctx FContext)(: program AST). (: (
       ( (Meta _) () )
       ( t (
          (let e (compile-expr( global-ctx t 0_i64 Used )))
-         (let text (+( (+( (fragment::get( e 'frame_s )) (fragment::get( e 'expression_s )) )) (SAtom '\:\n_s) )))
+         (let text (+( (+( (.get( e 'frame_s )) (.get( e 'expression_s )) )) (SAtom '\:\n_s) )))
          (set assemble-global-initializer-section (SCons( (close assemble-global-initializer-section) (close text) )))
       ))
    )))

PLUGINS/BACKEND/C/compile-push-rvalue.lm

@@ -15,12 +15,12 @@ compile-push-rvalue := λ(: ctx FContext)(: rval AST)(: offset I64)(: count U64)
                (let e2 (compile-expr( ctx re (.offset e1) Used )))
                (set r (fragment::chain( e1 e2 )))
                (if left-assoc (
-                  (set r (fragment::set( r 'expression_s (
-                     (+( (+( (fragment::get( e1 'expression_s )) (SAtom ',_s) )) (fragment::get( e2 'expression_s )) ))
+                  (set r (.set( r 'expression_s (
+                     (+( (+( (.get( e1 'expression_s )) (SAtom ',_s) )) (.get( e2 'expression_s )) ))
                   ))))
                ) (
-                  (set r (fragment::set( r 'expression_s (
-                     (+( (+( (fragment::get( e2 'expression_s )) (SAtom ',_s) )) (fragment::get( e1 'expression_s )) ))
+                  (set r (.set( r 'expression_s (
+                     (+( (+( (.get( e2 'expression_s )) (SAtom ',_s) )) (.get( e1 'expression_s )) ))
                   ))))
                ))
             ))

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

@@ -24,9 +24,9 @@ compile-stack-call := λ(: ctx FContext)(: f Fragment)(: function-name String)(:
             (set function-id (mangle-identifier( function-name function-type )))
          ))
 
-         (set ictx (fragment::set( ictx 'function-id_s (SAtom function-id) )))  
-         (set ictx (fragment::set( ictx 'function-name_s (SAtom function-name) )))
-         (set ictx (fragment::set( ictx 'used_s (SAtom(to-string used)) )))
+         (set ictx (.set( ictx 'function-id_s (SAtom function-id) )))  
+         (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 )))