diff options
Diffstat (limited to 'stdlib/source')
61 files changed, 1263 insertions, 1154 deletions
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 05293ad5a..c98304c87 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -42,10 +42,11 @@ [directive [".D" lux]]]]]] [meta - [archive + [archive (#+ Archive) ["." signature] ["." key (#+ Key)] ["." descriptor (#+ Module)] + ["." artifact] ["." document]]]]]) (def: #export (info target) @@ -148,9 +149,9 @@ ///generation.buffer)) ## TODO: Inline ASAP -(def: (process-directive expander pre-buffer code) +(def: (process-directive archive expander pre-buffer code) (All [directive] - (-> Expander (///generation.Buffer directive) Code + (-> Archive Expander (///generation.Buffer directive) Code (All [anchor expression] (///directive.Operation anchor expression directive [Requirements (///generation.Buffer directive)])))) @@ -158,25 +159,25 @@ [_ (///directive.lift-generation (///generation.set-buffer pre-buffer)) requirements (let [execute! (directiveP.phase expander)] - (execute! code)) + (execute! archive code)) post-buffer (..get-current-buffer pre-buffer)] (wrap [requirements post-buffer]))) -(def: (iteration expander reader source pre-buffer) +(def: (iteration archive expander reader source pre-buffer) (All [directive] - (-> Expander Reader Source (///generation.Buffer directive) + (-> Archive Expander Reader Source (///generation.Buffer directive) (All [anchor expression] (///directive.Operation anchor expression directive [Source Requirements (///generation.Buffer directive)])))) (do ///phase.monad [[source code] (///directive.lift-analysis (..read source reader)) - [requirements post-buffer] (process-directive expander pre-buffer code)] + [requirements post-buffer] (process-directive archive expander pre-buffer code)] (wrap [source requirements post-buffer]))) -(def: (iterate expander module source pre-buffer aliases) +(def: (iterate archive expander module source pre-buffer aliases) (All [directive] - (-> Expander Module Source (///generation.Buffer directive) Aliases + (-> Archive Expander Module Source (///generation.Buffer directive) Aliases (All [anchor expression] (///directive.Operation anchor expression directive (Maybe [Source Requirements (///generation.Buffer directive)]))))) @@ -184,7 +185,7 @@ [reader (///directive.lift-analysis (..reader module aliases source))] (function (_ state) - (case (///phase.run' state (..iteration expander reader source pre-buffer)) + (case (///phase.run' state (..iteration archive expander reader source pre-buffer)) (#try.Success [state source&requirements&buffer]) (#try.Success [state (#.Some source&requirements&buffer)]) @@ -218,7 +219,7 @@ (..begin dependencies hash input)) #let [module (get@ #///.module input)]] (loop [iteration (<| (///phase.run' state) - (..iterate expander module source buffer ///syntax.no-aliases))] + (..iterate archive expander module source buffer ///syntax.no-aliases))] (do @ [[state ?source&requirements&temporary-buffer] iteration] (case ?source&requirements&temporary-buffer @@ -229,7 +230,8 @@ #descriptor.name module #descriptor.file (get@ #///.file input) #descriptor.references (set.from-list text.hash dependencies) - #descriptor.state #.Compiled}]] + #descriptor.state #.Compiled + #descriptor.registry artifact.empty}]] (wrap [state (#.Right [[descriptor (document.write key analysis-module)] (|> final-buffer @@ -251,9 +253,9 @@ macro.current-module) _ (///directive.lift-generation (///generation.set-buffer temporary-buffer)) - _ (monad.map @ execute! (get@ #///directive.referrals requirements)) + _ (monad.map @ (execute! archive) (get@ #///directive.referrals requirements)) temporary-buffer (..get-current-buffer temporary-buffer)] - (..iterate expander module source temporary-buffer (..module-aliases analysis-module))))))})]) + (..iterate archive expander module source temporary-buffer (..module-aliases analysis-module))))))})]) )))))})))) (def: #export key diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux index 710bb3eb0..66efb1dde 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux @@ -18,10 +18,12 @@ ["." synthesis] ["." generation] [/// - ["." phase]]]]]]) + ["." phase] + [meta + [archive (#+ Archive)]]]]]]]) (type: #export Eval - (-> Nat Type Code (Operation Any))) + (-> Archive Nat Type Code (Operation Any))) (def: #export (evaluator expander synthesis-state generation-state generate) (All [anchor expression artifact] @@ -31,13 +33,13 @@ (generation.Phase anchor expression artifact) Eval)) (let [analyze (analysisP.phase expander)] - (function (eval count type exprC) + (function (eval archive count type exprC) (do phase.monad [exprA (type.with-type type - (analyze exprC))] + (analyze archive exprC))] (phase.lift (do try.monad - [exprS (|> exprA synthesisP.phase (phase.run synthesis-state))] + [exprS (|> exprA (synthesisP.phase archive) (phase.run synthesis-state))] (phase.run generation-state (do phase.monad - [exprO (generate exprS)] + [exprO (generate archive exprS)] (generation.evaluate! (format "eval" (%.nat count)) exprO))))))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index 80e5f37e3..c8cd8f3cb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -22,7 +22,8 @@ ["." phase] [meta [archive - [descriptor (#+ Module)]]]]]) + [descriptor (#+ Module)] + ["." artifact]]]]]) (type: #export Registry (Dictionary Name Text)) @@ -78,6 +79,7 @@ #host (Host expression directive) #buffer (Maybe (Buffer directive)) #output (Output directive) + #registry artifact.Registry #counter Nat #name-cache Registry}) @@ -106,6 +108,7 @@ #host host #buffer #.None #output row.empty + #registry artifact.empty #counter 0 #name-cache (dictionary.new name.hash)}) @@ -228,7 +231,7 @@ (#try.Success [state+ output]) (#try.Failure error) - (exception.throw cannot-interpret error))))] + (exception.throw ..cannot-interpret error))))] [evaluate! expression] [execute! directive] @@ -243,7 +246,7 @@ (#try.Success [stateE output]) (#try.Failure error) - (exception.throw cannot-interpret error)))) + (exception.throw ..cannot-interpret error)))) (def: #export (save! execute? name code) (All [anchor expression directive] @@ -281,7 +284,7 @@ (#try.Success [stateE host-name]) #.None - (exception.throw unknown-lux-name [lux-name cache]))))) + (exception.throw ..unknown-lux-name [lux-name cache]))))) (def: #export (learn lux-name host-name) (All [anchor expression directive] @@ -297,4 +300,4 @@ []]) (#.Some old-host-name) - (exception.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]))))) + (exception.throw ..cannot-overwrite-lux-name [lux-name old-host-name host-name]))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux index cd8a723b0..aa0ec7995 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -22,7 +22,9 @@ ["#." macro (#+ Expander)]] [/// ["//" phase] - ["." reference]]]]]) + ["." reference] + [meta + [archive (#+ Archive)]]]]]]) (exception: #export (unrecognized-syntax {code Code}) (ex.report ["Code" (%.code code)])) @@ -49,60 +51,60 @@ _ (else code'))) -(def: (compile|structure compile else code') - (-> Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))) +(def: (compile|structure archive compile else code') + (-> Archive Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))) (case code' (^template [<tag> <analyser>] (^ (#.Form (list& [_ (<tag> tag)] values))) (case values (#.Cons value #.Nil) - (<analyser> compile tag value) + (<analyser> compile tag archive value) _ - (<analyser> compile tag (` [(~+ values)])))) + (<analyser> compile tag archive (` [(~+ values)])))) ([#.Nat /structure.sum] [#.Tag /structure.tagged-sum]) (#.Tag tag) - (/structure.tagged-sum compile tag (' [])) + (/structure.tagged-sum compile tag archive (' [])) (^ (#.Tuple (list))) /primitive.unit (^ (#.Tuple (list singleton))) - (compile singleton) + (compile archive singleton) (^ (#.Tuple elems)) - (/structure.product compile elems) + (/structure.product archive compile elems) (^ (#.Record pairs)) - (/structure.record compile pairs) + (/structure.record archive compile pairs) _ (else code'))) -(def: (compile|others expander compile code') - (-> Expander Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) +(def: (compile|others expander archive compile code') + (-> Expander Archive Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) (case code' (#.Identifier reference) (/reference.reference reference) (^ (#.Form (list [_ (#.Record branches)] input))) - (/case.case compile input branches) + (/case.case compile branches archive input) (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) - (//extension.apply compile [extension-name extension-args]) + (//extension.apply archive compile [extension-name extension-args]) (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] [_ (#.Identifier ["" arg-name])]))] body))) - (/function.function compile function-name arg-name body) + (/function.function compile function-name arg-name archive body) (^ (#.Form (list& functionC argsC+))) (do //.monad [[functionT functionA] (/type.with-inference - (compile functionC))] + (compile archive functionC))] (case functionA (#/.Reference (#reference.Constant def-name)) (do @ @@ -111,23 +113,24 @@ (#.Some macro) (do @ [expansion (//extension.lift (/macro.expand-one expander def-name macro argsC+))] - (compile expansion)) + (compile archive expansion)) _ - (/function.apply compile functionT functionA functionC argsC+))) + (/function.apply compile argsC+ functionT functionA archive functionC))) _ - (/function.apply compile functionT functionA functionC argsC+))) + (/function.apply compile argsC+ functionT functionA archive functionC))) _ (//.throw unrecognized-syntax [.dummy-cursor code']))) (def: #export (phase expander) (-> Expander Phase) - (function (compile code) + (function (compile archive code) (let [[cursor code'] code] ## The cursor must be set in the state for the sake ## of having useful error messages. (/.with-cursor cursor - (compile|primitive (compile|structure compile (compile|others expander compile)) + (compile|primitive (compile|structure archive compile + (compile|others expander archive compile)) code'))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index a74613491..e85d5c9b4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -294,17 +294,17 @@ (/.throw not-a-pattern pattern) )) -(def: #export (case analyse inputC branches) - (-> Phase Code (List [Code Code]) (Operation Analysis)) +(def: #export (case analyse branches archive inputC) + (-> Phase (List [Code Code]) Phase) (.case branches (#.Cons [patternH bodyH] branchesT) (do ///.monad [[inputT inputA] (//type.with-inference - (analyse inputC)) - outputH (analyse-pattern #.None inputT patternH (analyse bodyH)) + (analyse archive inputC)) + outputH (analyse-pattern #.None inputT patternH (analyse archive bodyH)) outputT (monad.map @ (function (_ [patternT bodyT]) - (analyse-pattern #.None inputT patternT (analyse bodyT))) + (analyse-pattern #.None inputT patternT (analyse archive bodyT))) branchesT) outputHC (|> outputH product.left /coverage.determine) outputTC (monad.map @ (|>> product.left /coverage.determine) outputT) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux index 7e367ee5c..a4b94ec4e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -39,8 +39,8 @@ (format (%.nat idx) " " (%.code argC)))) (text.join-with text.new-line))])) -(def: #export (function analyse function-name arg-name body) - (-> Phase Text Text Code (Operation Analysis)) +(def: #export (function analyse function-name arg-name archive body) + (-> Phase Text Text Phase) (do ///.monad [functionT (///extension.lift macro.expected-type)] (loop [expectedT functionT] @@ -94,15 +94,15 @@ (//scope.with-local [function-name expectedT]) (//scope.with-local [arg-name inputT]) (//type.with-type outputT) - (analyse body)) + (analyse archive body)) _ (/.fail "") ))))) -(def: #export (apply analyse functionT functionA functionC argsC+) - (-> Phase Type Analysis Code (List Code) (Operation Analysis)) +(def: #export (apply analyse argsC+ functionT functionA archive functionC) + (-> Phase (List Code) Type Analysis Phase) (<| (/.with-stack cannot-apply [functionT functionC argsC+]) (do ///.monad - [[applyT argsA+] (//inference.general analyse functionT argsC+)]) + [[applyT argsA+] (//inference.general archive analyse functionT argsC+)]) (wrap (/.apply [functionA argsA+])))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 4510cf1dd..9a1e07d7a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -22,7 +22,9 @@ [// ["/" analysis (#+ Tag Analysis Operation Phase)] [/// - ["#" phase ("#@." monad)]]]]]) + ["#" phase ("#@." monad)] + [meta + [archive (#+ Archive)]]]]]]) (exception: #export (variant-tag-out-of-bounds {size Nat} {tag Tag} {type Type}) (ex.report ["Tag" (%.nat tag)] @@ -103,8 +105,8 @@ ## tagged variants). ## But, so long as the type being used for the inference can be treated ## as a function type, this method of inference should work. -(def: #export (general analyse inferT args) - (-> Phase Type (List Code) (Operation [Type (List Analysis)])) +(def: #export (general archive analyse inferT args) + (-> Archive Phase Type (List Code) (Operation [Type (List Analysis)])) (case args #.Nil (do ///.monad @@ -114,17 +116,17 @@ (#.Cons argC args') (case inferT (#.Named name unnamedT) - (general analyse unnamedT args) + (general archive analyse unnamedT args) (#.UnivQ _) (do ///.monad [[var-id varT] (//type.with-env check.var)] - (general analyse (maybe.assume (type.apply (list varT) inferT)) args)) + (general archive analyse (maybe.assume (type.apply (list varT) inferT)) args)) (#.ExQ _) (do ///.monad [[var-id varT] (//type.with-env check.var) - output (general analyse + output (general archive analyse (maybe.assume (type.apply (list varT) inferT)) args) bound? (//type.with-env @@ -140,7 +142,7 @@ (#.Apply inputT transT) (case (type.apply (list inputT) transT) (#.Some outputT) - (general analyse outputT args) + (general archive analyse outputT args) #.None (/.throw invalid-type-application inferT)) @@ -154,10 +156,10 @@ ## things together more easily. (#.Function inputT outputT) (do ///.monad - [[outputT' args'A] (general analyse outputT args') + [[outputT' args'A] (general archive analyse outputT args') argA (<| (/.with-stack cannot-infer-argument [inputT argC]) (//type.with-type inputT) - (analyse argC))] + (analyse archive argC))] (wrap [outputT' (list& argA args'A)])) (#.Var infer-id) @@ -165,7 +167,7 @@ [?inferT' (//type.with-env (check.read infer-id))] (case ?inferT' (#.Some inferT') - (general analyse inferT' args) + (general archive analyse inferT' args) _ (/.throw cannot-infer [inferT args]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index ee4ebb40d..cd07f23c4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -29,7 +29,9 @@ [// ["/" analysis (#+ Tag Analysis Operation Phase)] [/// - ["#" phase]]]]]) + ["#" phase] + [meta + [archive (#+ Archive)]]]]]]) (exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code}) (ex.report ["Type" (%.type type)] @@ -85,88 +87,89 @@ [(code.tag keyI) valueC])) code.record))])) -(def: #export (sum analyse tag valueC) - (-> Phase Nat Code (Operation Analysis)) - (do ///.monad - [expectedT (///extension.lift macro.expected-type) - expectedT' (//type.with-env - (check.clean expectedT))] - (/.with-stack cannot-analyse-variant [expectedT' tag valueC] - (case expectedT - (#.Sum _) - (let [flat (type.flatten-variant expectedT) - type-size (list.size flat) - right? (n.= (dec type-size) - tag) - lefts (if right? - (dec tag) - tag)] - (case (list.nth tag flat) - (#.Some variant-type) - (do @ - [valueA (//type.with-type variant-type - (analyse valueC))] - (wrap (/.variant [lefts right? valueA]))) - - #.None - (/.throw //inference.variant-tag-out-of-bounds [type-size tag expectedT]))) - - (#.Named name unnamedT) - (//type.with-type unnamedT - (sum analyse tag valueC)) - - (#.Var id) - (do @ - [?expectedT' (//type.with-env - (check.read id))] - (case ?expectedT' - (#.Some expectedT') - (//type.with-type expectedT' - (sum analyse tag valueC)) - - _ - ## Cannot do inference when the tag is numeric. - ## This is because there is no way of knowing how many - ## cases the inferred sum type would have. - (/.throw cannot-infer-numeric-tag [expectedT tag valueC]) - )) - - (^template [<tag> <instancer>] - (<tag> _) - (do @ - [[instance-id instanceT] (//type.with-env <instancer>)] - (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) - (sum analyse tag valueC)))) - ([#.UnivQ check.existential] - [#.ExQ check.var]) - - (#.Apply inputT funT) - (case funT - (#.Var funT-id) +(def: #export (sum analyse tag archive) + (-> Phase Nat Phase) + (function (recur valueC) + (do ///.monad + [expectedT (///extension.lift macro.expected-type) + expectedT' (//type.with-env + (check.clean expectedT))] + (/.with-stack cannot-analyse-variant [expectedT' tag valueC] + (case expectedT + (#.Sum _) + (let [flat (type.flatten-variant expectedT) + type-size (list.size flat) + right? (n.= (dec type-size) + tag) + lefts (if right? + (dec tag) + tag)] + (case (list.nth tag flat) + (#.Some variant-type) + (do @ + [valueA (//type.with-type variant-type + (analyse archive valueC))] + (wrap (/.variant [lefts right? valueA]))) + + #.None + (/.throw //inference.variant-tag-out-of-bounds [type-size tag expectedT]))) + + (#.Named name unnamedT) + (//type.with-type unnamedT + (recur valueC)) + + (#.Var id) (do @ - [?funT' (//type.with-env (check.read funT-id))] - (case ?funT' - (#.Some funT') - (//type.with-type (#.Apply inputT funT') - (sum analyse tag valueC)) + [?expectedT' (//type.with-env + (check.read id))] + (case ?expectedT' + (#.Some expectedT') + (//type.with-type expectedT' + (recur valueC)) _ - (/.throw invalid-variant-type [expectedT tag valueC]))) + ## Cannot do inference when the tag is numeric. + ## This is because there is no way of knowing how many + ## cases the inferred sum type would have. + (/.throw cannot-infer-numeric-tag [expectedT tag valueC]) + )) + + (^template [<tag> <instancer>] + (<tag> _) + (do @ + [[instance-id instanceT] (//type.with-env <instancer>)] + (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) + (recur valueC)))) + ([#.UnivQ check.existential] + [#.ExQ check.var]) + + (#.Apply inputT funT) + (case funT + (#.Var funT-id) + (do @ + [?funT' (//type.with-env (check.read funT-id))] + (case ?funT' + (#.Some funT') + (//type.with-type (#.Apply inputT funT') + (recur valueC)) - _ - (case (type.apply (list inputT) funT) - (#.Some outputT) - (//type.with-type outputT - (sum analyse tag valueC)) + _ + (/.throw invalid-variant-type [expectedT tag valueC]))) - #.None - (/.throw not-a-quantified-type funT))) - - _ - (/.throw invalid-variant-type [expectedT tag valueC]))))) + _ + (case (type.apply (list inputT) funT) + (#.Some outputT) + (//type.with-type outputT + (recur valueC)) + + #.None + (/.throw not-a-quantified-type funT))) + + _ + (/.throw invalid-variant-type [expectedT tag valueC])))))) -(def: (typed-product analyse members) - (-> Phase (List Code) (Operation Analysis)) +(def: (typed-product archive analyse members) + (-> Archive Phase (List Code) (Operation Analysis)) (do ///.monad [expectedT (///extension.lift macro.expected-type) membersA+ (: (Operation (List Analysis)) @@ -175,16 +178,16 @@ (case [membersT+ membersC+] [(#.Cons memberT #.Nil) _] (//type.with-type memberT - (:: @ map (|>> list) (analyse (code.tuple membersC+)))) + (:: @ map (|>> list) (analyse archive (code.tuple membersC+)))) [_ (#.Cons memberC #.Nil)] (//type.with-type (type.tuple membersT+) - (:: @ map (|>> list) (analyse memberC))) + (:: @ map (|>> list) (analyse archive memberC))) [(#.Cons memberT membersT+') (#.Cons memberC membersC+')] (do @ [memberA (//type.with-type memberT - (analyse memberC)) + (analyse archive memberC)) memberA+ (recur membersT+' membersC+')] (wrap (#.Cons memberA memberA+))) @@ -192,18 +195,18 @@ (/.throw cannot-analyse-tuple [expectedT members]))))] (wrap (/.tuple membersA+)))) -(def: #export (product analyse membersC) - (-> Phase (List Code) (Operation Analysis)) +(def: #export (product archive analyse membersC) + (-> Archive Phase (List Code) (Operation Analysis)) (do ///.monad [expectedT (///extension.lift macro.expected-type)] (/.with-stack cannot-analyse-tuple [expectedT membersC] (case expectedT (#.Product _) - (..typed-product analyse membersC) + (..typed-product archive analyse membersC) (#.Named name unnamedT) (//type.with-type unnamedT - (product analyse membersC)) + (product archive analyse membersC)) (#.Var id) (do @ @@ -212,12 +215,12 @@ (case ?expectedT' (#.Some expectedT') (//type.with-type expectedT' - (product analyse membersC)) + (product archive analyse membersC)) _ ## Must do inference... (do @ - [membersTA (monad.map @ (|>> analyse //type.with-inference) + [membersTA (monad.map @ (|>> (analyse archive) //type.with-inference) membersC) _ (//type.with-env (check.check expectedT @@ -229,7 +232,7 @@ (do @ [[instance-id instanceT] (//type.with-env <instancer>)] (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) - (product analyse membersC)))) + (product archive analyse membersC)))) ([#.UnivQ check.existential] [#.ExQ check.var]) @@ -241,7 +244,7 @@ (case ?funT' (#.Some funT') (//type.with-type (#.Apply inputT funT') - (product analyse membersC)) + (product archive analyse membersC)) _ (/.throw invalid-tuple-type [expectedT membersC]))) @@ -250,7 +253,7 @@ (case (type.apply (list inputT) funT) (#.Some outputT) (//type.with-type outputT - (product analyse membersC)) + (product archive analyse membersC)) #.None (/.throw not-a-quantified-type funT))) @@ -259,8 +262,8 @@ (/.throw invalid-tuple-type [expectedT membersC]) )))) -(def: #export (tagged-sum analyse tag valueC) - (-> Phase Name Code (Operation Analysis)) +(def: #export (tagged-sum analyse tag archive valueC) + (-> Phase Name Phase) (do ///.monad [tag (///extension.lift (macro.normalize tag)) [idx group variantT] (///extension.lift (macro.resolve-tag tag)) @@ -270,7 +273,7 @@ (do @ [#let [case-size (list.size group)] inferenceT (//inference.variant idx case-size variantT) - [inferredT valueA+] (//inference.general analyse inferenceT (list valueC)) + [inferredT valueA+] (//inference.general archive analyse inferenceT (list valueC)) #let [right? (n.= (dec case-size) idx) lefts (if right? (dec idx) @@ -278,7 +281,7 @@ (wrap (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) _ - (..sum analyse idx valueC)))) + (..sum analyse idx archive valueC)))) ## There cannot be any ambiguity or improper syntax when analysing ## records, so they must be normalized for further analysis. @@ -339,14 +342,14 @@ (wrap [ordered-tuple recordT])) )) -(def: #export (record analyse members) - (-> Phase (List [Code Code]) (Operation Analysis)) +(def: #export (record archive analyse members) + (-> Archive Phase (List [Code Code]) (Operation Analysis)) (case members (^ (list)) //primitive.unit (^ (list [_ singletonC])) - (analyse singletonC) + (analyse archive singletonC) _ (do ///.monad @@ -357,8 +360,8 @@ (#.Var _) (do @ [inferenceT (//inference.record recordT) - [inferredT membersA] (//inference.general analyse inferenceT membersC)] + [inferredT membersA] (//inference.general archive analyse inferenceT membersC)] (wrap (/.tuple membersA))) _ - (..product analyse membersC))))) + (..product archive analyse membersC))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux index a6311eaf8..8a809c493 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -8,7 +8,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#;." fold monoid)]]] + ["." list ("#@." fold monoid)]]] ["." macro]] ["." // #_ ["#." extension] @@ -38,17 +38,17 @@ (def: #export (phase expander) (-> Expander Phase) (let [analyze (//analysis.phase expander)] - (function (recur code) + (function (recur archive code) (case code (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (//extension.apply recur [name inputs]) + (//extension.apply archive recur [name inputs]) (^ [_ (#.Form (list& macro inputs))]) (do //.monad [expansion (/.lift-analysis (do @ [macroA (//analysis/type.with-type Macro - (analyze macro))] + (analyze archive macro))] (case macroA (^ (///analysis.constant macro-name)) (do @ @@ -65,13 +65,13 @@ (//.throw ..invalid-macro-call code))))] (case expansion (^ (list& <lux_def_module> referrals)) - (|> (recur <lux_def_module>) - (:: @ map (update@ #/.referrals (list;compose referrals)))) + (|> (recur archive <lux_def_module>) + (:: @ map (update@ #/.referrals (list@compose referrals)))) _ (|> expansion - (monad.map @ recur) - (:: @ map (list;fold /.merge-requirements /.no-requirements))))) + (monad.map @ (recur archive)) + (:: @ map (list@fold /.merge-requirements /.no-requirements))))) _ (//.throw ..not-a-directive code)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux index a3e841912..74b47e755 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux @@ -13,7 +13,9 @@ ["." list ("#@." functor)] ["." dictionary (#+ Dictionary)]]]] [///// - ["//" phase]]) + ["//" phase] + [meta + [archive (#+ Archive)]]]) (type: #export Name Text) @@ -77,13 +79,13 @@ _ (exception.throw cannot-overwrite name)))) -(def: #export (apply phase [name parameters]) +(def: #export (apply archive phase [name parameters]) (All [s i o] - (-> (Phase s i o) (Extension i) (Operation s i o o))) + (-> Archive (Phase s i o) (Extension i) (Operation s i o o))) (function (_ (^@ stateE [bundle state])) (case (dictionary.get name bundle) (#.Some handler) - (((handler name phase) parameters) + (((handler name phase) archive parameters) stateE) #.None diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index aaa37ccfc..76d8525ba 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -54,7 +54,7 @@ [reference (#+)] ["." phase ("#@." monad)] [meta - [archive + [archive (#+ Archive) [descriptor (#+ Module)]]]]]]]]) (def: reflection @@ -320,7 +320,7 @@ (def: (primitive-array-length-handler primitive-type) (-> (Type Primitive) Handler) - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list arrayC)) (do phase.monad @@ -328,7 +328,7 @@ arrayA (typeA.with-type (#.Primitive (|> (jvm.array primitive-type) ..reflection) (list)) - (analyse arrayC))] + (analyse archive arrayC))] (wrap (#/////analysis.Extension extension-name (list arrayA)))) _ @@ -336,14 +336,14 @@ (def: array::length::object Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list arrayC)) (do phase.monad [_ (typeA.infer ..int) [var-id varT] (typeA.with-env check.var) arrayA (typeA.with-type (.type (array.Array varT)) - (analyse arrayC)) + (analyse archive arrayC)) varT (typeA.with-env (check.clean varT)) arrayJT (jvm-array-type (.type (array.Array varT)))] (wrap (#/////analysis.Extension extension-name (list (/////analysis.text (..signature arrayJT)) @@ -354,12 +354,12 @@ (def: (new-primitive-array-handler primitive-type) (-> (Type Primitive) Handler) - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list lengthC)) (do phase.monad [lengthA (typeA.with-type ..int - (analyse lengthC)) + (analyse archive lengthC)) _ (typeA.infer (#.Primitive (|> (jvm.array primitive-type) ..reflection) (list)))] (wrap (#/////analysis.Extension extension-name (list lengthA)))) @@ -369,12 +369,12 @@ (def: array::new::object Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list lengthC)) (do phase.monad [lengthA (typeA.with-type ..int - (analyse lengthC)) + (analyse archive lengthC)) expectedT (///.lift macro.expected-type) expectedJT (jvm-array-type expectedT) elementJT (case (jvm-parser.array? expectedJT) @@ -525,16 +525,16 @@ (def: (read-primitive-array-handler lux-type jvm-type) (-> .Type (Type Primitive) Handler) - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list idxC arrayC)) (do phase.monad [_ (typeA.infer lux-type) idxA (typeA.with-type ..int - (analyse idxC)) + (analyse archive idxC)) arrayA (typeA.with-type (#.Primitive (|> (jvm.array jvm-type) ..reflection) (list)) - (analyse arrayC))] + (analyse archive arrayC))] (wrap (#/////analysis.Extension extension-name (list idxA arrayA)))) _ @@ -542,19 +542,19 @@ (def: array::read::object Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list idxC arrayC)) (do phase.monad [[var-id varT] (typeA.with-env check.var) _ (typeA.infer varT) arrayA (typeA.with-type (.type (array.Array varT)) - (analyse arrayC)) + (analyse archive arrayC)) varT (typeA.with-env (check.clean varT)) arrayJT (jvm-array-type (.type (array.Array varT))) idxA (typeA.with-type ..int - (analyse idxC))] + (analyse archive idxC))] (wrap (#/////analysis.Extension extension-name (list (/////analysis.text (..signature arrayJT)) idxA arrayA)))) @@ -566,17 +566,17 @@ (-> .Type (Type Primitive) Handler) (let [array-type (#.Primitive (|> (jvm.array jvm-type) ..reflection) (list))] - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list idxC valueC arrayC)) (do phase.monad [_ (typeA.infer array-type) idxA (typeA.with-type ..int - (analyse idxC)) + (analyse archive idxC)) valueA (typeA.with-type lux-type - (analyse valueC)) + (analyse archive valueC)) arrayA (typeA.with-type array-type - (analyse arrayC))] + (analyse archive arrayC))] (wrap (#/////analysis.Extension extension-name (list idxA valueA arrayA)))) @@ -586,21 +586,21 @@ (def: array::write::object Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list idxC valueC arrayC)) (do phase.monad [[var-id varT] (typeA.with-env check.var) _ (typeA.infer (.type (array.Array varT))) arrayA (typeA.with-type (.type (array.Array varT)) - (analyse arrayC)) + (analyse archive arrayC)) varT (typeA.with-env (check.clean varT)) arrayJT (jvm-array-type (.type (array.Array varT))) idxA (typeA.with-type ..int - (analyse idxC)) + (analyse archive idxC)) valueA (typeA.with-type varT - (analyse valueC))] + (analyse archive valueC))] (wrap (#/////analysis.Extension extension-name (list (/////analysis.text (..signature arrayJT)) idxA valueA @@ -661,7 +661,7 @@ (def: object::null Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list)) (do phase.monad @@ -674,13 +674,13 @@ (def: object::null? Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list objectC)) (do phase.monad [_ (typeA.infer Bit) [objectT objectA] (typeA.with-inference - (analyse objectC)) + (analyse archive objectC)) _ (check-object objectT)] (wrap (#/////analysis.Extension extension-name (list objectA)))) @@ -689,14 +689,14 @@ (def: object::synchronized Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list monitorC exprC)) (do phase.monad [[monitorT monitorA] (typeA.with-inference - (analyse monitorC)) + (analyse archive monitorC)) _ (check-object monitorT) - exprA (analyse exprC)] + exprA (analyse archive exprC)] (wrap (#/////analysis.Extension extension-name (list monitorA exprA)))) _ @@ -704,13 +704,13 @@ (def: object::throw Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list exceptionC)) (do phase.monad [_ (typeA.infer Nothing) [exceptionT exceptionA] (typeA.with-inference - (analyse exceptionC)) + (analyse archive exceptionC)) exception-class (check-object exceptionT) ? (phase.lift (reflection!.sub? "java.lang.Throwable" exception-class)) _ (: (Operation Any) @@ -724,7 +724,7 @@ (def: object::class Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list classC)) (case classC @@ -744,11 +744,11 @@ Handler (..custom [($_ <>.and <c>.text <c>.any) - (function (_ extension-name analyse [sub-class objectC]) + (function (_ extension-name analyse archive [sub-class objectC]) (do phase.monad [_ (typeA.infer Bit) [objectT objectA] (typeA.with-inference - (analyse objectC)) + (analyse archive objectC)) object-class (check-object objectT) ? (phase.lift (reflection!.sub? object-class sub-class))] (if ? @@ -854,14 +854,14 @@ (def: object::cast Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list fromC)) (do phase.monad [toT (///.lift macro.expected-type) to-name (:: @ map ..reflection (check-jvm toT)) [fromT fromA] (typeA.with-inference - (analyse fromC)) + (analyse archive fromC)) from-name (:: @ map ..reflection (check-jvm fromT)) can-cast? (: (Operation Bit) (`` (cond (~~ (template [<primitive> <object>] @@ -938,7 +938,7 @@ Handler (..custom [..member - (function (_ extension-name analyse [class field]) + (function (_ extension-name analyse archive [class field]) (do phase.monad [[final? fieldJT] (phase.lift (do try.monad @@ -955,7 +955,7 @@ Handler (..custom [($_ <>.and ..member <c>.any) - (function (_ extension-name analyse [[class field] valueC]) + (function (_ extension-name analyse archive [[class field] valueC]) (do phase.monad [_ (typeA.infer Any) [final? fieldJT] (phase.lift @@ -966,7 +966,7 @@ _ (phase.assert ..cannot-set-a-final-field [class field] (not final?)) valueA (typeA.with-type fieldT - (analyse valueC))] + (analyse archive valueC))] (wrap (<| (#/////analysis.Extension extension-name) (list (/////analysis.text class) (/////analysis.text field) @@ -976,10 +976,10 @@ Handler (..custom [($_ <>.and ..member <c>.any) - (function (_ extension-name analyse [[class field] objectC]) + (function (_ extension-name analyse archive [[class field] objectC]) (do phase.monad [[objectT objectA] (typeA.with-inference - (analyse objectC)) + (analyse archive objectC)) [mapping fieldJT] (phase.lift (do try.monad [class (reflection!.load class) @@ -997,10 +997,10 @@ Handler (..custom [($_ <>.and ..member <c>.any <c>.any) - (function (_ extension-name analyse [[class field] valueC objectC]) + (function (_ extension-name analyse archive [[class field] valueC objectC]) (do phase.monad [[objectT objectA] (typeA.with-inference - (analyse objectC)) + (analyse archive objectC)) _ (typeA.infer objectT) [final? mapping fieldJT] (phase.lift (do try.monad @@ -1012,7 +1012,7 @@ _ (phase.assert cannot-set-a-final-field [class field] (not final?)) valueA (typeA.with-type fieldT - (analyse valueC))] + (analyse archive valueC))] (wrap (<| (#/////analysis.Extension extension-name) (list (/////analysis.text class) (/////analysis.text field) @@ -1305,11 +1305,11 @@ Handler (..custom [($_ <>.and ..type-vars ..member ..type-vars (<>.some ..input)) - (function (_ extension-name analyse [class-tvars [class method] method-tvars argsTC]) + (function (_ extension-name analyse archive [class-tvars [class method] method-tvars argsTC]) (do phase.monad [#let [argsT (list@map product.left argsTC)] [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Static argsT) - [outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC)) + [outputT argsA] (inferenceA.general archive analyse methodT (list@map product.right argsTC)) outputJT (check-return outputT)] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) (/////analysis.text method) @@ -1320,11 +1320,11 @@ Handler (..custom [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) - (function (_ extension-name analyse [class-tvars [class method] method-tvars objectC argsTC]) + (function (_ extension-name analyse archive [class-tvars [class method] method-tvars objectC argsTC]) (do phase.monad [#let [argsT (list@map product.left argsTC)] [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Virtual argsT) - [outputT allA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC))) + [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list@map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) [objectA argsA] @@ -1342,11 +1342,11 @@ Handler (..custom [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) - (function (_ extension-name analyse [class-tvars [class method] method-tvars objectC argsTC]) + (function (_ extension-name analyse archive [class-tvars [class method] method-tvars objectC argsTC]) (do phase.monad [#let [argsT (list@map product.left argsTC)] [methodT exceptionsT] (method-candidate class-tvars class method-tvars method #Special argsT) - [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC))) + [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list@map product.right argsTC))) outputJT (check-return outputT)] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) (/////analysis.text method) @@ -1357,14 +1357,14 @@ Handler (..custom [($_ <>.and ..type-vars ..member ..type-vars <c>.any (<>.some ..input)) - (function (_ extension-name analyse [class-tvars [class-name method] method-tvars objectC argsTC]) + (function (_ extension-name analyse archive [class-tvars [class-name method] method-tvars objectC argsTC]) (do phase.monad [#let [argsT (list@map product.left argsTC)] class (phase.lift (reflection!.load class-name)) _ (phase.assert non-interface class-name (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) [methodT exceptionsT] (method-candidate class-tvars class-name method-tvars method #Interface argsT) - [outputT allA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC))) + [outputT allA] (inferenceA.general archive analyse methodT (list& objectC (list@map product.right argsTC))) #let [[objectA argsA] (case allA (#.Cons objectA argsA) [objectA argsA] @@ -1382,11 +1382,11 @@ (def: invoke::constructor (..custom [($_ <>.and ..type-vars <c>.text ..type-vars (<>.some ..input)) - (function (_ extension-name analyse [class-tvars class method-tvars argsTC]) + (function (_ extension-name analyse archive [class-tvars class method-tvars argsTC]) (do phase.monad [#let [argsT (list@map product.left argsTC)] [methodT exceptionsT] (constructor-candidate class-tvars class method-tvars argsT) - [outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC))] + [outputT argsA] (inferenceA.general archive analyse methodT (list@map product.right argsTC))] (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text (..signature (jvm.class class (list)))) (decorate-inputs argsT argsA))))))])) @@ -1570,8 +1570,8 @@ (<c>.tuple (<>.some ..input)) <c>.any))) -(def: #export (analyse-constructor-method analyse selfT mapping method) - (-> Phase .Type Mapping (Constructor Code) (Operation Analysis)) +(def: #export (analyse-constructor-method analyse archive selfT mapping method) + (-> Phase Archive .Type Mapping (Constructor Code) (Operation Analysis)) (let [[visibility strict-fp? annotations vars exceptions self-name arguments super-arguments body] method] @@ -1580,7 +1580,7 @@ (do @ [parametersA (monad.map @ (function (_ [name value]) (do @ - [valueA (analyse value)] + [valueA (analyse archive value)] (wrap [name valueA]))) parameters)] (wrap [name parametersA]))) @@ -1589,7 +1589,7 @@ (do @ [luxT (reflection-type mapping jvmT) super-argA (typeA.with-type luxT - (analyse super-argC))] + (analyse archive super-argC))] (wrap [jvmT super-argA]))) super-arguments) arguments' (monad.map @ @@ -1601,7 +1601,7 @@ [scope bodyA] (|> arguments' (#.Cons [self-name selfT]) list.reverse - (list@fold scope.with-local (analyse body)) + (list@fold scope.with-local (analyse archive body)) (typeA.with-type .Any) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..constructor-tag) @@ -1650,8 +1650,8 @@ (<c>.tuple (<>.some ..class)) <c>.any))) -(def: #export (analyse-virtual-method analyse selfT mapping method) - (-> Phase .Type Mapping (Virtual-Method Code) (Operation Analysis)) +(def: #export (analyse-virtual-method analyse archive selfT mapping method) + (-> Phase Archive .Type Mapping (Virtual-Method Code) (Operation Analysis)) (let [[method-name visibility final? strict-fp? annotations vars self-name arguments return exceptions @@ -1661,7 +1661,7 @@ (do @ [parametersA (monad.map @ (function (_ [name value]) (do @ - [valueA (analyse value)] + [valueA (analyse archive value)] (wrap [name valueA]))) parameters)] (wrap [name parametersA]))) @@ -1676,7 +1676,7 @@ [scope bodyA] (|> arguments' (#.Cons [self-name selfT]) list.reverse - (list@fold scope.with-local (analyse body)) + (list@fold scope.with-local (analyse archive body)) (typeA.with-type returnT) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..virtual-tag) @@ -1723,8 +1723,8 @@ ..return <c>.any))) -(def: #export (analyse-static-method analyse mapping method) - (-> Phase Mapping (Static-Method Code) (Operation Analysis)) +(def: #export (analyse-static-method analyse archive mapping method) + (-> Phase Archive Mapping (Static-Method Code) (Operation Analysis)) (let [[method-name visibility strict-fp? annotations vars exceptions arguments return @@ -1734,7 +1734,7 @@ (do @ [parametersA (monad.map @ (function (_ [name value]) (do @ - [valueA (analyse value)] + [valueA (analyse archive value)] (wrap [name valueA]))) parameters)] (wrap [name parametersA]))) @@ -1748,7 +1748,7 @@ arguments) [scope bodyA] (|> arguments' list.reverse - (list@fold scope.with-local (analyse body)) + (list@fold scope.with-local (analyse archive body)) (typeA.with-type returnT) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..static-tag) @@ -1797,8 +1797,8 @@ <c>.any ))) -(def: #export (analyse-overriden-method analyse selfT mapping method) - (-> Phase .Type Mapping (Overriden-Method Code) (Operation Analysis)) +(def: #export (analyse-overriden-method analyse archive selfT mapping method) + (-> Phase Archive .Type Mapping (Overriden-Method Code) (Operation Analysis)) (let [[parent-type method-name strict-fp? annotations vars self-name arguments return exceptions @@ -1808,7 +1808,7 @@ (do @ [parametersA (monad.map @ (function (_ [name value]) (do @ - [valueA (analyse value)] + [valueA (analyse archive value)] (wrap [name valueA]))) parameters)] (wrap [name parametersA]))) @@ -1823,7 +1823,7 @@ [scope bodyA] (|> arguments' (#.Cons [self-name selfT]) list.reverse - (list@fold scope.with-local (analyse body)) + (list@fold scope.with-local (analyse archive body)) (typeA.with-type returnT) /////analysis.with-scope)] (wrap (/////analysis.tuple (list (/////analysis.text ..overriden-tag) @@ -1911,11 +1911,11 @@ (<c>.tuple (<>.some ..class)) (<c>.tuple (<>.some ..input)) (<c>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name analyse [parameters - super-class - super-interfaces - constructor-args - methods]) + (function (_ extension-name analyse archive [parameters + super-class + super-interfaces + constructor-args + methods]) (do phase.monad [parameters (typeA.with-env (..parameter-types parameters)) @@ -1942,10 +1942,10 @@ (do @ [argT (reflection-type mapping type) termA (typeA.with-type argT - (analyse term))] + (analyse archive term))] (wrap [type termA]))) constructor-args) - methodsA (monad.map @ (analyse-overriden-method analyse selfT mapping) methods) + methodsA (monad.map @ (analyse-overriden-method analyse archive selfT mapping) methods) required-abstract-methods (phase.lift (all-abstract-methods (list& super-class super-interfaces))) available-methods (phase.lift (all-methods (list& super-class super-interfaces))) overriden-methods (monad.map @ (function (_ [parent-type method-name diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 5a813c253..1ae9bacf1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -31,17 +31,19 @@ ["#." analysis (#+ Analysis Operation Phase Handler Bundle) [evaluation (#+ Eval)]] [/// - ["#" phase]]]]]) + ["#" phase] + [meta + [archive (#+ Archive)]]]]]]) (def: #export (custom [syntax handler]) (All [s] (-> [(Parser s) - (-> Text Phase s (Operation Analysis))] + (-> Text Phase Archive s (Operation Analysis))] Handler)) - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case (<c>.run syntax args) (#try.Success inputs) - (handler extension-name analyse inputs) + (handler extension-name analyse archive inputs) (#try.Failure _) (////analysis.throw ///.invalid-syntax [extension-name %.code args])))) @@ -49,7 +51,7 @@ (def: (simple inputsT+ outputT) (-> (List Type) Type Handler) (let [num-expected (list.size inputsT+)] - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (let [num-actual (list.size args)] (if (n.= num-expected num-actual) (do ////.monad @@ -57,7 +59,7 @@ argsA (monad.map @ (function (_ [argT argC]) (typeA.with-type argT - (analyse argC))) + (analyse archive argC))) (list.zip2 inputsT+ args))] (wrap (#////analysis.Extension extension-name argsA))) (////analysis.throw ///.incorrect-arity [extension-name num-expected num-actual])))))) @@ -99,19 +101,19 @@ (<c>.tuple (<>.some (<>.and (<c>.tuple (<>.many ..text-char)) <c>.any))) <c>.any) - (function (_ extension-name phase [input conditionals else]) + (function (_ extension-name phase archive [input conditionals else]) (do ////.monad [input (typeA.with-type text.Char - (phase input)) + (phase archive input)) expectedT (///.lift macro.expected-type) conditionals (monad.map @ (function (_ [cases branch]) (do @ [branch (typeA.with-type expectedT - (phase branch))] + (phase archive branch))] (wrap [cases branch]))) conditionals) else (typeA.with-type expectedT - (phase else))] + (phase archive else))] (wrap (|> conditionals (list@map (function (_ [cases branch]) (////analysis.tuple @@ -123,24 +125,24 @@ ## "lux is" represents reference/pointer equality. (def: lux::is Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (do ////.monad [[var-id varT] (typeA.with-env check.var)] ((binary varT varT Bit extension-name) - analyse args)))) + analyse archive args)))) ## "lux try" provides a simple way to interact with the host platform's ## error-handling facilities. (def: lux::try Handler - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list opC)) (do ////.monad [[var-id varT] (typeA.with-env check.var) _ (typeA.infer (type (Either Text varT))) opA (typeA.with-type (type (IO varT)) - (analyse opC))] + (analyse archive opC))] (wrap (#////analysis.Extension extension-name (list opA)))) _ @@ -148,43 +150,43 @@ (def: lux::in-module Handler - (function (_ extension-name analyse argsC+) + (function (_ extension-name analyse archive argsC+) (case argsC+ (^ (list [_ (#.Text module-name)] exprC)) (////analysis.with-current-module module-name - (analyse exprC)) + (analyse archive exprC)) _ (////analysis.throw ///.invalid-syntax [extension-name %.code argsC+])))) (def: (lux::check eval) (-> Eval Handler) - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list typeC valueC)) (do ////.monad [count (///.lift macro.count) actualT (:: @ map (|>> (:coerce Type)) - (eval count Type typeC)) + (eval archive count Type typeC)) _ (typeA.infer actualT)] (typeA.with-type actualT - (analyse valueC))) + (analyse archive valueC))) _ (////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) (def: (lux::coerce eval) (-> Eval Handler) - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list typeC valueC)) (do ////.monad [count (///.lift macro.count) actualT (:: @ map (|>> (:coerce Type)) - (eval count Type typeC)) + (eval archive count Type typeC)) _ (typeA.infer actualT) [valueT valueA] (typeA.with-inference - (analyse valueC))] + (analyse archive valueC))] (wrap valueA)) _ @@ -192,13 +194,13 @@ (def: (caster input output) (-> Type Type Handler) - (function (_ extension-name analyse args) + (function (_ extension-name analyse archive args) (case args (^ (list valueC)) (do ////.monad [_ (typeA.infer output)] (typeA.with-type input - (analyse valueC))) + (analyse archive valueC))) _ (////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 3d79c84c1..b5f4c77b3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -34,41 +34,45 @@ ["#." generation] ["#." directive (#+ Import Requirements Phase Operation Handler Bundle)] [/// - ["." phase]]]]]) + ["." phase] + [meta + [archive (#+ Archive)]]]]]]) (def: #export (custom [syntax handler]) (All [anchor expression directive s] (-> [(Parser s) (-> Text (Phase anchor expression directive) + Archive s (Operation anchor expression directive Requirements))] (Handler anchor expression directive))) - (function (_ extension-name phase inputs) + (function (_ extension-name phase archive inputs) (case (s.run syntax inputs) (#try.Success inputs) - (handler extension-name phase inputs) + (handler extension-name phase archive inputs) (#try.Failure error) (phase.throw ///.invalid-syntax [extension-name %.code inputs])))) ## TODO: Inline "evaluate!'" into "evaluate!" ASAP -(def: (evaluate!' generate code//type codeS) +(def: (evaluate!' archive generate code//type codeS) (All [anchor expression directive] - (-> (/////generation.Phase anchor expression directive) + (-> Archive + (/////generation.Phase anchor expression directive) Type Synthesis (Operation anchor expression directive [Type expression Any]))) (/////directive.lift-generation (do phase.monad - [codeT (generate codeS) + [codeG (generate archive codeS) id /////generation.next - codeV (/////generation.evaluate! (format "evaluate" (%.nat id)) codeT)] - (wrap [code//type codeT codeV])))) + codeV (/////generation.evaluate! (format "evaluate" (%.nat id)) codeG)] + (wrap [code//type codeG codeV])))) -(def: #export (evaluate! type codeC) +(def: #export (evaluate! archive type codeC) (All [anchor expression directive] - (-> Type Code (Operation anchor expression directive [Type expression Any]))) + (-> Archive Type Code (Operation anchor expression directive [Type expression Any]))) (do phase.monad [state (///.lift phase.get-state) #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) @@ -78,29 +82,30 @@ (/////analysis.with-scope (typeA.with-fresh-env (typeA.with-type type - (analyse codeC))))) + (analyse archive codeC))))) codeS (/////directive.lift-synthesis - (synthesize codeA))] - (evaluate!' generate type codeS))) + (synthesize archive codeA))] + (evaluate!' archive generate type codeS))) ## TODO: Inline "definition'" into "definition" ASAP -(def: (definition' generate name code//type codeS) +(def: (definition' archive generate name code//type codeS) (All [anchor expression directive] - (-> (/////generation.Phase anchor expression directive) + (-> Archive + (/////generation.Phase anchor expression directive) Name Type Synthesis (Operation anchor expression directive [Type expression Text Any]))) (/////directive.lift-generation (do phase.monad - [codeT (generate codeS) + [codeT (generate archive codeS) [target-name value directive] (/////generation.define! name codeT) _ (/////generation.save! false name directive)] (wrap [code//type codeT target-name value])))) -(def: (definition name expected codeC) +(def: (definition archive name expected codeC) (All [anchor expression directive] - (-> Name (Maybe Type) Code + (-> Archive Name (Maybe Type) Code (Operation anchor expression directive [Type expression Text Any]))) (do phase.monad [state (///.lift phase.get-state) @@ -113,7 +118,8 @@ (case expected #.None (do @ - [[code//type codeA] (typeA.with-inference (analyse codeC)) + [[code//type codeA] (typeA.with-inference + (analyse archive codeC)) code//type (typeA.with-env (check.clean code//type))] (wrap [code//type codeA])) @@ -121,11 +127,11 @@ (#.Some expected) (do @ [codeA (typeA.with-type expected - (analyse codeC))] + (analyse archive codeC))] (wrap [expected codeA])))))) codeS (/////directive.lift-synthesis - (synthesize codeA))] - (definition' generate name code//type codeS))) + (synthesize archive codeA))] + (definition' archive generate name code//type codeS))) (def: (refresh expander host-analysis) (All [anchor expression directive] @@ -145,15 +151,15 @@ (def: (lux::def expander host-analysis) (-> Expander /////analysis.Bundle Handler) - (function (_ extension-name phase inputsC+) + (function (_ extension-name phase archive inputsC+) (case inputsC+ (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC [_ (#.Bit exported?)])) (do phase.monad [current-module (/////directive.lift-analysis (///.lift macro.current-module-name)) #let [full-name [current-module short-name]] - [type valueT valueN value] (..definition full-name #.None valueC) - [_ annotationsT annotations] (evaluate! Code annotationsC) + [type valueT valueN value] (..definition archive full-name #.None valueC) + [_ annotationsT annotations] (evaluate! archive Code annotationsC) _ (/////directive.lift-analysis (module.define short-name (#.Right [exported? type (:coerce Code annotations) value]))) #let [_ (log! (format "Definition " (%.name full-name)))] @@ -169,14 +175,14 @@ (-> Expander /////analysis.Bundle Handler) (..custom [($_ p.and s.local-identifier s.any s.any (s.tuple (p.some s.text)) s.bit) - (function (_ extension-name phase [short-name valueC annotationsC tags exported?]) + (function (_ extension-name phase archive [short-name valueC annotationsC tags exported?]) (do phase.monad [current-module (/////directive.lift-analysis (///.lift macro.current-module-name)) #let [full-name [current-module short-name]] - [_ annotationsT annotations] (evaluate! Code annotationsC) + [_ annotationsT annotations] (evaluate! archive Code annotationsC) #let [annotations (:coerce Code annotations)] - [type valueT valueN value] (..definition full-name (#.Some .Type) valueC) + [type valueT valueN value] (..definition archive full-name (#.Some .Type) valueC) _ (/////directive.lift-analysis (do phase.monad [_ (module.define short-name (#.Right [exported? type annotations value]))] @@ -197,9 +203,9 @@ Handler (..custom [($_ p.and s.any ..imports) - (function (_ extension-name phase [annotationsC imports]) + (function (_ extension-name phase archive [annotationsC imports]) (do phase.monad - [[_ annotationsT annotationsV] (evaluate! Code annotationsC) + [[_ annotationsT annotationsV] (evaluate! archive Code annotationsC) #let [annotationsV (:coerce Code annotationsV)] _ (/////directive.lift-analysis (do @ @@ -236,7 +242,7 @@ Handler (..custom [($_ p.and s.local-identifier s.identifier) - (function (_ extension-name phase [alias def-name]) + (function (_ extension-name phase archive [alias def-name]) (do phase.monad [_ (///.lift (phase.sub [(get@ [#/////directive.analysis #/////directive.state]) @@ -249,15 +255,15 @@ (All [anchor expression directive] (-> Extender (Handler anchor expression directive))) - (function (handler extension-name phase inputsC+) + (function (handler extension-name phase archive inputsC+) (case inputsC+ (^ (list nameC valueC)) (do phase.monad - [[_ _ name] (evaluate! Text nameC) - [_ _ handlerV] (evaluate! (:by-example [anchor expression directive] - {(Handler anchor expression directive) - handler} - <type>) + [[_ _ name] (evaluate! archive Text nameC) + [_ _ handlerV] (evaluate! archive (:by-example [anchor expression directive] + {(Handler anchor expression directive) + handler} + <type>) valueC) _ (<| <scope> (///.install extender (:coerce Text name)) @@ -281,9 +287,10 @@ ## TODO; Both "prepare-program" and "define-program" exist only ## because the old compiler couldn"t handle a fully-inlined definition ## for "def::program". Inline them ASAP. -(def: (prepare-program analyse synthesize programC) +(def: (prepare-program archive analyse synthesize programC) (All [anchor expression directive output] - (-> /////analysis.Phase + (-> Archive + /////analysis.Phase /////synthesis.Phase Code (Operation anchor expression directive Synthesis))) @@ -292,24 +299,25 @@ (/////analysis.with-scope (typeA.with-fresh-env (typeA.with-type (type (-> (List Text) (IO Any))) - (analyse programC)))))] + (analyse archive programC)))))] (/////directive.lift-synthesis - (synthesize programA)))) + (synthesize archive programA)))) -(def: (define-program generate program programS) +(def: (define-program archive generate program programS) (All [anchor expression directive output] - (-> (/////generation.Phase anchor expression directive) + (-> Archive + (/////generation.Phase anchor expression directive) (-> expression directive) Synthesis (/////generation.Operation anchor expression directive Any))) (do phase.monad - [programG (generate programS)] + [programG (generate archive programS)] (/////generation.save! false ["" ""] (program programG)))) (def: (def::program program) (All [anchor expression directive] (-> (-> expression directive) (Handler anchor expression directive))) - (function (handler extension-name phase inputsC+) + (function (handler extension-name phase archive inputsC+) (case inputsC+ (^ (list programC)) (do phase.monad @@ -317,9 +325,9 @@ #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - programS (prepare-program analyse synthesize programC) + programS (prepare-program archive analyse synthesize programC) _ (/////directive.lift-generation - (define-program generate program programS))] + (define-program archive generate program programS))] (wrap /////directive.no-requirements)) _ diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 966815a29..880ada9a2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -24,7 +24,7 @@ [extension (#+ Nullary Unary Binary Trinary nullary unary binary trinary)] ["//" js #_ - ["#." runtime (#+ Operation Phase Handler Bundle)] + ["#." runtime (#+ Operation Phase Handler Bundle Generator)] ["#." primitive]]] [// [synthesis (#+ %synthesis)] @@ -34,12 +34,12 @@ (def: #export (custom [parser handler]) (All [s] (-> [(Parser s) - (-> Text Phase s (Operation Expression))] + (-> Text (Generator s))] Handler)) - (function (_ extension-name phase input) + (function (_ extension-name phase archive input) (case (<s>.run parser input) (#try.Success input') - (handler extension-name phase input') + (handler extension-name phase archive input') (#try.Failure error) (/////.throw extension.invalid-syntax [extension-name %synthesis input])))) @@ -132,15 +132,15 @@ (<>.some (<s>.tuple ($_ <>.and (<s>.tuple (<>.many <s>.i64)) <s>.any)))) - (function (_ extension-name phase [input else conditionals]) + (function (_ extension-name phase archive [input else conditionals]) (do /////.monad - [inputG (phase input) - elseG (phase else) + [inputG (phase archive input) + elseG (phase archive else) conditionalsG (: (Operation (List [(List Literal) Statement])) (monad.map @ (function (_ [chars branch]) (do @ - [branchG (phase branch)] + [branchG (phase archive branch)] (wrap [(list@map (|>> .int _.int) chars) (_.return branchG)]))) conditionals))] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index 592446e93..1f526a0a8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -60,29 +60,29 @@ (def: object::new (custom [($_ <>.and <s>.any (<>.some <s>.any)) - (function (_ extension phase [constructorS inputsS]) + (function (_ extension phase archive [constructorS inputsS]) (do ////////phase.monad - [constructorG (phase constructorS) - inputsG (monad.map @ phase inputsS)] + [constructorG (phase archive constructorS) + inputsG (monad.map @ (phase archive) inputsS)] (wrap (_.new constructorG inputsG))))])) (def: object::get Handler (custom [($_ <>.and <s>.text <s>.any) - (function (_ extension phase [fieldS objectS]) + (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad - [objectG (phase objectS)] + [objectG (phase archive objectS)] (wrap (_.the fieldS objectG))))])) (def: object::do Handler (custom [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) - (function (_ extension phase [methodS objectS inputsS]) + (function (_ extension phase archive [methodS objectS inputsS]) (do ////////phase.monad - [objectG (phase objectS) - inputsG (monad.map @ phase inputsS)] + [objectG (phase archive objectS) + inputsG (monad.map @ (phase archive) inputsS)] (wrap (_.do methodS inputsG objectG))))])) (template [<!> <?> <unit>] @@ -109,7 +109,7 @@ (def: js::constant (custom [<s>.text - (function (_ extension phase name) + (function (_ extension phase archive name) (do ////////phase.monad [] (wrap (_.var name))))])) @@ -117,10 +117,10 @@ (def: js::apply (custom [($_ <>.and <s>.any (<>.some <s>.any)) - (function (_ extension phase [abstractionS inputsS]) + (function (_ extension phase archive [abstractionS inputsS]) (do ////////phase.monad - [abstractionG (phase abstractionS) - inputsG (monad.map @ phase inputsS)] + [abstractionG (phase archive abstractionS) + inputsG (monad.map @ (phase archive) inputsS)] (wrap (_.apply/* abstractionG inputsG))))])) (def: #export bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 8bfdb9193..f4db9b89a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -38,17 +38,19 @@ [// ["/#." synthesis (#+ Synthesis %synthesis)] [/// - ["#" phase]]]]) + ["#" phase] + [meta + [archive (#+ Archive)]]]]]) (def: #export (custom [parser handler]) (All [s] (-> [(Parser s) - (-> Text Phase s (Operation (Bytecode Any)))] + (-> Text Phase Archive s (Operation (Bytecode Any)))] Handler)) - (function (_ extension-name phase input) + (function (_ extension-name phase archive input) (case (<s>.run parser input) (#try.Success input') - (handler extension-name phase input') + (handler extension-name phase archive input') (#try.Failure error) (/////.throw /////extension.invalid-syntax [extension-name //////synthesis.%synthesis input])))) @@ -102,16 +104,16 @@ (<>.some (<s>.tuple ($_ <>.and (<s>.tuple (<>.many <s>.i64)) <s>.any)))) - (function (_ extension-name phase [inputS elseS conditionalsS]) + (function (_ extension-name phase archive [inputS elseS conditionalsS]) (do /////.monad [@end ///runtime.forge-label - inputG (phase inputS) - elseG (phase elseS) + inputG (phase archive inputS) + elseG (phase archive elseS) conditionalsG+ (: (Operation (List [(List [S4 Label]) (Bytecode Any)])) (monad.map @ (function (_ [chars branch]) (do @ - [branchG (phase branch) + [branchG (phase archive branch) @branch ///runtime.forge-label] (wrap [(list@map (function (_ char) [(try.assume (signed.s4 (.int char))) @branch]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index b1c55f555..3e3daa995 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -46,7 +46,7 @@ [extension (#+ Nullary Unary Binary Trinary Variadic nullary unary binary trinary variadic)] ["///" jvm - [runtime (#+ Operation Bundle Handler)] + [runtime (#+ Operation Bundle Phase Handler)] ["#." reference] [function [field @@ -62,7 +62,9 @@ ["#." generation] [/// ["#" phase] - ["#." reference (#+ Variable)]]]]]) + ["#." reference (#+ Variable)] + [meta + [archive (#+ Archive)]]]]]]) (template [<name> <0> <1>] [(def: <name> @@ -349,9 +351,9 @@ (-> (Type Primitive) Handler) (..custom [<s>.any - (function (_ extension-name generate arrayS) + (function (_ extension-name generate archive arrayS) (do //////.monad - [arrayG (generate arrayS)] + [arrayG (generate archive arrayS)] (wrap ($_ _.compose arrayG (_.checkcast (type.array jvm-primitive)) @@ -361,9 +363,9 @@ Handler (..custom [($_ <>.and ..object-array <s>.any) - (function (_ extension-name generate [elementJT arrayS]) + (function (_ extension-name generate archive [elementJT arrayS]) (do //////.monad - [arrayG (generate arrayS)] + [arrayG (generate archive arrayS)] (wrap ($_ _.compose arrayG (_.checkcast (type.array elementJT)) @@ -373,9 +375,9 @@ (-> Primitive-Array-Type Handler) (..custom [<s>.any - (function (_ extension-name generate [lengthS]) + (function (_ extension-name generate archive [lengthS]) (do //////.monad - [lengthG (generate lengthS)] + [lengthG (generate archive lengthS)] (wrap ($_ _.compose lengthG (_.newarray jvm-primitive)))))])) @@ -384,9 +386,9 @@ Handler (..custom [($_ <>.and ..object <s>.any) - (function (_ extension-name generate [objectJT lengthS]) + (function (_ extension-name generate archive [objectJT lengthS]) (do //////.monad - [lengthG (generate lengthS)] + [lengthG (generate archive lengthS)] (wrap ($_ _.compose lengthG (_.anewarray objectJT)))))])) @@ -395,10 +397,10 @@ (-> (Type Primitive) (Bytecode Any) Handler) (..custom [($_ <>.and <s>.any <s>.any) - (function (_ extension-name generate [idxS arrayS]) + (function (_ extension-name generate archive [idxS arrayS]) (do //////.monad - [arrayG (generate arrayS) - idxG (generate idxS)] + [arrayG (generate archive arrayS) + idxG (generate archive idxS)] (wrap ($_ _.compose arrayG (_.checkcast (type.array jvm-primitive)) @@ -409,10 +411,10 @@ Handler (..custom [($_ <>.and ..object-array <s>.any <s>.any) - (function (_ extension-name generate [elementJT idxS arrayS]) + (function (_ extension-name generate archive [elementJT idxS arrayS]) (do //////.monad - [arrayG (generate arrayS) - idxG (generate idxS)] + [arrayG (generate archive arrayS) + idxG (generate archive idxS)] (wrap ($_ _.compose arrayG (_.checkcast (type.array elementJT)) @@ -423,11 +425,11 @@ (-> (Type Primitive) (Bytecode Any) Handler) (..custom [($_ <>.and <s>.any <s>.any <s>.any) - (function (_ extension-name generate [idxS valueS arrayS]) + (function (_ extension-name generate archive [idxS valueS arrayS]) (do //////.monad - [arrayG (generate arrayS) - idxG (generate idxS) - valueG (generate valueS)] + [arrayG (generate archive arrayS) + idxG (generate archive idxS) + valueG (generate archive valueS)] (wrap ($_ _.compose arrayG (_.checkcast (type.array jvm-primitive)) @@ -440,11 +442,11 @@ Handler (..custom [($_ <>.and ..object-array <s>.any <s>.any <s>.any) - (function (_ extension-name generate [elementJT idxS valueS arrayS]) + (function (_ extension-name generate archive [elementJT idxS valueS arrayS]) (do //////.monad - [arrayG (generate arrayS) - idxG (generate idxS) - valueG (generate valueS)] + [arrayG (generate archive arrayS) + idxG (generate archive idxS) + valueG (generate archive valueS)] (wrap ($_ _.compose arrayG (_.checkcast (type.array elementJT)) @@ -544,7 +546,7 @@ Handler (..custom [<s>.text - (function (_ extension-name generate [class]) + (function (_ extension-name generate archive [class]) (do //////.monad [] (wrap ($_ _.compose @@ -555,9 +557,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.any) - (function (_ extension-name generate [class objectS]) + (function (_ extension-name generate archive [class objectS]) (do //////.monad - [objectG (generate objectS)] + [objectG (generate archive objectS)] (wrap ($_ _.compose objectG (_.instanceof (type.class class (list))) @@ -572,9 +574,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.any) - (function (_ extension-name generate [from to valueS]) + (function (_ extension-name generate archive [from to valueS]) (do //////.monad - [valueG (generate valueS)] + [valueG (generate archive valueS)] (wrap (`` (cond (~~ (template [<object> <type> <unwrap>] [(and (text@= (..reflection <type>) from) @@ -635,7 +637,7 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text) - (function (_ extension-name generate [class field unboxed]) + (function (_ extension-name generate archive [class field unboxed]) (do //////.monad [#let [$class (type.class class (list))]] (case (dictionary.get unboxed ..primitives) @@ -651,9 +653,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate [class field unboxed valueS]) + (function (_ extension-name generate archive [class field unboxed valueS]) (do //////.monad - [valueG (generate valueS) + [valueG (generate archive valueS) #let [$class (type.class class (list))]] (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -673,9 +675,9 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate [class field unboxed objectS]) + (function (_ extension-name generate archive [class field unboxed objectS]) (do //////.monad - [objectG (generate objectS) + [objectG (generate archive objectS) #let [$class (type.class class (list)) getG (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -692,10 +694,10 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any) - (function (_ extension-name generate [class field unboxed valueS objectS]) + (function (_ extension-name generate archive [class field unboxed valueS objectS]) (do //////.monad - [valueG (generate valueS) - objectG (generate objectS) + [valueG (generate archive valueS) + objectG (generate archive objectS) #let [$class (type.class class (list)) putG (case (dictionary.get unboxed ..primitives) (#.Some primitive) @@ -719,11 +721,10 @@ (Parser Input) (<s>.tuple (<>.and ..value <s>.any))) -(def: (generate-input generate [valueT valueS]) - (-> (-> Synthesis (Operation (Bytecode Any))) Input - (Operation (Typed (Bytecode Any)))) +(def: (generate-input generate archive [valueT valueS]) + (-> Phase Archive Input (Operation (Typed (Bytecode Any)))) (do //////.monad - [valueG (generate valueS)] + [valueG (generate archive valueS)] (case (type.primitive? valueT) (#.Right valueT) (wrap [valueT valueG]) @@ -746,9 +747,9 @@ Handler (..custom [($_ <>.and ..class <s>.text ..return (<>.some ..input)) - (function (_ extension-name generate [class method outputT inputsTS]) + (function (_ extension-name generate archive [class method outputT inputsTS]) (do //////.monad - [inputsTG (monad.map @ (generate-input generate) inputsTS)] + [inputsTG (monad.map @ (generate-input generate archive) inputsTS)] (wrap ($_ _.compose (monad.map _.monad product.right inputsTG) (_.invokestatic class method (type.method [(list@map product.left inputsTG) outputT (list)])) @@ -759,10 +760,10 @@ Handler (..custom [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) - (function (_ extension-name generate [class method outputT objectS inputsTS]) + (function (_ extension-name generate archive [class method outputT objectS inputsTS]) (do //////.monad - [objectG (generate objectS) - inputsTG (monad.map @ (generate-input generate) inputsTS)] + [objectG (generate archive objectS) + inputsTG (monad.map @ (generate-input generate archive) inputsTS)] (wrap ($_ _.compose objectG (_.checkcast class) @@ -779,9 +780,9 @@ Handler (..custom [($_ <>.and ..class (<>.some ..input)) - (function (_ extension-name generate [class inputsTS]) + (function (_ extension-name generate archive [class inputsTS]) (do //////.monad - [inputsTG (monad.map @ (generate-input generate) inputsTS)] + [inputsTG (monad.map @ (generate-input generate archive) inputsTS)] (wrap ($_ _.compose (_.new class) _.dup @@ -991,10 +992,10 @@ (<s>.tuple (<>.some ..class)) (<s>.tuple (<>.some ..input)) (<s>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name generate [class-name - super-class super-interfaces - inputsTS - overriden-methods]) + (function (_ extension-name generate archive [class-name + super-class super-interfaces + inputsTS + overriden-methods]) (do //////.monad [#let [class (type.class class-name (list)) total-environment (|> overriden-methods @@ -1029,14 +1030,14 @@ self-name arguments returnT exceptionsT (normalize-method-body local-mapping body)])) overriden-methods)] - inputsTI (monad.map @ (generate-input generate) inputsTS) + inputsTI (monad.map @ (generate-input generate archive) inputsTS) method-definitions (monad.map @ (function (_ [ownerT name strict-fp? annotations vars self-name arguments returnT exceptionsT bodyS]) (do @ [bodyG (//////generation.with-specific-context class-name - (generate bodyS))] + (generate archive bodyS))] (wrap (method.method ($_ modifier@compose method.public method.final diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby.lux new file mode 100644 index 000000000..8b1b94bbb --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + ["." / #_ + ["#." common] + [//// + [generation + [ruby + [runtime (#+ Bundle)]]]]]) + +(def: #export bundle + Bundle + /common.bundle) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux new file mode 100644 index 000000000..b7131e02b --- /dev/null +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -0,0 +1,161 @@ +(.module: + [lux #* + [host (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + ["." product] + ["." text] + [number + ["f" frac]] + [collection + ["." dictionary]]] + [target + ["_" ruby (#+ Expression)]]] + [//// + ["/" bundle] + [// + [generation + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + ["//" ruby #_ + ["#." runtime (#+ Operation Phase Handler Bundle)]]]]]) + +(def: lux-procs + Bundle + (|> /.empty + (/.install "is" (binary (product.uncurry _.=))) + (/.install "try" (unary //runtime.lux//try)))) + +(def: keep-i64 + (All [input] + (-> (-> input (Expression Any)) + (-> input (Expression Any)))) + (function.compose (_.bit-and (_.manual "0xFFFFFFFFFFFFFFFF")))) + +(def: i64-procs + Bundle + (<| (/.prefix "i64") + (|> /.empty + (/.install "and" (binary (product.uncurry _.bit-and))) + (/.install "or" (binary (product.uncurry _.bit-or))) + (/.install "xor" (binary (product.uncurry _.bit-xor))) + (/.install "left-shift" (binary (..keep-i64 (product.uncurry _.bit-shl)))) + (/.install "logical-right-shift" (binary (product.uncurry //runtime.i64//logic-right-shift))) + (/.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) + (/.install "=" (binary (product.uncurry _.=))) + (/.install "+" (binary (..keep-i64 (product.uncurry _.+)))) + (/.install "-" (binary (..keep-i64 (product.uncurry _.-)))) + ))) + +(import: #long java/lang/Double + (#static MIN_VALUE double) + (#static MAX_VALUE double)) + +(template [<name> <const>] + [(def: (<name> _) + (Nullary (Expression Any)) + (_.float <const>))] + + [frac//smallest (java/lang/Double::MIN_VALUE)] + [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//max (java/lang/Double::MAX_VALUE)] + ) + +(def: int-procs + Bundle + (<| (/.prefix "int") + (|> /.empty + (/.install "<" (binary (product.uncurry _.<))) + (/.install "*" (binary (..keep-i64 (product.uncurry _.*)))) + (/.install "/" (binary (product.uncurry _./))) + (/.install "%" (binary (product.uncurry _.%))) + (/.install "frac" (unary (_./ (_.float +1.0)))) + (/.install "char" (unary (_.do "chr" (list))))))) + +(def: frac-procs + Bundle + (<| (/.prefix "frac") + (|> /.empty + (/.install "+" (binary (product.uncurry _.+))) + (/.install "-" (binary (product.uncurry _.-))) + (/.install "*" (binary (product.uncurry _.*))) + (/.install "/" (binary (product.uncurry _./))) + (/.install "%" (binary (product.uncurry _.%))) + (/.install "=" (binary (product.uncurry _.=))) + (/.install "<" (binary (product.uncurry _.<))) + (/.install "smallest" (nullary frac//smallest)) + (/.install "min" (nullary frac//min)) + (/.install "max" (nullary frac//max)) + (/.install "int" (unary (_.do "floor" (list)))) + (/.install "encode" (unary (_.do "to_s" (list)))) + (/.install "decode" (unary //runtime.f64//decode))))) + +(def: (text//char [subjectO paramO]) + (Binary (Expression Any)) + (//runtime.text//char subjectO paramO)) + +(def: (text//clip [paramO extraO subjectO]) + (Trinary (Expression Any)) + (//runtime.text//clip subjectO paramO extraO)) + +(def: (text//index [startO partO textO]) + (Trinary (Expression Any)) + (//runtime.text//index textO partO startO)) + +(def: text-procs + Bundle + (<| (/.prefix "text") + (|> /.empty + (/.install "=" (binary (product.uncurry _.=))) + (/.install "<" (binary (product.uncurry _.<))) + (/.install "concat" (binary (product.uncurry _.+))) + (/.install "index" (trinary text//index)) + (/.install "size" (unary (_.the "length"))) + (/.install "char" (binary (product.uncurry //runtime.text//char))) + (/.install "clip" (trinary text//clip)) + ))) + +(def: (io//log! messageG) + (Unary (Expression Any)) + (_.or (_.apply/* (list (|> messageG (_.+ (_.string text.new-line)))) + (_.local "puts")) + //runtime.unit)) + +(def: io//error! + (Unary (Expression Any)) + _.raise) + +(def: (io//exit! code) + (Unary (Expression Any)) + (_.apply/* (list code) (_.local "exit"))) + +(def: (io//current-time! _) + (Nullary (Expression Any)) + (|> (_.local "Time") + (_.do "now" (list)) + (_.do "to_f" (list)) + (_.* (_.float +1000.0)) + (_.do "to_i" (list)))) + +(def: io-procs + Bundle + (<| (/.prefix "io") + (|> /.empty + (/.install "log" (unary ..io//log!)) + (/.install "error" (unary ..io//error!)) + (/.install "exit" (unary ..io//exit!)) + (/.install "current-time" (nullary ..io//current-time!))))) + +(def: #export bundle + Bundle + (<| (/.prefix "lux") + (|> lux-procs + (dictionary.merge ..i64-procs) + (dictionary.merge ..int-procs) + (dictionary.merge ..frac-procs) + (dictionary.merge ..text-procs) + (dictionary.merge ..io-procs) + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux index 2847fa805..79b2f5ea3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -29,19 +29,20 @@ (type: #export (Variadic of) (-> (List of) of)) (syntax: (arity: {arity s.nat} {name s.local-identifier} type) - (with-gensyms [g!_ g!extension g!name g!phase g!inputs g!of g!anchor g!expression g!directive] + (with-gensyms [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) (All [(~ g!anchor) (~ g!expression) (~ g!directive)] - (-> ((~ type) (~ g!expression)) (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) - (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) + (-> ((~ type) (~ g!expression)) + (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) + (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) (do ///.monad [(~+ (|> g!input+ (list@map (function (_ g!input) - (list g!input (` ((~ g!phase) (~ g!input)))))) + (list g!input (` ((~ g!phase) (~ g!archive) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) @@ -57,7 +58,7 @@ (All [anchor expression directive] (-> (Variadic expression) (generation.Handler anchor expression directive))) (function (_ extension-name) - (function (_ phase inputsS) + (function (_ phase archive inputsS) (do ///.monad - [inputsI (monad.map @ phase inputsS)] + [inputsI (monad.map @ (phase archive) inputsS)] (wrap (extension inputsI)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux index ebfbda2a0..c1970c013 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux @@ -18,7 +18,7 @@ ["//#" /// #_ ["#." phase ("#@." monad)]]]]]) -(def: #export (generate synthesis) +(def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] @@ -30,35 +30,35 @@ [synthesis.text /primitive.text]) (^ (synthesis.variant variantS)) - (/structure.variant generate variantS) + (/structure.variant generate archive variantS) (^ (synthesis.tuple members)) - (/structure.tuple generate members) + (/structure.tuple generate archive members) (#synthesis.Reference value) (/reference@reference value) (^ (synthesis.branch/case case)) - (/case.case generate case) + (/case.case generate archive case) (^ (synthesis.branch/let let)) - (/case.let generate let) + (/case.let generate archive let) (^ (synthesis.branch/if if)) - (/case.if generate if) + (/case.if generate archive if) (^ (synthesis.loop/scope scope)) - (/loop.scope generate scope) + (/loop.scope generate archive scope) (^ (synthesis.loop/recur updates)) - (/loop.recur generate updates) + (/loop.recur generate archive updates) (^ (synthesis.function/abstraction abstraction)) - (/function.function generate abstraction) + (/function.function generate archive abstraction) (^ (synthesis.function/apply application)) - (/function.apply generate application) + (/function.apply generate archive application) (#synthesis.Extension extension) - (extension.apply generate extension) + (extension.apply archive generate extension) )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux index 79b63ba13..2be5ac6cd 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -13,7 +13,7 @@ [target ["_" js (#+ Expression Computation Var Statement)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." reference] ["#." primitive] ["/#" // #_ @@ -25,27 +25,27 @@ ["#." synthesis (#+ Synthesis Path)] ["//#" /// #_ [reference (#+ Register)] - ["#." phase ("#@." monad)]]]]]]) + ["#." phase ("#@." monad)] + [meta + [archive (#+ Archive)]]]]]]]) (def: #export register (///reference.local _.var)) -(def: #export (let generate [valueS register bodyS]) - (-> Phase [Synthesis Register Synthesis] - (Operation Computation)) +(def: #export (let generate archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) (do ///////phase.monad - [valueO (generate valueS) - bodyO (generate bodyS)] + [valueO (generate archive valueS) + bodyO (generate archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. (wrap (_.apply/* (_.closure (list (..register register)) (_.return bodyO)) (list valueO))))) -(def: #export (record-get generate valueS pathP) - (-> Phase Synthesis (List (Either Nat Nat)) - (Operation Expression)) +(def: #export (record-get generate archive [valueS pathP]) + (Generator [Synthesis (List (Either Nat Nat))]) (do ///////phase.monad - [valueO (generate valueS)] + [valueO (generate archive valueS)] (wrap (list@fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -57,13 +57,12 @@ valueO pathP)))) -(def: #export (if generate [testS thenS elseS]) - (-> Phase [Synthesis Synthesis Synthesis] - (Operation Computation)) +(def: #export (if generate archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) (do ///////phase.monad - [testO (generate testS) - thenO (generate thenS) - elseO (generate elseS)] + [testO (generate archive testS) + thenO (generate archive thenS) + elseO (generate archive elseS)] (wrap (_.? testO thenO elseO)))) (def: @savepoint (_.var "lux_pm_cursor_savepoint")) @@ -136,12 +135,12 @@ ..restore-cursor! post!))) -(def: (pattern-matching' generate pathP) - (-> Phase Path (Operation Statement)) +(def: (pattern-matching' generate archive pathP) + (-> Phase Archive Path (Operation Statement)) (.case pathP (^ (/////synthesis.path/then bodyS)) (do ///////phase.monad - [body! (generate bodyS)] + [body! (generate archive bodyS)] (wrap (_.return body!))) #/////synthesis.Pop @@ -165,7 +164,7 @@ (^ (<simple> idx nextP)) (|> nextP - (pattern-matching' generate) + (pattern-matching' generate archive) (:: ///////phase.monad map (_.then (<choice> true idx))))) ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) @@ -178,7 +177,7 @@ (/////synthesis.member/left 0) (/////synthesis.!bind-top register thenP))) (do ///////phase.monad - [then! (pattern-matching' generate thenP)] + [then! (pattern-matching' generate archive thenP)] (///////phase@wrap ($_ _.then (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor)) then!))) @@ -192,7 +191,7 @@ (<pm> lefts) (/////synthesis.!bind-top register thenP))) (do ///////phase.monad - [then! (pattern-matching' generate thenP)] + [then! (pattern-matching' generate archive thenP)] (///////phase@wrap ($_ _.then (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor)) then!)))) @@ -201,7 +200,7 @@ (^ (/////synthesis.!bind-top register thenP)) (do ///////phase.monad - [then! (pattern-matching' generate thenP)] + [then! (pattern-matching' generate archive thenP)] (///////phase@wrap ($_ _.then (_.define (..register register) ..peek-and-pop-cursor) then!))) @@ -209,7 +208,7 @@ (^ (/////synthesis.!multi-pop nextP)) (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)] (do ///////phase.monad - [next! (pattern-matching' generate nextP')] + [next! (pattern-matching' generate archive nextP')] (///////phase@wrap ($_ _.then (multi-pop-cursor! (n.+ 2 extra-pops)) next!)))) @@ -217,26 +216,26 @@ (^template [<tag> <combinator>] (^ (<tag> leftP rightP)) (do ///////phase.monad - [left! (pattern-matching' generate leftP) - right! (pattern-matching' generate rightP)] + [left! (pattern-matching' generate archive leftP) + right! (pattern-matching' generate archive rightP)] (wrap (<combinator> left! right!)))) ([/////synthesis.path/seq _.then] [/////synthesis.path/alt alternation]))) -(def: (pattern-matching generate pathP) - (-> Phase Path (Operation Statement)) +(def: (pattern-matching generate archive pathP) + (-> Phase Archive Path (Operation Statement)) (do ///////phase.monad - [pattern-matching! (pattern-matching' generate pathP)] + [pattern-matching! (pattern-matching' generate archive pathP)] (wrap ($_ _.then (_.do-while (_.boolean false) pattern-matching!) (_.throw (_.string ////synthesis/case.pattern-matching-error)))))) -(def: #export (case generate [valueS pathP]) - (-> Phase [Synthesis Path] (Operation Computation)) +(def: #export (case generate archive [valueS pathP]) + (Generator [Synthesis Path]) (do ///////phase.monad - [stack-init (generate valueS) - path! (pattern-matching generate pathP) + [stack-init (generate archive valueS) + path! (pattern-matching generate archive pathP) #let [closure (<| (_.closure (list)) ($_ _.then (_.declare @temp) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 75399ef04..cf2f4db68 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -11,7 +11,7 @@ [target ["_" js (#+ Expression Computation Var)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Generator)] ["#." reference] ["#." case] ["/#" // #_ @@ -25,11 +25,11 @@ [reference (#+ Register Variable)] ["#." phase ("#@." monad)]]]]]) -(def: #export (apply generate [functionS argsS+]) - (-> Phase (Application Synthesis) (Operation Computation)) +(def: #export (apply generate archive [functionS argsS+]) + (Generator (Application Synthesis)) (do ///////phase.monad - [functionO (generate functionS) - argsO+ (monad.map @ generate argsS+)] + [functionO (generate archive functionS) + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) (def: (with-closure inits function-definition) @@ -53,14 +53,14 @@ (def: @@arguments (_.var "arguments")) -(def: #export (function generate [environment arity bodyS]) - (-> Phase (Abstraction Synthesis) (Operation Computation)) +(def: #export (function generate archive [environment arity bodyS]) + (Generator (Abstraction Synthesis)) (do ///////phase.monad [[function-name bodyO] (/////generation.with-context (do @ [function-name /////generation.context] (/////generation.with-anchor (_.var function-name) - (generate bodyS)))) + (generate archive bodyS)))) #let [capture (:: //reference.system variable)] closureO+ (: (Operation (List Expression)) (monad.map @ capture environment)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index 3479de19b..53b0a3f19 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux @@ -12,7 +12,7 @@ [target ["_" js (#+ Computation Var)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Generator)] ["#." case] ["///#" //// #_ [synthesis (#+ Scope Synthesis)] @@ -22,12 +22,12 @@ (def: @scope (_.var "scope")) -(def: #export (scope generate [start initsS+ bodyS]) - (-> Phase (Scope Synthesis) (Operation Computation)) +(def: #export (scope generate archive [start initsS+ bodyS]) + (Generator (Scope Synthesis)) (do ///////phase.monad - [initsO+ (monad.map @ generate initsS+) + [initsO+ (monad.map @ (generate archive) initsS+) bodyO (/////generation.with-anchor @scope - (generate bodyS)) + (generate archive bodyS)) #let [closure (_.function @scope (|> initsS+ list.enumerate @@ -35,9 +35,9 @@ (_.return bodyO))]] (wrap (_.apply/* closure initsO+)))) -(def: #export (recur generate argsS+) - (-> Phase (List Synthesis) (Operation Computation)) +(def: #export (recur generate archive argsS+) + (Generator (List Synthesis)) (do ///////phase.monad [@scope /////generation.anchor - argsO+ (monad.map @ generate argsS+)] + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 1c1b7379d..fb197118a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -23,7 +23,9 @@ ["#." generation] ["//#" /// #_ ["#." phase] - ["#." name]]] + ["#." name] + [meta + [archive (#+ Archive)]]]] ) (template [<name> <base>] @@ -37,7 +39,7 @@ ) (type: #export (Generator i) - (-> i Phase (Operation Expression))) + (-> Phase Archive i (Operation Expression))) (def: prefix Text "LuxRuntime") diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux index a1f05d050..aaea204bc 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux @@ -5,7 +5,7 @@ [target ["_" js (#+ Expression)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] ["///#" //// #_ [analysis (#+ Variant Tuple)] @@ -15,25 +15,25 @@ (def: unit Expression (//primitive.text /////synthesis.unit)) -(def: #export (tuple generate elemsS+) - (-> Phase (Tuple Synthesis) (Operation Expression)) +(def: #export (tuple generate archive elemsS+) + (Generator (Tuple Synthesis)) (case elemsS+ #.Nil (///////phase@wrap ..unit) (#.Cons singletonS #.Nil) - (generate singletonS) + (generate archive singletonS) _ (do ///////phase.monad - [elemsT+ (monad.map @ generate elemsS+)] + [elemsT+ (monad.map @ (generate archive) elemsS+)] (wrap (_.array elemsT+))))) -(def: #export (variant generate [lefts right? valueS]) - (-> Phase (Variant Synthesis) (Operation Expression)) +(def: #export (variant generate archive [lefts right? valueS]) + (Generator (Variant Synthesis)) (let [tag (if right? (inc lefts) lefts)] (///////phase@map (//runtime.variant (_.i32 (.int tag)) (//runtime.flag right?)) - (generate valueS)))) + (generate archive valueS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux index a5a9c9141..019714867 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux @@ -17,24 +17,24 @@ ["." synthesis] [/// ["." reference] - ["#" phase]]]]]) + ["#" phase ("#@." monad)]]]]]) -(def: #export (generate synthesis) +(def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] (^ (<tag> value)) - (:: ///.monad wrap (<generator> value))) + (///@wrap (<generator> value))) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] [synthesis.text /primitive.text]) (^ (synthesis.variant variantS)) - (/structure.variant generate variantS) + (/structure.variant generate archive variantS) (^ (synthesis.tuple members)) - (/structure.tuple generate members) + (/structure.tuple generate archive members) (#synthesis.Reference reference) (case reference @@ -45,26 +45,26 @@ (/reference.constant constant)) (^ (synthesis.branch/case [valueS pathS])) - (/case.case generate valueS pathS) + (/case.case generate archive [valueS pathS]) (^ (synthesis.branch/let [inputS register bodyS])) - (/case.let generate inputS register bodyS) + (/case.let generate archive [inputS register bodyS]) (^ (synthesis.branch/if [conditionS thenS elseS])) - (/case.if generate conditionS thenS elseS) + (/case.if generate archive [conditionS thenS elseS]) (^ (synthesis.loop/scope scope)) - (/loop.scope generate scope) + (/loop.scope generate archive scope) (^ (synthesis.loop/recur updates)) - (/loop.recur generate updates) + (/loop.recur generate archive updates) (^ (synthesis.function/abstraction abstraction)) - (/function.abstraction generate abstraction) + (/function.abstraction generate archive abstraction) (^ (synthesis.function/apply application)) - (/function.apply generate application) + (/function.apply generate archive application) (#synthesis.Extension extension) - (///extension.apply generate extension) + (///extension.apply archive generate extension) )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index 244614688..9abfe1f55 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -15,7 +15,7 @@ [category (#+ Method)]]]]] ["." // #_ ["#." type] - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." value] [//// ["." synthesis (#+ Path Synthesis)] @@ -65,8 +65,8 @@ (//runtime.get //runtime.stack-tail) (_.checkcast //type.stack))) -(def: (path' phase stack-depth @else @end path) - (-> Phase Nat Label Label Path (Operation (Bytecode Any))) +(def: (path' stack-depth @else @end phase archive path) + (-> Nat Label Label (Generator Path)) (.case path #synthesis.Pop (operation@wrap ..pop) @@ -108,7 +108,7 @@ (#synthesis.Then bodyS) (do phase.monad - [bodyG (phase bodyS)] + [bodyG (phase archive bodyS)] (wrap ($_ _.compose (..pop-alt stack-depth) bodyG @@ -164,7 +164,7 @@ (synthesis.member/left 0) (synthesis.!bind-top register thenP))) (do phase.monad - [thenG (path' phase stack-depth @else @end thenP)] + [thenG (path' stack-depth @else @end phase archive thenP)] (wrap ($_ _.compose ..peek (_.checkcast //type.tuple) @@ -179,7 +179,7 @@ (<pm> lefts) (synthesis.!bind-top register thenP))) (do phase.monad - [then! (path' phase stack-depth @else @end thenP)] + [then! (path' stack-depth @else @end phase archive thenP)] (wrap ($_ _.compose ..peek (_.checkcast //type.tuple) @@ -193,8 +193,8 @@ (#synthesis.Alt leftP rightP) (do phase.monad [@alt-else //runtime.forge-label - left! (path' phase (inc stack-depth) @alt-else @end leftP) - right! (path' phase stack-depth @else @end rightP)] + left! (path' (inc stack-depth) @alt-else @end phase archive leftP) + right! (path' stack-depth @else @end phase archive rightP)] (wrap ($_ _.compose _.dup left! @@ -204,18 +204,18 @@ (#synthesis.Seq leftP rightP) (do phase.monad - [left! (path' phase stack-depth @else @end leftP) - right! (path' phase stack-depth @else @end rightP)] + [left! (path' stack-depth @else @end phase archive leftP) + right! (path' stack-depth @else @end phase archive rightP)] (wrap ($_ _.compose left! right!))) )) -(def: (path phase path @end) - (-> Phase Path Label (Operation (Bytecode Any))) +(def: (path @end phase archive path) + (-> Label (Generator Path)) (do phase.monad [@else //runtime.forge-label - pathG (..path' phase 1 @else @end path)] + pathG (..path' 1 @else @end phase archive path)] (wrap ($_ _.compose pathG (_.set-label @else) @@ -224,12 +224,12 @@ _.aconst-null (_.goto @end))))) -(def: #export (if phase conditionS thenS elseS) - (-> Phase Synthesis Synthesis Synthesis (Operation (Bytecode Any))) +(def: #export (if phase archive [conditionS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) (do phase.monad - [conditionG (phase conditionS) - thenG (phase thenS) - elseG (phase elseS)] + [conditionG (phase archive conditionS) + thenG (phase archive thenS) + elseG (phase archive elseS)] (wrap (do _.monad [@else _.new-label @end _.new-label] @@ -243,22 +243,22 @@ elseG (_.set-label @end)))))) -(def: #export (let phase inputS register bodyS) - (-> Phase Synthesis Register Synthesis (Operation (Bytecode Any))) +(def: #export (let phase archive [inputS register bodyS]) + (Generator [Synthesis Register Synthesis]) (do phase.monad - [inputG (phase inputS) - bodyG (phase bodyS)] + [inputG (phase archive inputS) + bodyG (phase archive bodyS)] (wrap ($_ _.compose inputG (_.astore register) bodyG)))) -(def: #export (case phase valueS path) - (-> Phase Synthesis Path (Operation (Bytecode Any))) +(def: #export (case phase archive [valueS path]) + (Generator [Synthesis Path]) (do phase.monad [@end //runtime.forge-label - valueG (phase valueS) - pathG (..path phase path @end)] + valueG (phase archive valueS) + pathG (..path @end phase archive path)] (wrap ($_ _.compose _.aconst-null valueG diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index a06d127ac..ebc8f6906 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -42,7 +42,7 @@ ["#." reset] ["#." apply]] ["/#" // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] [//// [analysis (#+ Environment)] [synthesis (#+ Synthesis Abstraction Apply)] @@ -89,13 +89,13 @@ Internal)) (|>> type.reflection reflection.reflection name.internal)) -(def: #export (abstraction generate [environment arity bodyS]) - (-> Phase Abstraction (Operation (Bytecode Any))) +(def: #export (abstraction generate archive [environment arity bodyS]) + (Generator Abstraction) (do phase.monad [@begin //runtime.forge-label [function-class bodyG] (generation.with-context (generation.with-anchor [@begin ..this-offset] - (generate bodyS))) + (generate archive bodyS))) [fields methods instance] (..with @begin function-class environment arity bodyG) class (phase.lift (class.class version.v6_0 ..modifier @@ -109,11 +109,11 @@ (format.run class.writer class)])] (wrap instance))) -(def: #export (apply generate [abstractionS inputsS]) - (-> Phase Apply (Operation (Bytecode Any))) +(def: #export (apply generate archive [abstractionS inputsS]) + (Generator Apply) (do phase.monad - [abstractionG (generate abstractionS) - inputsG (monad.map @ generate inputsS)] + [abstractionG (generate archive abstractionS) + inputsG (monad.map @ (generate archive) inputsS)] (wrap ($_ _.compose abstractionG (|> inputsG diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux index ac0cd300d..d2a900a87 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux @@ -14,7 +14,7 @@ [jvm ["_" bytecode (#+ Label Bytecode) ("#@." monad)]]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." value] [//// ["." synthesis (#+ Path Synthesis)] @@ -35,8 +35,8 @@ (def: no-op (_@wrap [])) -(def: #export (recur translate updatesS) - (-> Phase (List Synthesis) (Operation (Bytecode Any))) +(def: #export (recur translate archive updatesS) + (Generator (List Synthesis)) (do phase.monad [[@begin offset] generation.anchor updatesG (|> updatesS @@ -48,7 +48,7 @@ (wrap [..no-op ..no-op]) (do @ - [fetchG (translate updateS) + [fetchG (translate archive updateS) #let [storeG (_.astore register)]] (wrap [fetchG storeG]))))))] (wrap ($_ _.compose @@ -69,13 +69,13 @@ (monad.seq _.monad)) (_.goto @begin))))) -(def: #export (scope translate [offset initsS+ iterationS]) - (-> Phase [Nat (List Synthesis) Synthesis] (Operation (Bytecode Any))) +(def: #export (scope translate archive [offset initsS+ iterationS]) + (Generator [Nat (List Synthesis) Synthesis]) (do phase.monad [@begin //runtime.forge-label - initsI+ (monad.map @ translate initsS+) + initsI+ (monad.map @ (translate archive) initsS+) iterationG (generation.with-anchor [@begin offset] - (translate iterationS)) + (translate archive iterationS)) #let [initializationG (|> (list.enumerate initsI+) (list@map (function (_ [index initG]) ($_ _.compose diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 1ad86b82c..0582b21be 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -48,7 +48,9 @@ [/// ["#" phase] [arity (#+ Arity)] - [reference (#+ Register)]]]]]) + [reference (#+ Register)] + [meta + [archive (#+ Archive)]]]]]]) (type: #export Byte-Code Binary) @@ -67,7 +69,7 @@ ) (type: #export (Generator i) - (-> Phase i (Operation (Bytecode Any)))) + (-> Phase Archive i (Operation (Bytecode Any)))) (type: #export Host (generation.Host (Bytecode Any) Definition)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux index 23acad65c..a324b0bec 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux @@ -24,14 +24,14 @@ (def: unitG (Bytecode Any) (//primitive.text /////synthesis.unit)) -(def: #export (tuple generate membersS) +(def: #export (tuple generate archive membersS) (Generator (Tuple Synthesis)) (case membersS #.Nil (:: phase.monad wrap ..unitG) (#.Cons singletonS #.Nil) - (generate singletonS) + (generate archive singletonS) _ (do phase.monad @@ -39,7 +39,7 @@ list.enumerate (monad.map @ (function (_ [idx member]) (do @ - [memberI (generate member)] + [memberI (generate archive member)] (wrap (do _.monad [_ _.dup _ (_.int (.i64 idx)) @@ -56,10 +56,10 @@ ..unitG _.aconst-null)) -(def: #export (variant generate [lefts right? valueS]) +(def: #export (variant generate archive [lefts right? valueS]) (Generator (Variant Synthesis)) (do phase.monad - [valueI (generate valueS)] + [valueI (generate archive valueS)] (wrap (do _.monad [_ (_.int (.i64 (if right? (.inc lefts) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux index 24b40808f..3a041f594 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux @@ -18,7 +18,7 @@ ["//#" /// #_ ["#." phase ("#@." monad)]]]]]) -(def: #export (generate synthesis) +(def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] @@ -30,34 +30,34 @@ [synthesis.text /primitive.text]) (^ (synthesis.variant variantS)) - (/structure.variant generate variantS) + (/structure.variant generate archive variantS) (^ (synthesis.tuple members)) - (/structure.tuple generate members) + (/structure.tuple generate archive members) (#synthesis.Reference value) (/reference@reference value) (^ (synthesis.branch/case case)) - (/case.case generate case) + (/case.case generate archive case) (^ (synthesis.branch/let let)) - (/case.let generate let) + (/case.let generate archive let) (^ (synthesis.branch/if if)) - (/case.if generate if) + (/case.if generate archive if) (^ (synthesis.loop/scope scope)) - (/loop.scope generate scope) + (/loop.scope generate archive scope) (^ (synthesis.loop/recur updates)) - (/loop.recur generate updates) + (/loop.recur generate archive updates) (^ (synthesis.function/abstraction abstraction)) - (/function.function generate abstraction) + (/function.function generate archive abstraction) (^ (synthesis.function/apply application)) - (/function.apply generate application) + (/function.apply generate archive application) (#synthesis.Extension extension) - (///extension.apply generate extension))) + (///extension.apply archive generate extension))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index 89a58a788..6271955ed 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -12,7 +12,7 @@ [target ["_" lua (#+ Expression Var Statement)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] ["/#" // #_ ["#." reference] @@ -24,7 +24,9 @@ ["/#" // #_ ["/#" // #_ [reference (#+ Register)] - ["#." phase ("#@." monad)]]]]]]]) + ["#." phase ("#@." monad)] + [meta + [archive (#+ Archive)]]]]]]]]) (def: #export register (///reference.local _.var)) @@ -32,23 +34,21 @@ (def: #export capture (///reference.foreign _.var)) -(def: #export (let generate [valueS register bodyS]) - (-> Phase [Synthesis Register Synthesis] - (Operation (Expression Any))) +(def: #export (let generate archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) (do ///////phase.monad - [valueO (generate valueS) - bodyO (generate bodyS)] + [valueO (generate archive valueS) + bodyO (generate archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. (wrap (|> bodyO _.return (_.closure (list (..register register))) (_.apply/* (list valueO)))))) -(def: #export (record-get generate valueS pathP) - (-> Phase Synthesis (List (Either Nat Nat)) - (Operation (Expression Any))) +(def: #export (record-get generate archive [valueS pathP]) + (Generator [Synthesis (List (Either Nat Nat))]) (do ///////phase.monad - [valueO (generate valueS)] + [valueO (generate archive valueS)] (wrap (list@fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -60,13 +60,12 @@ valueO pathP)))) -(def: #export (if generate [testS thenS elseS]) - (-> Phase [Synthesis Synthesis Synthesis] - (Operation (Expression Any))) +(def: #export (if generate archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) (do ///////phase.monad - [testO (generate testS) - thenO (generate thenS) - elseO (generate elseS)] + [testO (generate archive testS) + thenO (generate archive thenS) + elseO (generate archive elseS)] (wrap (|> (_.if testO (_.return thenO) (_.return elseO)) @@ -132,11 +131,11 @@ ..restore! post!))) -(def: (pattern-matching' generate pathP) - (-> Phase Path (Operation Statement)) +(def: (pattern-matching' generate archive pathP) + (-> Phase Archive Path (Operation Statement)) (.case pathP (^ (/////synthesis.path/then bodyS)) - (///////phase@map _.return (generate bodyS)) + (///////phase@map _.return (generate archive bodyS)) #/////synthesis.Pop (///////phase@wrap ..pop!) @@ -159,7 +158,7 @@ (^ (<simple> idx nextP)) (|> nextP - (pattern-matching' generate) + (pattern-matching' generate archive) (///////phase@map (_.then (<choice> true idx))))) ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) @@ -175,7 +174,7 @@ (^ (/////synthesis.!bind-top register thenP)) (do ///////phase.monad - [then! (pattern-matching' generate thenP)] + [then! (pattern-matching' generate archive thenP)] (///////phase@wrap ($_ _.then (_.let (list (..register register)) ..peek-and-pop) then!))) @@ -183,26 +182,26 @@ (^template [<tag> <combinator>] (^ (<tag> preP postP)) (do ///////phase.monad - [pre! (pattern-matching' generate preP) - post! (pattern-matching' generate postP)] + [pre! (pattern-matching' generate archive preP) + post! (pattern-matching' generate archive postP)] (wrap (<combinator> pre! post!)))) ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation]))) -(def: (pattern-matching generate pathP) - (-> Phase Path (Operation Statement)) +(def: (pattern-matching generate archive pathP) + (-> Phase Archive Path (Operation Statement)) (do ///////phase.monad - [pattern-matching! (pattern-matching' generate pathP)] + [pattern-matching! (pattern-matching' generate archive pathP)] (wrap ($_ _.then (_.while (_.bool true) pattern-matching!) (_.statement (|> (_.var "error") (_.apply/* (list (_.string /.pattern-matching-error))))))))) -(def: #export (case generate [valueS pathP]) - (-> Phase [Synthesis Path] (Operation (Expression Any))) +(def: #export (case generate archive [valueS pathP]) + (Generator [Synthesis Path]) (do ///////phase.monad - [initG (generate valueS) - pattern-matching! (pattern-matching generate pathP)] + [initG (generate archive valueS) + pattern-matching! (pattern-matching generate archive pathP)] (wrap (|> ($_ _.then (_.local (list @temp)) (_.let (list @cursor) (_.array (list initG))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index fe58b821a..556f8d169 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -11,7 +11,7 @@ [target ["_" lua (#+ Expression Statement)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." reference] ["#." case] ["/#" // #_ @@ -25,11 +25,11 @@ [arity (#+ Arity)] ["#." phase]]]]]) -(def: #export (apply generate [functionS argsS+]) - (-> Phase (Application Synthesis) (Operation (Expression Any))) +(def: #export (apply generate archive [functionS argsS+]) + (Generator (Application Synthesis)) (do ///////phase.monad - [functionO (generate functionS) - argsO+ (monad.map @ generate argsS+)] + [functionO (generate archive functionS) + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* argsO+ functionO)))) (def: #export capture @@ -59,14 +59,14 @@ (def: input (|>> inc //case.register)) -(def: #export (function generate [environment arity bodyS]) - (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) +(def: #export (function generate archive [environment arity bodyS]) + (Generator (Abstraction Synthesis)) (do ///////phase.monad [[function-name bodyO] (/////generation.with-context (do @ [function-name /////generation.context] (/////generation.with-anchor (_.var function-name) - (generate bodyS)))) + (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) (monad.map @ (:: //reference.system variable) environment)) #let [@curried (_.var "curried") diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index f2f96759a..993ac4312 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -13,7 +13,7 @@ [target ["_" lua (#+ Expression Var)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Generator)] ["#." case] ["///#" //// #_ [synthesis (#+ Scope Synthesis)] @@ -25,13 +25,13 @@ (-> Nat Var) (|>> %.nat (format "loop") _.var)) -(def: #export (scope generate [start initsS+ bodyS]) - (-> Phase (Scope Synthesis) (Operation (Expression Any))) +(def: #export (scope generate archive [start initsS+ bodyS]) + (Generator (Scope Synthesis)) (do ///////phase.monad [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ generate initsS+) + initsO+ (monad.map @ (generate archive) initsS+) bodyO (/////generation.with-anchor @loop - (generate bodyS)) + (generate archive bodyS)) _ (/////generation.save! true ["" (_.code @loop)] (_.function @loop (|> initsS+ list.enumerate @@ -39,9 +39,9 @@ (_.return bodyO)))] (wrap (_.apply/* initsO+ @loop)))) -(def: #export (recur generate argsS+) - (-> Phase (List Synthesis) (Operation (Expression Any))) +(def: #export (recur generate archive argsS+) + (Generator (List Synthesis)) (do ///////phase.monad [@scope /////generation.anchor - argsO+ (monad.map @ generate argsS+)] + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index 760759b05..ad3745dff 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -23,7 +23,9 @@ ["#." generation] ["//#" /// #_ ["#." phase] - ["#." name]]]) + ["#." name] + [meta + [archive (#+ Archive)]]]]) (template [<name> <base>] [(type: #export <name> @@ -35,6 +37,9 @@ [Bundle /////generation.Bundle] ) +(type: #export (Generator i) + (-> Phase Archive i (Operation (Expression Any)))) + (def: prefix Text "LuxRuntime") (def: #export unit (_.string /////synthesis.unit)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux index 3ef7d505d..d06034686 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux @@ -5,7 +5,7 @@ [target ["_" lua (#+ Expression)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] ["///#" //// #_ [analysis (#+ Variant Tuple)] @@ -13,24 +13,24 @@ ["//#" /// #_ ["#." phase ("#@." monad)]]]]) -(def: #export (tuple generate elemsS+) - (-> Phase (Tuple Synthesis) (Operation (Expression Any))) +(def: #export (tuple generate archive elemsS+) + (Generator (Tuple Synthesis)) (case elemsS+ #.Nil (///////phase@wrap (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) - (generate singletonS) + (generate archive singletonS) _ (|> elemsS+ - (monad.map ///////phase.monad generate) + (monad.map ///////phase.monad (generate archive)) (///////phase@map _.array)))) -(def: #export (variant generate [lefts right? valueS]) - (-> Phase (Variant Synthesis) (Operation (Expression Any))) +(def: #export (variant generate archive [lefts right? valueS]) + (Generator (Variant Synthesis)) (let [tag (if right? (inc lefts) lefts)] (///////phase@map (//runtime.variant tag right?) - (generate valueS)))) + (generate archive valueS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux index 9523b743a..f6e14de75 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -18,7 +18,7 @@ ["//#" /// #_ ["#." phase ("#@." monad)]]]]]) -(def: #export (generate synthesis) +(def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] @@ -30,34 +30,34 @@ [////synthesis.text /primitive.text]) (^ (////synthesis.variant variantS)) - (/structure.variant generate variantS) + (/structure.variant generate archive variantS) (^ (////synthesis.tuple members)) - (/structure.tuple generate members) + (/structure.tuple generate archive members) (#////synthesis.Reference value) (/reference@reference value) (^ (////synthesis.branch/case case)) - (/case.case generate case) + (/case.case generate archive case) (^ (////synthesis.branch/let let)) - (/case.let generate let) + (/case.let generate archive let) (^ (////synthesis.branch/if if)) - (/case.if generate if) + (/case.if generate archive if) (^ (////synthesis.loop/scope scope)) - (/loop.scope generate scope) + (/loop.scope generate archive scope) (^ (////synthesis.loop/recur updates)) - (/loop.recur generate updates) + (/loop.recur generate archive updates) (^ (////synthesis.function/abstraction abstraction)) - (/function.function generate abstraction) + (/function.function generate archive abstraction) (^ (////synthesis.function/apply application)) - (/function.apply generate application) + (/function.apply generate archive application) (#////synthesis.Extension extension) - (///extension.apply generate extension))) + (///extension.apply archive generate extension))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 1feff5e51..61796bb40 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -16,7 +16,7 @@ [target ["_" python (#+ Expression SVar Statement)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] ["/#" // #_ ["#." reference] @@ -28,7 +28,9 @@ ["#." generation] ["//#" /// #_ ["#." reference (#+ Register)] - ["#." phase ("#@." monad)]]]]]]) + ["#." phase ("#@." monad)] + [meta + [archive (#+ Archive)]]]]]]]) (def: #export register (///reference.local _.var)) @@ -36,22 +38,20 @@ (def: #export capture (///reference.foreign _.var)) -(def: #export (let generate [valueS register bodyS]) - (-> Phase [Synthesis Register Synthesis] - (Operation (Expression Any))) +(def: #export (let generate archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) (do ///////phase.monad - [valueO (generate valueS) - bodyO (generate bodyS)] + [valueO (generate archive valueS) + bodyO (generate archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. (wrap (_.apply/* (_.lambda (list (..register register)) bodyO) (list valueO))))) -(def: #export (record-get generate valueS pathP) - (-> Phase Synthesis (List (Either Nat Nat)) - (Operation (Expression Any))) +(def: #export (record-get generate archive [valueS pathP]) + (Generator [Synthesis (List (Either Nat Nat))]) (do ///////phase.monad - [valueO (generate valueS)] + [valueO (generate archive valueS)] (wrap (list@fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -63,13 +63,12 @@ valueO pathP)))) -(def: #export (if generate [testS thenS elseS]) - (-> Phase [Synthesis Synthesis Synthesis] - (Operation (Expression Any))) +(def: #export (if generate archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) (do ///////phase.monad - [testO (generate testS) - thenO (generate thenS) - elseO (generate elseS)] + [testO (generate archive testS) + thenO (generate archive thenS) + elseO (generate archive elseS)] (wrap (_.? testO thenO elseO)))) (def: @savepoint (_.var "lux_pm_savepoint")) @@ -135,11 +134,11 @@ ..restore! post!))) -(def: (pattern-matching' generate pathP) - (-> Phase Path (Operation (Statement Any))) +(def: (pattern-matching' generate archive pathP) + (-> Phase Archive Path (Operation (Statement Any))) (.case pathP (^ (/////synthesis.path/then bodyS)) - (///////phase@map _.return (generate bodyS)) + (///////phase@map _.return (generate archive bodyS)) #/////synthesis.Pop (///////phase@wrap ..pop!) @@ -162,7 +161,7 @@ (^ (<simple> idx nextP)) (|> nextP - (pattern-matching' generate) + (pattern-matching' generate archive) (///////phase@map (_.then (<choice> true idx))))) ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) @@ -178,7 +177,7 @@ (^ (/////synthesis.!bind-top register thenP)) (do ///////phase.monad - [then! (pattern-matching' generate thenP)] + [then! (pattern-matching' generate archive thenP)] (///////phase@wrap ($_ _.then (_.set (list (..register register)) ..peek-and-pop) then!))) @@ -186,7 +185,7 @@ (^ (/////synthesis.!multi-pop nextP)) (.let [[extra-pops nextP'] (case.count-pops nextP)] (do ///////phase.monad - [next! (pattern-matching' generate nextP')] + [next! (pattern-matching' generate archive nextP')] (///////phase@wrap ($_ _.then (..multi-pop! (n.+ 2 extra-pops)) next!)))) @@ -194,16 +193,16 @@ (^template [<tag> <combinator>] (^ (<tag> preP postP)) (do ///////phase.monad - [pre! (pattern-matching' generate preP) - post! (pattern-matching' generate postP)] + [pre! (pattern-matching' generate archive preP) + post! (pattern-matching' generate archive postP)] (wrap (<combinator> pre! post!)))) ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation]))) -(def: (pattern-matching generate pathP) - (-> Phase Path (Operation (Statement Any))) +(def: (pattern-matching generate archive pathP) + (-> Phase Archive Path (Operation (Statement Any))) (do ///////phase.monad - [pattern-matching! (pattern-matching' generate pathP)] + [pattern-matching! (pattern-matching' generate archive pathP)] (wrap ($_ _.then (_.while (_.bool true) pattern-matching!) @@ -213,11 +212,11 @@ (-> Text (Operation SVar)) (///////phase@map (|>> %.nat (format prefix) _.var) /////generation.next)) -(def: #export (case generate [valueS pathP]) - (-> Phase [Synthesis Path] (Operation (Expression Any))) +(def: #export (case generate archive [valueS pathP]) + (Generator [Synthesis Path]) (do ///////phase.monad - [initG (generate valueS) - pattern-matching! (pattern-matching generate pathP) + [initG (generate archive valueS) + pattern-matching! (pattern-matching generate archive pathP) @case (..gensym "case") @init (..gensym "init") #let [@dependencies+ (|> (case.storage pathP) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index f98f9b929..eb815a2c8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -11,7 +11,7 @@ [target ["_" python (#+ Expression Statement)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Generator)] ["#." reference] ["#." case] ["/#" // #_ @@ -25,11 +25,11 @@ [arity (#+ Arity)] ["#." phase]]]]]) -(def: #export (apply generate [functionS argsS+]) - (-> Phase (Application Synthesis) (Operation (Expression Any))) +(def: #export (apply generate archive [functionS argsS+]) + (Generator (Application Synthesis)) (do ///////phase.monad - [functionO (generate functionS) - argsO+ (monad.map @ generate argsS+)] + [functionO (generate archive functionS) + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) (def: #export capture @@ -59,14 +59,14 @@ (def: input (|>> inc //case.register)) -(def: #export (function generate [environment arity bodyS]) - (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) +(def: #export (function generate archive [environment arity bodyS]) + (Generator (Abstraction Synthesis)) (do ///////phase.monad [[function-name bodyO] (/////generation.with-context (do @ [function-name /////generation.context] (/////generation.with-anchor (_.var function-name) - (generate bodyS)))) + (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) (monad.map @ (:: //reference.system variable) environment)) #let [@curried (_.var "curried") diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 0533d7ab5..61c534618 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -13,7 +13,7 @@ [target ["_" python (#+ Expression SVar)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Generator)] ["#." case] ["///#" //// #_ [synthesis (#+ Scope Synthesis)] @@ -25,13 +25,13 @@ (-> Nat SVar) (|>> %.nat (format "loop") _.var)) -(def: #export (scope generate [start initsS+ bodyS]) - (-> Phase (Scope Synthesis) (Operation (Expression Any))) +(def: #export (scope generate archive [start initsS+ bodyS]) + (Generator (Scope Synthesis)) (do ///////phase.monad [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ generate initsS+) + initsO+ (monad.map @ (generate archive) initsS+) bodyO (/////generation.with-anchor @loop - (generate bodyS)) + (generate archive bodyS)) _ (/////generation.save! true ["" (_.code @loop)] (_.def @loop (|> initsS+ list.enumerate @@ -39,9 +39,9 @@ (_.return bodyO)))] (wrap (_.apply/* @loop initsO+)))) -(def: #export (recur generate argsS+) - (-> Phase (List Synthesis) (Operation (Expression Any))) +(def: #export (recur generate archive argsS+) + (Generator (List Synthesis)) (do ///////phase.monad [@scope /////generation.anchor - argsO+ (monad.map @ generate argsS+)] + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index eb18ec80e..8916ad6d8 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -23,7 +23,9 @@ ["#." generation] ["//#" /// #_ ["#." phase] - ["#." name]]]) + ["#." name] + [meta + [archive (#+ Archive)]]]]) (template [<name> <base>] [(type: #export <name> @@ -35,6 +37,9 @@ [Bundle /////generation.Bundle] ) +(type: #export (Generator i) + (-> Phase Archive i (Operation (Expression Any)))) + (def: prefix Text "LuxRuntime") (def: #export unit (_.string /////synthesis.unit)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux index fe3087ae8..b564b1d3c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux @@ -5,7 +5,7 @@ [target ["_" python (#+ Expression)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] ["///#" //// #_ [analysis (#+ Variant Tuple)] @@ -13,24 +13,24 @@ ["//#" /// #_ ["#." phase ("#@." monad)]]]]) -(def: #export (tuple generate elemsS+) - (-> Phase (Tuple Synthesis) (Operation (Expression Any))) +(def: #export (tuple generate archive elemsS+) + (Generator (Tuple Synthesis)) (case elemsS+ #.Nil (///////phase@wrap (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) - (generate singletonS) + (generate archive singletonS) _ (|> elemsS+ - (monad.map ///////phase.monad generate) + (monad.map ///////phase.monad (generate archive)) (///////phase@map _.list)))) -(def: #export (variant generate [lefts right? valueS]) - (-> Phase (Variant Synthesis) (Operation (Expression Any))) +(def: #export (variant generate archive [lefts right? valueS]) + (Generator (Variant Synthesis)) (let [tag (if right? (inc lefts) lefts)] (///////phase@map (//runtime.variant tag right?) - (generate valueS)))) + (generate archive valueS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux index a83ac89e1..f6e14de75 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux @@ -2,60 +2,62 @@ [lux #* [abstract [monad (#+ do)]]] - [/ + ["." / #_ [runtime (#+ Phase)] - ["." primitive] - ["." structure] - ["." reference ("#@." system)] - ["." case] - ["." function] - ["." loop] - ["." /// - ["." extension] - [// + ["#." primitive] + ["#." structure] + ["#." reference ("#@." system)] + ["#." function] + ["#." case] + ["#." loop] + ["//#" /// #_ + ["#." extension] + ["/#" // #_ [analysis (#+)] - ["." synthesis]]]]) + ["#." synthesis] + ["//#" /// #_ + ["#." phase ("#@." monad)]]]]]) -(def: #export (generate synthesis) +(def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] (^ (<tag> value)) - (:: ///.monad wrap (<generator> value))) - ([synthesis.bit primitive.bit] - [synthesis.i64 primitive.i64] - [synthesis.f64 primitive.f64] - [synthesis.text primitive.text]) + (//////phase@wrap (<generator> value))) + ([////synthesis.bit /primitive.bit] + [////synthesis.i64 /primitive.i64] + [////synthesis.f64 /primitive.f64] + [////synthesis.text /primitive.text]) - (^ (synthesis.variant variantS)) - (structure.variant generate variantS) + (^ (////synthesis.variant variantS)) + (/structure.variant generate archive variantS) - (^ (synthesis.tuple members)) - (structure.tuple generate members) + (^ (////synthesis.tuple members)) + (/structure.tuple generate archive members) - (#synthesis.Reference value) - (reference@reference value) + (#////synthesis.Reference value) + (/reference@reference value) - (^ (synthesis.branch/case case)) - (case.case generate case) + (^ (////synthesis.branch/case case)) + (/case.case generate archive case) - (^ (synthesis.branch/let let)) - (case.let generate let) + (^ (////synthesis.branch/let let)) + (/case.let generate archive let) - (^ (synthesis.branch/if if)) - (case.if generate if) + (^ (////synthesis.branch/if if)) + (/case.if generate archive if) - (^ (synthesis.loop/scope scope)) - (loop.scope generate scope) + (^ (////synthesis.loop/scope scope)) + (/loop.scope generate archive scope) - (^ (synthesis.loop/recur updates)) - (loop.recur generate updates) + (^ (////synthesis.loop/recur updates)) + (/loop.recur generate archive updates) - (^ (synthesis.function/abstraction abstraction)) - (function.function generate abstraction) + (^ (////synthesis.function/abstraction abstraction)) + (/function.function generate archive abstraction) - (^ (synthesis.function/apply application)) - (function.apply generate application) + (^ (////synthesis.function/apply application)) + (/function.apply generate archive application) - (#synthesis.Extension extension) - (extension.apply generate extension))) + (#////synthesis.Extension extension) + (///extension.apply archive generate extension))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index 8d95783a9..082f9c334 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -15,17 +15,21 @@ [target ["_" ruby (#+ Expression Statement)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] - ["#." reference] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // ("#@." monad) + ["/#" // #_ [synthesis ["." case]] - ["#/" // #_ - ["." reference (#+ Register)] - ["#." synthesis (#+ Synthesis Path)]]]]]) + ["/#" // #_ + ["#." synthesis (#+ Synthesis Path)] + ["#." generation] + ["//#" /// #_ + ["#." reference (#+ Register)] + ["#." phase ("#@." monad)] + [meta + [archive (#+ Archive)]]]]]]]) (def: #export register (///reference.local _.local)) @@ -33,23 +37,21 @@ (def: #export capture (///reference.foreign _.local)) -(def: #export (let generate [valueS register bodyS]) - (-> Phase [Synthesis Register Synthesis] - (Operation (Expression Any))) - (do ////.monad - [valueO (generate valueS) - bodyO (generate bodyS)] +(def: #export (let generate archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (generate archive valueS) + bodyO (generate archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. (wrap (|> bodyO _.return (_.lambda #.None (list (..register register))) (_.do "call" (list valueO)))))) -(def: #export (record-get generate valueS pathP) - (-> Phase Synthesis (List (Either Nat Nat)) - (Operation (Expression Any))) - (do ////.monad - [valueO (generate valueS)] +(def: #export (record-get generate archive [valueS pathP]) + (Generator [Synthesis (List (Either Nat Nat))]) + (do ///////phase.monad + [valueO (generate archive valueS)] (wrap (list@fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] @@ -61,13 +63,12 @@ valueO pathP)))) -(def: #export (if generate [testS thenS elseS]) - (-> Phase [Synthesis Synthesis Synthesis] - (Operation (Expression Any))) - (do ////.monad - [testO (generate testS) - thenO (generate thenS) - elseO (generate elseS)] +(def: #export (if generate archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (generate archive testS) + thenO (generate archive thenS) + elseO (generate archive elseS)] (wrap (_.? testO thenO elseO)))) (def: @savepoint (_.local "lux_pm_savepoint")) @@ -134,22 +135,22 @@ ..restore! post!))) -(def: (pattern-matching' generate pathP) - (-> Phase Path (Operation (Statement Any))) +(def: (pattern-matching' generate archive pathP) + (-> Phase Archive Path (Operation (Statement Any))) (.case pathP (^ (/////synthesis.path/then bodyS)) - (:: ////.monad map _.return (generate bodyS)) + (///////phase@map _.return (generate archive bodyS)) #/////synthesis.Pop - (////@wrap ..pop!) + (///////phase@wrap ..pop!) (#/////synthesis.Bind register) - (////@wrap (_.set (list (..register register)) ..peek)) + (///////phase@wrap (_.set (list (..register register)) ..peek)) (^template [<tag> <format>] (^ (<tag> value)) - (////@wrap (_.when (|> value <format> (_.= ..peek) _.not) - fail!))) + (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not) + fail!))) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] [/////synthesis.path/f64 //primitive.f64] @@ -157,62 +158,62 @@ (^template [<complex> <simple> <choice>] (^ (<complex> idx)) - (////@wrap (<choice> false idx)) + (///////phase@wrap (<choice> false idx)) (^ (<simple> idx nextP)) (|> nextP - (pattern-matching' generate) - (:: ////.monad map (_.then (<choice> true idx))))) + (pattern-matching' generate archive) + (///////phase@map (_.then (<choice> true idx))))) ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) (^ (/////synthesis.member/left 0)) - (////@wrap (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase@wrap (|> ..peek (_.nth (_.int +0)) ..push!)) (^template [<pm> <getter>] (^ (<pm> lefts)) - (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))) + (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind-top register thenP)) - (do ////.monad - [then! (pattern-matching' generate thenP)] - (////@wrap ($_ _.then - (_.set (list (..register register)) ..peek-and-pop) - then!))) + (do ///////phase.monad + [then! (pattern-matching' generate archive thenP)] + (///////phase@wrap ($_ _.then + (_.set (list (..register register)) ..peek-and-pop) + then!))) (^ (/////synthesis.!multi-pop nextP)) (.let [[extra-pops nextP'] (case.count-pops nextP)] - (do ////.monad - [next! (pattern-matching' generate nextP')] - (////@wrap ($_ _.then - (..multi-pop! (n.+ 2 extra-pops)) - next!)))) + (do ///////phase.monad + [next! (pattern-matching' generate archive nextP')] + (///////phase@wrap ($_ _.then + (..multi-pop! (n.+ 2 extra-pops)) + next!)))) (^template [<tag> <combinator>] (^ (<tag> preP postP)) - (do ////.monad - [pre! (pattern-matching' generate preP) - post! (pattern-matching' generate postP)] + (do ///////phase.monad + [pre! (pattern-matching' generate archive preP) + post! (pattern-matching' generate archive postP)] (wrap (<combinator> pre! post!)))) ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation]))) -(def: (pattern-matching generate pathP) - (-> Phase Path (Operation (Statement Any))) - (do ////.monad - [pattern-matching! (pattern-matching' generate pathP)] +(def: (pattern-matching generate archive pathP) + (-> Phase Archive Path (Operation (Statement Any))) + (do ///////phase.monad + [pattern-matching! (pattern-matching' generate archive pathP)] (wrap ($_ _.then (_.while (_.bool true) pattern-matching!) (_.statement (_.raise (_.string case.pattern-matching-error))))))) -(def: #export (case generate [valueS pathP]) - (-> Phase [Synthesis Path] (Operation (Expression Any))) - (do ////.monad - [initG (generate valueS) - pattern-matching! (pattern-matching generate pathP)] +(def: #export (case generate archive [valueS pathP]) + (Generator [Synthesis Path]) + (do ///////phase.monad + [initG (generate archive valueS) + pattern-matching! (pattern-matching generate archive pathP)] (wrap (|> ($_ _.then (_.set (list @cursor) (_.array (list initG))) (_.set (list @savepoint) (_.array (list))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/extension.lux deleted file mode 100644 index 3bc0a0887..000000000 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/extension.lux +++ /dev/null @@ -1,13 +0,0 @@ -(.module: - [lux #* - [data - [collection - ["." dictionary]]]] - [// - [runtime (#+ Bundle)]] - [/ - ["." common]]) - -(def: #export bundle - Bundle - common.bundle) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/extension/common.lux deleted file mode 100644 index 0ebfe1ab5..000000000 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/extension/common.lux +++ /dev/null @@ -1,162 +0,0 @@ -(.module: - [lux #* - [host (#+ import:)] - [abstract - ["." monad (#+ do)]] - [control - ["." function]] - [data - ["." product] - ["." text] - [number - ["f" frac]] - [collection - ["." dictionary]]] - [target - ["_" ruby (#+ Expression)]]] - ["." /// #_ - ["#." runtime (#+ Operation Phase Handler Bundle)] - ["#." primitive] - [// - [extension (#+ Nullary Unary Binary Trinary - nullary unary binary trinary)] - [// - [extension - ["." bundle]]]]]) - -(def: lux-procs - Bundle - (|> bundle.empty - (bundle.install "is" (binary (product.uncurry _.=))) - (bundle.install "try" (unary ///runtime.lux//try)))) - -(def: keep-i64 - (All [input] - (-> (-> input (Expression Any)) - (-> input (Expression Any)))) - (function.compose (_.bit-and (_.manual "0xFFFFFFFFFFFFFFFF")))) - -(def: i64-procs - Bundle - (<| (bundle.prefix "i64") - (|> bundle.empty - (bundle.install "and" (binary (product.uncurry _.bit-and))) - (bundle.install "or" (binary (product.uncurry _.bit-or))) - (bundle.install "xor" (binary (product.uncurry _.bit-xor))) - (bundle.install "left-shift" (binary (..keep-i64 (product.uncurry _.bit-shl)))) - (bundle.install "logical-right-shift" (binary (product.uncurry ///runtime.i64//logic-right-shift))) - (bundle.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "+" (binary (..keep-i64 (product.uncurry _.+)))) - (bundle.install "-" (binary (..keep-i64 (product.uncurry _.-)))) - ))) - -(import: #long java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [<name> <const>] - [(def: (<name> _) - (Nullary (Expression Any)) - (_.float <const>))] - - [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [frac//max (java/lang/Double::MAX_VALUE)] - ) - -(def: int-procs - Bundle - (<| (bundle.prefix "int") - (|> bundle.empty - (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "*" (binary (..keep-i64 (product.uncurry _.*)))) - (bundle.install "/" (binary (product.uncurry _./))) - (bundle.install "%" (binary (product.uncurry _.%))) - (bundle.install "frac" (unary (_./ (_.float +1.0)))) - (bundle.install "char" (unary (_.do "chr" (list))))))) - -(def: frac-procs - Bundle - (<| (bundle.prefix "frac") - (|> bundle.empty - (bundle.install "+" (binary (product.uncurry _.+))) - (bundle.install "-" (binary (product.uncurry _.-))) - (bundle.install "*" (binary (product.uncurry _.*))) - (bundle.install "/" (binary (product.uncurry _./))) - (bundle.install "%" (binary (product.uncurry _.%))) - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "smallest" (nullary frac//smallest)) - (bundle.install "min" (nullary frac//min)) - (bundle.install "max" (nullary frac//max)) - (bundle.install "int" (unary (_.do "floor" (list)))) - (bundle.install "encode" (unary (_.do "to_s" (list)))) - (bundle.install "decode" (unary ///runtime.f64//decode))))) - -(def: (text//char [subjectO paramO]) - (Binary (Expression Any)) - (///runtime.text//char subjectO paramO)) - -(def: (text//clip [paramO extraO subjectO]) - (Trinary (Expression Any)) - (///runtime.text//clip subjectO paramO extraO)) - -(def: (text//index [startO partO textO]) - (Trinary (Expression Any)) - (///runtime.text//index textO partO startO)) - -(def: text-procs - Bundle - (<| (bundle.prefix "text") - (|> bundle.empty - (bundle.install "=" (binary (product.uncurry _.=))) - (bundle.install "<" (binary (product.uncurry _.<))) - (bundle.install "concat" (binary (product.uncurry _.+))) - (bundle.install "index" (trinary text//index)) - (bundle.install "size" (unary (_.the "length"))) - (bundle.install "char" (binary (product.uncurry ///runtime.text//char))) - (bundle.install "clip" (trinary text//clip)) - ))) - -(def: (io//log! messageG) - (Unary (Expression Any)) - (_.or (_.apply/* (list (|> messageG (_.+ (_.string text.new-line)))) - (_.local "puts")) - ///runtime.unit)) - -(def: io//error! - (Unary (Expression Any)) - _.raise) - -(def: (io//exit! code) - (Unary (Expression Any)) - (_.apply/* (list code) (_.local "exit"))) - -(def: (io//current-time! _) - (Nullary (Expression Any)) - (|> (_.local "Time") - (_.do "now" (list)) - (_.do "to_f" (list)) - (_.* (_.float +1000.0)) - (_.do "to_i" (list)))) - -(def: io-procs - Bundle - (<| (bundle.prefix "io") - (|> bundle.empty - (bundle.install "log" (unary ..io//log!)) - (bundle.install "error" (unary ..io//error!)) - (bundle.install "exit" (unary ..io//exit!)) - (bundle.install "current-time" (nullary ..io//current-time!))))) - -(def: #export bundle - Bundle - (<| (bundle.prefix "lux") - (|> lux-procs - (dictionary.merge ..i64-procs) - (dictionary.merge ..int-procs) - (dictionary.merge ..frac-procs) - (dictionary.merge ..text-procs) - (dictionary.merge ..io-procs) - ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 02e221894..3e63c5a86 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -11,23 +11,25 @@ [target ["_" ruby (#+ Expression Statement)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Generator)] ["#." reference] ["#." case] - ["#/" // + ["/#" // #_ ["#." reference] - ["#/" // - ["." // #_ + ["//#" /// #_ + [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] + [synthesis (#+ Synthesis)] + ["#." generation] + ["//#" /// #_ [reference (#+ Register Variable)] [arity (#+ Arity)] - [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)] - [synthesis (#+ Synthesis)]]]]]) + ["#." phase]]]]]) -(def: #export (apply generate [functionS argsS+]) - (-> Phase (Application Synthesis) (Operation (Expression Any))) - (do ////.monad - [functionO (generate functionS) - argsO+ (monad.map @ generate argsS+)] +(def: #export (apply generate archive [functionS argsS+]) + (Generator (Application Synthesis)) + (do ///////phase.monad + [functionO (generate archive functionS) + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.do "call" argsO+ functionO)))) (def: #export capture @@ -43,21 +45,21 @@ (|> function-definition _.return (_.lambda #.None - (|> (list.enumerate inits) - (list@map (|>> product.left ..capture)))) + (|> (list.enumerate inits) + (list@map (|>> product.left ..capture)))) (_.do "call" inits)))) (def: input (|>> inc //case.register)) -(def: #export (function generate [environment arity bodyS]) - (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) - (do ////.monad - [[function-name bodyO] (///.with-context +(def: #export (function generate archive [environment arity bodyS]) + (Generator (Abstraction Synthesis)) + (do ///////phase.monad + [[function-name bodyO] (/////generation.with-context (do @ - [function-name ///.context] - (///.with-anchor (_.local function-name) - (generate bodyS)))) + [function-name /////generation.context] + (/////generation.with-anchor (_.local function-name) + (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) (monad.map @ (:: //reference.system variable) environment)) #let [@curried (_.local "curried") @@ -74,26 +76,26 @@ (list.indices arity))]] (wrap (with-closure closureO+ (_.lambda (#.Some @self) (list (_.variadic @curried)) - ($_ _.then - (_.set (list @num-args) (_.the "length" @curried)) - (_.cond (list [(|> @num-args (_.= arityO)) - ($_ _.then - initialize! - (_.return bodyO))] - [(|> @num-args (_.> arityO)) - (let [slice (.function (_ from to) - (_.array-range from to @curried)) - arity-args (_.splat (slice (_.int +0) limitO)) - output-func-args (_.splat (slice arityO @num-args))] - (_.return (|> @self - (_.do "call" (list arity-args)) - (_.do "call" (list output-func-args)))))]) - ## (|> @num-args (_.< arityO)) - (let [@missing (_.local "missing")] - (_.return (_.lambda #.None (list (_.variadic @missing)) - (_.return (|> @self - (_.do "call" (list (_.splat (|> (_.array (list)) - (_.do "concat" (list @curried)) - (_.do "concat" (list @missing)))))))))))) - )))) + ($_ _.then + (_.set (list @num-args) (_.the "length" @curried)) + (_.cond (list [(|> @num-args (_.= arityO)) + ($_ _.then + initialize! + (_.return bodyO))] + [(|> @num-args (_.> arityO)) + (let [slice (.function (_ from to) + (_.array-range from to @curried)) + arity-args (_.splat (slice (_.int +0) limitO)) + output-func-args (_.splat (slice arityO @num-args))] + (_.return (|> @self + (_.do "call" (list arity-args)) + (_.do "call" (list output-func-args)))))]) + ## (|> @num-args (_.< arityO)) + (let [@missing (_.local "missing")] + (_.return (_.lambda #.None (list (_.variadic @missing)) + (_.return (|> @self + (_.do "call" (list (_.splat (|> (_.array (list)) + (_.do "concat" (list @curried)) + (_.do "concat" (list @missing)))))))))))) + )))) )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index 4bb7d44c7..1112aa00d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -11,32 +11,37 @@ [collection ["." list ("#@." functor)]]] [target - ["_" ruby (#+ Expression)]]] + ["_" ruby (#+ Expression LVar)]]] ["." // #_ - [runtime (#+ Operation Phase)] + [runtime (#+ Operation Phase Generator)] ["#." case] - ["#/" // - ["#/" // - [// - [synthesis (#+ Scope Synthesis)]]]]]) + ["///#" //// #_ + [synthesis (#+ Scope Synthesis)] + ["#." generation] + ["//#" /// #_ + ["#." phase]]]]) -(def: #export (scope generate [start initsS+ bodyS]) - (-> Phase (Scope Synthesis) (Operation (Expression Any))) - (do ////.monad - [@loop (:: @ map (|>> %.nat (format "loop") _.local) ///.next) - initsO+ (monad.map @ generate initsS+) - bodyO (///.with-anchor @loop - (generate bodyS))] +(def: loop-name + (-> Nat LVar) + (|>> %.nat (format "loop") _.local)) + +(def: #export (scope generate archive [start initsS+ bodyS]) + (Generator (Scope Synthesis)) + (do ///////phase.monad + [@loop (:: @ map ..loop-name /////generation.next) + initsO+ (monad.map @ (generate archive) initsS+) + bodyO (/////generation.with-anchor @loop + (generate archive bodyS))] (wrap (|> (_.return bodyO) (_.lambda (#.Some @loop) - (|> initsS+ - list.enumerate - (list@map (|>> product.left (n.+ start) //case.register)))) + (|> initsS+ + list.enumerate + (list@map (|>> product.left (n.+ start) //case.register)))) (_.apply/* initsO+))))) -(def: #export (recur generate argsS+) - (-> Phase (List Synthesis) (Operation (Expression Any))) - (do ////.monad - [@scope ///.anchor - argsO+ (monad.map @ generate argsS+)] +(def: #export (recur generate archive argsS+) + (Generator (List Synthesis)) + (do ///////phase.monad + [@scope /////generation.anchor + argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/primitive.lux index b437230ee..59efdb9fb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/primitive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/primitive.lux @@ -1,27 +1,15 @@ (.module: [lux (#- i64) - [control - [pipe (#+ cond> new>)]] - [data - [number - ["." frac]]] [target - ["_" ruby (#+ Literal)]]] - ["." // #_ - ["#." runtime]]) - -(def: #export bit - (-> Bit Literal) - _.bool) - -(def: #export i64 - (-> (I64 Any) Literal) - (|>> .int _.int)) - -(def: #export f64 - (-> Frac Literal) - _.float) - -(def: #export text - (-> Text Literal) - _.string) + ["_" ruby (#+ Literal)]]]) + +(template [<type> <name> <implementation>] + [(def: #export <name> + (-> <type> Literal) + <implementation>)] + + [Bit bit _.bool] + [(I64 Any) i64 (|>> .int _.int)] + [Frac f64 _.float] + [Text text _.string] + ) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux index 3a8e7e635..936f9249e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux @@ -2,9 +2,12 @@ [lux #* [target ["_" ruby (#+ Expression)]]] - [/// - ["." reference]]) + ["." /// #_ + ["#." reference]]) (def: #export system - (reference.system (: (-> Text (Expression Any)) _.global) - (: (-> Text (Expression Any)) _.local))) + (let [constant (: (-> Text (Expression Any)) + _.global) + variable (: (-> Text (Expression Any)) + _.local)] + (///reference.system constant variable))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index a4062693c..ab1607c26 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -18,26 +18,31 @@ [syntax (#+ syntax:)]] [target ["_" ruby (#+ Expression LVar Computation Literal Statement)]]] - ["." /// - ["//." // - [// - ["/////." name] - ["." synthesis]]]] - ) + ["." ///// #_ + ["#." synthesis] + ["#." generation] + ["//#" /// #_ + ["#." phase] + ["#." name] + [meta + [archive (#+ Archive)]]]]) (template [<name> <base>] [(type: #export <name> (<base> LVar (Expression Any) (Statement Any)))] - [Operation ///.Operation] - [Phase ///.Phase] - [Handler ///.Handler] - [Bundle ///.Bundle] + [Operation /////generation.Operation] + [Phase /////generation.Phase] + [Handler /////generation.Handler] + [Bundle /////generation.Bundle] ) +(type: #export (Generator i) + (-> Phase Archive i (Operation (Expression Any)))) + (def: prefix Text "LuxRuntime") -(def: #export unit (_.string synthesis.unit)) +(def: #export unit (_.string /////synthesis.unit)) (def: (flag value) (-> Bit Literal) @@ -77,7 +82,7 @@ (def: runtime-name (-> Text LVar) - (|>> /////name.normalize + (|>> ///////name.normalize (format ..prefix "_") _.local)) @@ -90,7 +95,7 @@ (wrap (list (` (let [(~+ (|> vars (list@map (function (_ var) (list (code.local-identifier var) - (` (_.local (~ (code.text (/////name.normalize var)))))))) + (` (_.local (~ (code.text (///////name.normalize var)))))))) list.concat))] (~ body)))))) @@ -288,8 +293,8 @@ (def: #export generate (Operation Any) - (///.with-buffer - (do ////.monad - [_ (///.save! true ["" ..prefix] - ..runtime)] - (///.save-buffer! ..artifact)))) + (/////generation.with-buffer + (do ///////phase.monad + [_ (/////generation.save! true ["" ..prefix] + ..runtime)] + (/////generation.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux index a929f736c..d8eba5932 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux @@ -5,32 +5,32 @@ [target ["_" ruby (#+ Expression)]]] ["." // #_ - ["#." runtime (#+ Operation Phase)] + ["#." runtime (#+ Operation Phase Generator)] ["#." primitive] - ["#//" /// - ["#/" // #_ - [analysis (#+ Variant Tuple)] - ["#." synthesis (#+ Synthesis)]]]]) + ["///#" //// #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)] + ["//#" /// #_ + ["#." phase ("#@." monad)]]]]) -(def: #export (tuple generate elemsS+) - (-> Phase (Tuple Synthesis) (Operation (Expression Any))) +(def: #export (tuple generate archive elemsS+) + (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (:: ////.monad wrap (//primitive.text /////synthesis.unit)) + (///////phase@wrap (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) - (generate singletonS) + (generate archive singletonS) _ (|> elemsS+ - (monad.map ////.monad generate) - (:: ////.monad map _.array)))) + (monad.map ///////phase.monad (generate archive)) + (///////phase@map _.array)))) -(def: #export (variant generate [lefts right? valueS]) - (-> Phase (Variant Synthesis) (Operation (Expression Any))) - (:: ////.monad map - (//runtime.variant (if right? - (inc lefts) - lefts) - right?) - (generate valueS))) +(def: #export (variant generate archive [lefts right? valueS]) + (Generator (Variant Synthesis)) + (let [tag (if right? + (inc lefts) + lefts)] + (///////phase@map (//runtime.variant tag right?) + (generate archive valueS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux index 83402a0d4..572db842f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -42,49 +42,50 @@ [#///analysis.Int #/.I64] [#///analysis.Rev #/.I64]))) -(def: #export (phase analysis) +(def: #export (phase archive) Phase - (case analysis - (#///analysis.Primitive analysis') - (phase@wrap (#/.Primitive (..primitive analysis'))) + (function (phase' analysis) + (case analysis + (#///analysis.Primitive analysis') + (phase@wrap (#/.Primitive (..primitive analysis'))) - (#///analysis.Structure structure) - (case structure - (#///analysis.Variant variant) - (do phase.monad - [valueS (phase (get@ #///analysis.value variant))] - (wrap (/.variant (set@ #///analysis.value valueS variant)))) + (#///analysis.Structure structure) + (case structure + (#///analysis.Variant variant) + (do phase.monad + [valueS (phase' (get@ #///analysis.value variant))] + (wrap (/.variant (set@ #///analysis.value valueS variant)))) - (#///analysis.Tuple tuple) - (|> tuple - (monad.map phase.monad phase) - (phase@map (|>> /.tuple)))) - - (#///analysis.Reference reference) - (phase@wrap (#/.Reference reference)) + (#///analysis.Tuple tuple) + (|> tuple + (monad.map phase.monad phase') + (phase@map (|>> /.tuple)))) + + (#///analysis.Reference reference) + (phase@wrap (#/.Reference reference)) - (#///analysis.Case inputA branchesAB+) - (/case.synthesize phase inputA branchesAB+) + (#///analysis.Case inputA branchesAB+) + (/case.synthesize phase branchesAB+ archive inputA) - (^ (///analysis.no-op value)) - (phase value) + (^ (///analysis.no-op value)) + (phase' value) - (#///analysis.Apply _) - (/function.apply phase analysis) + (#///analysis.Apply _) + (/function.apply phase archive analysis) - (#///analysis.Function environmentA bodyA) - (/function.abstraction phase environmentA bodyA) + (#///analysis.Function environmentA bodyA) + (/function.abstraction phase environmentA archive bodyA) - (#///analysis.Extension name args) - (function (_ state) - (|> (//extension.apply phase [name args]) - (phase.run' state) - (case> (#try.Success output) - (#try.Success output) - - (#try.Failure _) - (<| (phase.run' state) - (do phase.monad - [argsS+ (monad.map @ phase args)] - (wrap (#/.Extension [name argsS+]))))))) - )) + (#///analysis.Extension name args) + (function (_ state) + (|> (//extension.apply archive phase [name args]) + (phase.run' state) + (case> (#try.Success output) + (#try.Success output) + + (#try.Failure _) + (<| (phase.run' state) + (do phase.monad + [argsS+ (monad.map @ phase' args)] + (wrap (#/.Extension [name argsS+]))))))) + ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index e02f5d3b6..56a0a1f2e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -21,7 +21,9 @@ ["/" synthesis (#+ Path Synthesis Operation Phase)] [/// ["#." reference (#+ Variable)] - ["#" phase ("#@." monad)]]]]) + ["#" phase ("#@." monad)] + [meta + [archive (#+ Archive)]]]]]) (def: clean-up (-> Path Path) @@ -74,9 +76,9 @@ (list.reverse (list.enumerate tuple)))) )) -(def: #export (path synthesize pattern bodyA) - (-> Phase Pattern Analysis (Operation Path)) - (path' pattern true (///@map (|>> #/.Then) (synthesize bodyA)))) +(def: #export (path archive synthesize pattern bodyA) + (-> Archive Phase Pattern Analysis (Operation Path)) + (path' pattern true (///@map (|>> #/.Then) (synthesize archive bodyA)))) (def: #export (weave leftP rightP) (-> Path Path Path) @@ -124,10 +126,10 @@ _ <default>))) -(def: #export (synthesize synthesize^ inputA [headB tailB+]) - (-> Phase Analysis Match (Operation Synthesis)) +(def: #export (synthesize synthesize^ [headB tailB+] archive inputA) + (-> Phase Match Phase) (do ///.monad - [inputS (synthesize^ inputA)] + [inputS (synthesize^ archive inputA)] (with-expansions [<unnecesary-let> (as-is (^multi (^ (#///analysis.Reference (///reference.local outputR))) (n.= inputR outputR)) @@ -142,7 +144,7 @@ _ (do @ [headB/bodyS (/.with-new-local - (synthesize^ headB/bodyA))] + (synthesize^ archive headB/bodyA))] (wrap (/.branch/let [inputS inputR headB/bodyS]))))) <if> @@ -151,8 +153,8 @@ (^ [[(///analysis.pattern/bit #0) elseA] (list [(///analysis.pattern/bit #1) thenA])])) (do @ - [thenS (synthesize^ thenA) - elseS (synthesize^ elseA)] + [thenS (synthesize^ archive thenA) + elseS (synthesize^ archive elseA)] (wrap (/.branch/if [inputS thenS elseS])))) <case> @@ -165,8 +167,8 @@ _ (undefined)))] (do @ - [lastSP (path synthesize^ lastP lastA) - prevsSP+ (monad.map @ (product.uncurry (path synthesize^)) prevsPA)] + [lastSP (path archive synthesize^ lastP lastA) + prevsSP+ (monad.map @ (product.uncurry (path archive synthesize^)) prevsPA)] (wrap (/.branch/case [inputS (list@fold weave lastSP prevsSP+)])))))] (case [headB tailB+] <let> diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 91cea2d9d..7fe35a6c3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -42,11 +42,11 @@ (def: #export (apply phase) (-> Phase Phase) - (function (_ exprA) + (function (_ archive exprA) (let [[funcA argsA] (////analysis.application exprA)] (do phase.monad - [funcS (phase funcA) - argsS (monad.map @ phase argsA) + [funcS (phase archive funcA) + argsS (monad.map @ (phase archive) argsA) ## locals /.locals ] (with-expansions [<apply> (as-is (/.function/apply [funcS argsS]))] @@ -201,10 +201,10 @@ _ (phase@wrap expression))) -(def: #export (abstraction phase environment bodyA) - (-> Phase Environment Analysis (Operation Synthesis)) +(def: #export (abstraction phase environment archive bodyA) + (-> Phase Environment Phase) (do phase.monad - [bodyS (phase bodyA)] + [bodyS (phase archive bodyA)] (case bodyS (^ (/.function/abstraction [env' down-arity' bodyS'])) (|> bodyS' diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux new file mode 100644 index 000000000..222bb2479 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux @@ -0,0 +1,48 @@ +(.module: + [lux #* + [data + ["." text] + [collection + ["." row (#+ Row)] + ["." dictionary (#+ Dictionary)]]] + [type + abstract]]) + +(type: #export ID Nat) + +(type: Artifact + (#Resource ID) + (#Definition [ID Text])) + +(abstract: #export Registry + {} + {#next ID + #artifacts (Row Artifact) + #resolver (Dictionary Text ID)} + + (def: #export empty + Registry + (:abstraction {#next 0 + #artifacts row.empty + #resolver (dictionary.new text.hash)})) + + (def: #export (resource registry) + (-> Registry [ID Registry]) + (let [id (get@ #next (:representation registry))] + [id + (|> registry + :representation + (update@ #next inc) + (update@ #artifacts (row.add (#Resource id))) + :abstraction)])) + + (def: #export (definition name registry) + (-> Text Registry [ID Registry]) + (let [id (get@ #next (:representation registry))] + [id + (|> registry + :representation + (update@ #next inc) + (update@ #artifacts (row.add (#Definition id name))) + :abstraction)])) + ) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux index 5daf10016..4582ab702 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux @@ -4,7 +4,9 @@ [collection [set (#+ Set)]]] [world - [file (#+ Path)]]]) + [file (#+ Path)]]] + [// + [artifact (#+ Registry)]]) (type: #export Module Text) @@ -13,4 +15,5 @@ #name Module #file Path #references (Set Module) - #state Module-State}) + #state Module-State + #registry Registry}) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index dddac7e49..1280a9591 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -9,10 +9,10 @@ [security ["!" capability]] [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise) ("#@." monad)]]] [data [binary (#+ Binary)] - ["." text ("#;." hash) + ["." text ("#@." hash) ["%" format (#+ format)] ["." encoding]]] [world @@ -31,7 +31,8 @@ [cannot-read-module] ) -(type: #export Extension Text) +(type: #export Extension + Text) (def: lux-extension Extension @@ -48,7 +49,7 @@ (Promise (Try [Path (File Promise)]))) (case contexts #.Nil - (:: promise.monad wrap (ex.throw ..cannot-find-module [module])) + (promise@wrap (ex.throw ..cannot-find-module [module])) (#.Cons context contexts') (do promise.monad @@ -62,9 +63,11 @@ (find-source-file system contexts' module extension))))) (def: #export (find-any-source-file system contexts partial-host-extension module) - (-> (file.System Promise) (List Context) Text Module + (-> (file.System Promise) (List Context) Extension Module (Promise (Try [Path (File Promise)]))) (let [full-host-extension (format partial-host-extension lux-extension)] + ## Preference is explicitly being given to Lux files that have a host extension. + ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. (do promise.monad [outcome (find-source-file system contexts module full-host-extension)] (case outcome @@ -75,7 +78,7 @@ (find-source-file system contexts module ..lux-extension))))) (def: #export (read system contexts partial-host-extension module) - (-> (file.System Promise) (List Context) Text Module + (-> (file.System Promise) (List Context) Extension Module (Promise (Try Input))) (do (try.with promise.monad) [[path file] (..find-any-source-file system contexts partial-host-extension module) @@ -84,8 +87,8 @@ (#try.Success code) (wrap {#////.module module #////.file path - #////.hash (text;hash code) + #////.hash (text@hash code) #////.code code}) (#try.Failure _) - (:: promise.monad wrap (ex.throw ..cannot-read-module [module]))))) + (promise@wrap (ex.throw ..cannot-read-module [module]))))) diff --git a/stdlib/source/lux/tool/compiler/phase.lux b/stdlib/source/lux/tool/compiler/phase.lux index 596d94f6b..68d6a4848 100644 --- a/stdlib/source/lux/tool/compiler/phase.lux +++ b/stdlib/source/lux/tool/compiler/phase.lux @@ -17,7 +17,10 @@ ["." instant] ["." duration]] [macro - [syntax (#+ syntax:)]]]) + [syntax (#+ syntax:)]]] + [// + [meta + [archive (#+ Archive)]]]) (type: #export (Operation s o) (state.State' Try s o)) @@ -27,7 +30,7 @@ (state.with try.monad)) (type: #export (Phase s i o) - (-> i (Operation s o))) + (-> Archive i (Operation s o))) (def: #export (run' state operation) (All [s o] @@ -83,7 +86,7 @@ (def: #export identity (All [s a] (Phase s a a)) - (function (_ input state) + (function (_ archive input state) (#try.Success [state input]))) (def: #export (compose pre post) @@ -91,10 +94,10 @@ (-> (Phase s0 i t) (Phase s1 t o) (Phase [s0 s1] i o))) - (function (_ input [pre/state post/state]) + (function (_ archive input [pre/state post/state]) (do try.monad - [[pre/state' temp] (pre input pre/state) - [post/state' output] (post temp post/state)] + [[pre/state' temp] (pre archive input pre/state) + [post/state' output] (post archive temp post/state)] (wrap [[pre/state' post/state'] output])))) (def: #export (timed definition description operation) |