diff options
Diffstat (limited to 'stdlib')
13 files changed, 330 insertions, 67 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 34ceb43ba..1c7969f99 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -5832,10 +5832,16 @@ (fail "Wrong syntax for undefined"))) (macro: #export (:of tokens) - {#.doc (doc "Generates the type corresponding to a given definition or variable." - (let [my-num (: Int +123)] + {#.doc (doc "Generates the type corresponding to a given expression." + "Example #1:" + (let [my-num +123] (:of my-num)) "==" + Int + "-------------------" + "Example #2:" + (:of +123) + "==" Int)} (case tokens (^ (list [_ (#Identifier var-name)])) @@ -5843,6 +5849,12 @@ [var-type (find-type var-name)] (wrap (list (type-to-code var-type)))) + (^ (list expression)) + (do Monad<Meta> + [g!temp (gensym "g!temp")] + (wrap (list (` (let [(~ g!temp) (~ expression)] + (..:of (~ g!temp))))))) + _ (fail "Wrong syntax for :of"))) diff --git a/stdlib/source/lux/compiler/default/phase.lux b/stdlib/source/lux/compiler/default/phase.lux index ae146be74..85567e45c 100644 --- a/stdlib/source/lux/compiler/default/phase.lux +++ b/stdlib/source/lux/compiler/default/phase.lux @@ -33,6 +33,22 @@ operation (:: error.Monad<Error> map product.right))) +(def: #export state + (All [s o] + (Operation s s)) + (function (_ state) + (#error.Success [state state]))) + +(def: #export (sub [get set] operation) + (All [s s' o] + (-> [(-> s s') (-> s' s s)] + (Operation s' o) + (Operation s o))) + (function (_ state) + (do error.Monad<Error> + [[state' output] (operation (get state))] + (wrap [(set state' state) output])))) + (def: #export fail (-> Text Operation) (|>> error.fail (state.lift error.Monad<Error>))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux index 72d2a3485..ccf46b873 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -51,20 +51,16 @@ (#Apply Analysis Analysis) (#Extension (Extension Analysis))) -(type: #export State+ - (extension.State .Lux Code Analysis)) - -(type: #export Operation - (extension.Operation .Lux Code Analysis)) - -(type: #export Phase - (extension.Phase .Lux Code Analysis)) - -(type: #export Handler - (extension.Handler .Lux .Code Analysis)) - -(type: #export Bundle - (extension.Bundle .Lux .Code Analysis)) +(do-template [<special> <general>] + [(type: #export <special> + (<general> .Lux Code Analysis))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) (type: #export Branch (Branch' Analysis)) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux index 61d3a2ec6..5812ef3d2 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/module.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux @@ -112,7 +112,7 @@ [state] #error.Success)))) (def: #export (define name definition) - (-> Text Definition (Operation [])) + (-> Text Definition (Operation Any)) (do ///.Monad<Operation> [self-name (extension.lift macro.current-module-name) self (extension.lift macro.current-module)] diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux index f894679ef..2977eb777 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux @@ -22,8 +22,7 @@ ["." primitive] ["." inference] ["/." // - ["." extension] - ["//." //]]]) + ["." extension]]]) (exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code}) (ex.report ["Type" (%type type)] diff --git a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux index e2d36fa73..4fe68b23c 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux @@ -8,7 +8,7 @@ format] [collection [list ("list/." Functor<List>)] - ["dict" dictionary (#+ Dictionary)]]]] + ["." dictionary (#+ Dictionary)]]]] [// (#+ Handler Bundle)]) (exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) @@ -22,17 +22,17 @@ ## [Utils] (def: #export empty Bundle - (dict.new text.Hash<Text>)) + (dictionary.new text.Hash<Text>)) (def: #export (install name anonymous) (All [s i o] (-> Text (Handler s i o) (-> (Bundle s i o) (Bundle s i o)))) - (dict.put name anonymous)) + (dictionary.put name anonymous)) (def: #export (prefix prefix) (All [s i o] (-> Text (-> (Bundle s i o) (Bundle s i o)))) - (|>> dict.entries + (|>> dictionary.entries (list/map (function (_ [key val]) [(format prefix " " key) val])) - (dict.from-list text.Hash<Text>))) + (dictionary.from-list text.Hash<Text>))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux new file mode 100644 index 000000000..2c2bf4464 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux @@ -0,0 +1,184 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + pipe] + [data + [collection + [list ("list/." Functor<List>)] + ["." dictionary]]] + ["." macro] + [type (#+ :share) + ["." check]]] + [// + ["/." // (#+ Eval) + ["." analysis + ["." module] + ["." type]] + ["." synthesis] + ["." translation] + ["." statement (#+ Operation Handler Bundle)] + ["." extension + ["." bundle]] + [// + ["." evaluation]]]]) + +(do-template [<name> <component> <operation>] + [(def: (<name> operation) + (All [anchor expression statement output] + (-> (<operation> output) (Operation anchor expression statement output))) + (extension.lift + (///.sub [(get@ [<component> #statement.state]) + (set@ [<component> #statement.state])] + operation)))] + + [lift-analysis! #statement.analysis analysis.Operation] + [lift-synthesis! #statement.synthesis synthesis.Operation] + [lift-translation! #statement.translation (translation.Operation anchor expression statement)] + ) + +(def: (compile ?name ?type codeC) + (All [anchor expression statement] + (-> (Maybe Name) (Maybe Type) Code + (Operation anchor expression statement [Type expression Any]))) + (do ///.Monad<Operation> + [state (extension.lift ///.state) + #let [analyse (get@ [#statement.analysis #statement.phase] state) + synthesize (get@ [#statement.synthesis #statement.phase] state) + translate (get@ [#statement.translation #statement.phase] state)] + [_ code//type codeA] (lift-analysis! + (analysis.with-scope + (type.with-fresh-env + (case ?type + (#.Some type) + (type.with-type type + (do @ + [codeA (analyse codeC)] + (wrap [type codeA]))) + + #.None + (do @ + [[code//type codeA] (type.with-inference (analyse codeC)) + code//type (type.with-env + (check.clean code//type))] + (wrap [code//type codeA])))))) + codeS (lift-synthesis! + (synthesize codeA))] + (lift-translation! + (do @ + [codeT (translate codeS) + codeV (case ?name + (#.Some name) + (translation.define! name codeT) + + #.None + (translation.evaluate! codeT))] + (wrap [code//type codeT codeV]))))) + +(def: lux::def + Handler + (function (_ extension-name phase inputsC+) + (case inputsC+ + (^ (list [_ (#.Identifier ["" def-name])] valueC annotationsC)) + (do ///.Monad<Operation> + [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC) + #let [annotationsV (:coerce Code annotationsV)] + current-module (lift-analysis! + (extension.lift + macro.current-module-name)) + [value//type valueT valueV] (compile (#.Some [current-module def-name]) + (if (macro.type? annotationsV) + (#.Some Type) + #.None) + valueC)] + (lift-analysis! + (do @ + [_ (module.define def-name [value//type annotationsV valueV])] + (if (macro.type? annotationsV) + (case (macro.declared-tags annotationsV) + #.Nil + (wrap []) + + tags + (module.declare-tags tags (macro.export? annotationsV) (:coerce Type valueV))) + (wrap []))))) + + _ + (///.throw bundle.invalid-syntax [extension-name])))) + +(def: (alias! alias def-name) + (-> Text Name (analysis.Operation Any)) + (do ///.Monad<Operation> + [definition (extension.lift (macro.find-def def-name))] + (module.define alias definition))) + +(def: def::alias + Handler + (function (_ extension-name phase inputsC+) + (case inputsC+ + (^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)])) + (extension.lift + (///.sub [(get@ [#statement.analysis #statement.state]) + (set@ [#statement.analysis #statement.state])] + (alias! alias def-name))) + + _ + (///.throw bundle.invalid-syntax [extension-name])))) + +(do-template [<mame> <type> <scope>] + [(def: <mame> + (All [anchor expression statement] + (Handler anchor expression statement)) + (function (handler extension-name phase inputsC+) + (case inputsC+ + (^ (list [_ (#.Text name)] valueC)) + (do ///.Monad<Operation> + [[_ handlerT handlerV] (compile #.None + (#.Some (:of (:share [anchor expression statement] + {(Handler anchor expression statement) + handler} + {<type> + (:assume [])}))) + valueC)] + (<| <scope> + (extension.install name) + (:share [anchor expression statement] + {(Handler anchor expression statement) + handler} + {<type> + (:assume handlerV)}))) + + _ + (///.throw bundle.invalid-syntax [extension-name]))))] + + [def::analysis analysis.Handler lift-analysis!] + [def::synthesis synthesis.Handler + (<| extension.lift + (///.sub [(get@ [#statement.synthesis #statement.state]) + (set@ [#statement.synthesis #statement.state])]))] + [def::translation (translation.Handler anchor expression statement) + (<| extension.lift + (///.sub [(get@ [#statement.translation #statement.state]) + (set@ [#statement.translation #statement.state])]))] + + [def::statement (Handler anchor expression statement) + (<|)] + ) + +(def: bundle::def + Bundle + (<| (bundle.prefix "def") + (|> bundle.empty + (dictionary.put "alias" def::alias) + (dictionary.put "analysis" def::analysis) + (dictionary.put "synthesis" def::synthesis) + (dictionary.put "translation" def::translation) + (dictionary.put "statement" def::statement) + ))) + +(def: #export bundle + Bundle + (<| (bundle.prefix "lux") + (|> bundle.empty + (dictionary.put "def" lux::def) + (dictionary.merge ..bundle::def)))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux index d907808a8..1a2e44f6f 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux @@ -1,10 +1,10 @@ (.module: - [lux #* - [data - [text] - [collection ["dict" dictionary (#+ Dictionary)]]]] - [//]) + [lux #*] + [// + ["." bundle] + [// + [synthesis (#+ Bundle)]]]) -(def: #export defaults - (Dictionary Text //.Synthesis) - (dict.new text.Hash<Text>)) +(def: #export bundle + Bundle + bundle.empty) diff --git a/stdlib/source/lux/compiler/default/phase/extension/translation.lux b/stdlib/source/lux/compiler/default/phase/extension/translation.lux index 3a43e0dcb..232c8c168 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/translation.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/translation.lux @@ -1,10 +1,10 @@ (.module: - [lux #* - [data - [text] - [collection ["dict" dictionary (#+ Dictionary)]]]] - [//]) + [lux #*] + [// + ["." bundle] + [// + [translation (#+ Bundle)]]]) -(def: #export defaults - (Dictionary Text //.Translation) - (dict.new text.Hash<Text>)) +(def: #export bundle + Bundle + bundle.empty) diff --git a/stdlib/source/lux/compiler/default/phase/statement.lux b/stdlib/source/lux/compiler/default/phase/statement.lux new file mode 100644 index 000000000..638f29b80 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/statement.lux @@ -0,0 +1,55 @@ +(.module: + [lux #*] + [// (#+ Eval) + ["." analysis + [".A" expression]] + ["." synthesis + [".S" expression]] + ["." translation (#+ Host)] + ["." extension + ["." bundle] + [".E" analysis] + [".E" synthesis] + [".E" translation] + ## [".E" statement] + ] + [// + ["." init]]]) + +(type: #export (Component state phase) + {#state state + #phase phase}) + +(type: #export (State anchor expression statement) + {#analysis (Component analysis.State+ + analysis.Phase) + #synthesis (Component synthesis.State+ + synthesis.Phase) + #translation (Component (translation.State+ anchor expression statement) + (translation.Phase anchor expression statement))}) + +(do-template [<special> <general>] + [(type: #export (<special> anchor expression statement) + (<general> (..State anchor expression statement) Code Any))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) + +(def: #export (state eval translate host) + (All [anchor expression statement] + (-> Eval + (translation.Phase anchor expression statement) + (Host expression statement) + (..State+ anchor expression statement))) + [bundle.empty + ## statementE.bundle + {#analysis {#state [analysisE.bundle (init.compiler [])] + #phase (expressionA.analyser eval)} + #synthesis {#state [synthesisE.bundle synthesis.init] + #phase expressionS.synthesize} + #translation {#state [translationE.bundle (translation.state host)] + #phase translate}}]) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux index 2ee018be4..29c2189c3 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux @@ -98,14 +98,16 @@ (#Control (Control Synthesis)) (#Extension (Extension Synthesis))) -(type: #export State+ - (extension.State ..State Analysis Synthesis)) - -(type: #export Operation - (extension.Operation ..State Analysis Synthesis)) - -(type: #export Phase - (extension.Phase ..State Analysis Synthesis)) +(do-template [<special> <general>] + [(type: #export <special> + (<general> ..State Analysis Synthesis))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) (type: #export Path (Path' Synthesis)) diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux index d8a58ca84..3bf09937f 100644 --- a/stdlib/source/lux/compiler/default/phase/translation.lux +++ b/stdlib/source/lux/compiler/default/phase/translation.lux @@ -73,20 +73,16 @@ #counter Nat #name-cache (Dictionary Name Text)}) -(type: #export (State+ anchor expression statement) - (extension.State (State anchor expression statement) Synthesis expression)) - -(type: #export (Operation anchor expression statement) - (extension.Operation (State anchor expression statement) Synthesis expression)) - -(type: #export (Phase anchor expression statement) - (extension.Phase (State anchor expression statement) Synthesis expression)) - -(type: #export (Handler anchor expression statement) - (extension.Handler (State anchor expression statement) Synthesis expression)) - -(type: #export (Bundle anchor expression statement) - (extension.Bundle (State anchor expression statement) Synthesis expression)) +(do-template [<special> <general>] + [(type: #export (<special> anchor expression statement) + (<general> (State anchor expression statement) Synthesis expression))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) (def: #export (state host) (All [anchor expression statement] diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 350a0e913..702f7f342 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -42,7 +42,7 @@ [compiler [host [".H" scheme]] - [default + ["._" default ["._" evaluation] [phase ["._" translation @@ -55,7 +55,9 @@ ["._scheme" case] ["._scheme" extension] ["._scheme" extension/common] - ["._scheme" expression]]]] + ["._scheme" expression]]] + [extension + ["._" statement]]] ["._default" cache] [repl ["._" type]]] @@ -65,6 +67,7 @@ ["._meta_io" archive]] ["._meta" archive] ["._meta" cache]]]] + ## TODO: Must have 100% coverage on tests. [test ["_." lux] [lux @@ -104,7 +107,7 @@ ["_." product] ["_." sum] [number - ## "_." number ## TODO: Specially troublesome... + ## "_." number ## TODO: FIX Specially troublesome... ["_." i64] ["_." ratio] ["_." complex]] @@ -145,7 +148,7 @@ ["poly_." functor]]] ["_." type ["_." check] - ## ["_." implicit] ## TODO: Specially troublesome... + ## ["_." implicit] ## TODO: FIX Specially troublesome... ["_." resource]] [compiler [default @@ -166,7 +169,7 @@ ["_.S" function]]]]] [world ["_." binary] - ## ["_." file] ## TODO: Specially troublesome... + ## ["_." file] ## TODO: FIX Specially troublesome... [net ["_." tcp] ["_." udp]]]]] |