diff options
Diffstat (limited to 'stdlib/source')
13 files changed, 194 insertions, 123 deletions
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index 190eee760..f06a235de 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -109,7 +109,8 @@ #let [[cursor _] code] _ (analysis.set-cursor cursor)] (wrap code))) - _ (totalS.phase code)] + _ (totalS.phase code) + _ init.refresh] (forgive-eof (recur [])))))) (def: (perform-module-compilation module-name source) diff --git a/stdlib/source/lux/compiler/default/evaluation.lux b/stdlib/source/lux/compiler/default/evaluation.lux index d93feca93..3fb1a9984 100644 --- a/stdlib/source/lux/compiler/default/evaluation.lux +++ b/stdlib/source/lux/compiler/default/evaluation.lux @@ -3,7 +3,9 @@ [control [monad (#+ do)]] [data - ["." error]]] + ["." error] + [text + format]]] [// ["." phase [analysis (#+ Operation) @@ -14,7 +16,7 @@ ["." translation]]]) (type: #export Eval - (-> Type Code (Operation Any))) + (-> Nat Type Code (Operation Any))) (def: #export (evaluator synthesis-state translation-state translate) (All [anchor expression statement] @@ -22,7 +24,7 @@ (translation.State+ anchor expression statement) (translation.Phase anchor expression statement) Eval)) - (function (eval type exprC) + (function (eval count type exprC) (do phase.Monad<Operation> [exprA (type.with-type type (expressionA.compile exprC))] @@ -31,4 +33,4 @@ (phase.run translation-state (do phase.Monad<Operation> [exprO (translate exprS)] - (translation.evaluate! exprO)))))))) + (translation.evaluate! (format "eval" (%n count)) exprO)))))))) diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux index e30f5c551..947dc9d4b 100644 --- a/stdlib/source/lux/compiler/default/init.lux +++ b/stdlib/source/lux/compiler/default/init.lux @@ -1,9 +1,13 @@ (.module: - lux + [lux #* + [control + [monad (#+ do)]] + [data + ["." product]]] [// ["." evaluation] - [phase - [analysis + ["." phase + ["." analysis [".A" expression]] ["." synthesis [".S" expression]] @@ -84,3 +88,18 @@ #statement.phase expressionS.synthesize} #statement.translation {#statement.state translation-state #statement.phase translate}}])) + +(def: #export refresh + (All [anchor expression statement] + (statement.Operation anchor expression statement Any)) + (do phase.Monad<Operation> + [[bundle state] phase.get-state + #let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state) + (get@ [#statement.translation #statement.state] state) + (get@ [#statement.translation #statement.phase] state))]] + (phase.set-state [statementE.bundle + (update@ [#statement.analysis #statement.state] + (: (-> analysis.State+ analysis.State+) + (|>> product.right + [(analysisE.bundle eval)])) + state)]))) diff --git a/stdlib/source/lux/compiler/default/phase.lux b/stdlib/source/lux/compiler/default/phase.lux index 920d81996..25ceea746 100644 --- a/stdlib/source/lux/compiler/default/phase.lux +++ b/stdlib/source/lux/compiler/default/phase.lux @@ -33,12 +33,18 @@ operation (:: error.Monad<Error> map product.right))) -(def: #export state +(def: #export get-state (All [s o] (Operation s s)) (function (_ state) (#error.Success [state state]))) +(def: #export (set-state state) + (All [s o] + (-> s (Operation s Any))) + (function (_ _) + (#error.Success [state []]))) + (def: #export (sub [get set] operation) (All [s s' o] (-> [(-> s s') (-> s' s s)] diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux index 578560d11..19ef64af2 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -281,7 +281,8 @@ output]) (#error.Error error) - (#error.Error error)))))) + (#error.Error (format "@ " (%cursor cursor) "\n" + error))))))) (do-template [<name> <type> <field> <value>] [(def: #export (<name> value) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux index e46576201..c3c3ee619 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux @@ -4,7 +4,7 @@ [monad (#+ do)] ["ex" exception (#+ exception:)]] [data - ["e" error] + ["." error] [text format]] ["." macro]] @@ -12,13 +12,14 @@ ["." type] ["." primitive] ["." structure] - ["." reference] + ["//." reference] ["." case] + ["." function] + ["//." macro] ["/." // ["." extension] [// - ## [".L" macro] - ]]]) + ["." reference]]]]) (exception: #export (macro-expansion-failed {message Text}) message) @@ -78,7 +79,7 @@ (structure.record compile pairs) (#.Identifier reference) - (reference.reference reference) + (//reference.reference reference) (^ (#.Form (list [_ (#.Record branches)] input))) (case.case compile input branches) @@ -86,38 +87,45 @@ (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) (extension.apply compile [extension-name extension-args]) - ## (^ (#.Form (list& func args))) - ## (do ///.Monad<Operation> - ## [[funcT funcA] (type.with-inference - ## (compile func))] - ## (case funcA - ## [_ (#.Identifier def-name)] - ## (do @ - ## [?macro (///.with-error-tracking - ## (extension.lift (macro.find-macro def-name)))] - ## (case ?macro - ## (#.Some macro) - ## (do @ - ## [expansion (: (Operation (List Code)) - ## (function (_ state) - ## (case (macroL.expand macro args state) - ## (#e.Error error) - ## ((///.throw macro-expansion-failed error) state) - - ## output - ## output)))] - ## (case expansion - ## (^ (list single)) - ## (compile single) - - ## _ - ## (///.throw macro-call-must-have-single-expansion code))) - - ## _ - ## (functionA.apply compile funcT funcA args))) - - ## _ - ## (functionA.apply compile funcT funcA args))) + (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] + [_ (#.Identifier ["" arg-name])]))] + body))) + (function.function compile function-name arg-name body) + + (^ (#.Form (list& functionC argsC+))) + (do @ + [[functionT functionA] (type.with-inference + (compile functionC))] + (case functionA + (#//.Reference (#reference.Constant def-name)) + (do @ + [?macro (extension.lift (macro.find-macro def-name))] + (case ?macro + (#.Some macro) + (do @ + [#let [_ (log! (format (%name def-name) " @@@ " + (%list %code argsC+)))] + expansion (: (Operation (List Code)) + (extension.lift + (function (_ state) + (case (//macro.expand macro argsC+ state) + (#error.Error error) + ((///.throw macro-expansion-failed error) state) + + output + output))))] + (case expansion + (^ (list single)) + (compile single) + + _ + (///.throw macro-call-must-have-single-expansion code))) + + _ + (function.apply compile functionT functionA argsC+))) + + _ + (function.apply compile functionT functionA argsC+))) _ (///.throw unrecognized-syntax code) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/function.lux b/stdlib/source/lux/compiler/default/phase/analysis/function.lux index 13a377df3..1f0e4c8f9 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/function.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/function.lux @@ -26,7 +26,7 @@ ["Body" (%code body)])) (exception: #export (cannot-apply {function Type} {arguments (List Code)}) - (ex.report [" Function" (%type function)] + (ex.report ["Function" (%type function)] ["Arguments" (|> arguments list.enumerate (list/map (.function (_ [idx argC]) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/macro.lux b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux new file mode 100644 index 000000000..c37375805 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux @@ -0,0 +1,44 @@ +(.module: + [lux #* + [control + [monad (#+ do)]] + [data + ["." error (#+ Error)] + [collection + ["." array (#+ Array)]]] + ["." host (#+ import:)]]) + +(import: java/lang/reflect/Method + (invoke [Object (Array Object)] #try Object)) + +(import: (java/lang/Class c) + (getMethod [String (Array (Class Object))] #try Method)) + +(import: java/lang/Object + (getClass [] (Class Object))) + +(def: _object-class + (Class Object) + (host.class-for Object)) + +(def: _apply-args + (Array (Class Object)) + (|> (host.array (Class Object) 2) + (host.array-write 0 _object-class) + (host.array-write 1 _object-class))) + +(def: #export (expand macro inputs) + (-> Macro (List Code) (Meta (List Code))) + (function (_ compiler) + (do error.Monad<Error> + [apply-method (|> macro + (:coerce Object) + (Object::getClass []) + (Class::getMethod ["apply" _apply-args])) + output (Method::invoke [(:coerce Object macro) + (|> (host.array Object 2) + (host.array-write 0 (:coerce Object inputs)) + (host.array-write 1 (:coerce Object compiler)))] + apply-method)] + (:coerce (Error [Lux (List Code)]) + output)))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 0d1148fbd..59a99800b 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -7,9 +7,10 @@ format] [collection ["." list ("list/." Functor<List>)] - ["dict" dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]]] [type ["." check]] + ["." macro] [io (#+ IO)]] ["." /// ["." bundle] @@ -99,8 +100,9 @@ (case args (^ (list typeC valueC)) (do ////.Monad<Operation> - [actualT (:: @ map (|>> (:coerce Type)) - (eval Type typeC)) + [count (///.lift macro.count) + actualT (:: @ map (|>> (:coerce Type)) + (eval count Type typeC)) _ (typeA.infer actualT)] (typeA.with-type <type> (analyse valueC))) @@ -207,10 +209,10 @@ (-> Eval Bundle) (<| (bundle.prefix "lux") (|> bundle.empty - (dict.merge (bundle::lux eval)) - (dict.merge bundle::bit) - (dict.merge bundle::int) - (dict.merge bundle::frac) - (dict.merge bundle::text) - (dict.merge bundle::io) + (dictionary.merge (bundle::lux eval)) + (dictionary.merge bundle::bit) + (dictionary.merge bundle::int) + (dictionary.merge bundle::frac) + (dictionary.merge bundle::text) + (dictionary.merge bundle::io) ))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux index 7daf27227..afc7c843c 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/statement.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux @@ -26,7 +26,7 @@ (All [anchor expression statement] (-> Type Code (Operation anchor expression statement [Type expression Any]))) (do ///.Monad<Operation> - [state (extension.lift ///.state) + [state (extension.lift ///.get-state) #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) translate (get@ [#statement.translation #statement.phase] state)] @@ -40,17 +40,19 @@ codeS (statement.lift-synthesis (synthesize codeA))] (statement.lift-translation - (do @ - [codeT (translate codeS) - codeV (translation.evaluate! codeT)] - (wrap [code//type codeT codeV]))))) + (translation.with-buffer + (do @ + [codeT (translate codeS) + count translation.next + codeV (translation.evaluate! (format "evaluate" (%n count)) codeT)] + (wrap [code//type codeT codeV])))))) (def: (define! name ?type codeC) (All [anchor expression statement] (-> Name (Maybe Type) Code (Operation anchor expression statement [Type expression Text Any]))) (do ///.Monad<Operation> - [state (extension.lift ///.state) + [state (extension.lift ///.get-state) #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) translate (get@ [#statement.translation #statement.phase] state)] @@ -73,10 +75,11 @@ codeS (statement.lift-synthesis (synthesize codeA))] (statement.lift-translation - (do @ - [codeT (translate codeS) - codeN+V (translation.define! name codeT)] - (wrap [code//type codeT codeN+V]))))) + (translation.with-buffer + (do @ + [codeT (translate codeS) + codeN+V (translation.define! name codeT)] + (wrap [code//type codeT codeN+V])))))) (def: lux::def Handler @@ -97,8 +100,7 @@ valueC) _ (statement.lift-analysis (do @ - [_ (module.define def-name [value//type annotationsV valueV]) - #let [_ (log! (format "Definition " (%name full-name)))]] + [_ (module.define def-name [value//type annotationsV valueV])] (if (macro.type? annotationsV) (case (macro.declared-tags annotationsV) #.Nil @@ -106,7 +108,8 @@ tags (module.declare-tags tags (macro.export? annotationsV) (:coerce Type valueV))) - (wrap []))))] + (wrap [])))) + #let [_ (log! (format "Definition " (%name full-name)))]] (statement.lift-translation (translation.learn full-name valueN))) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux index 8a85b9873..3c89ae063 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux @@ -1,13 +1,9 @@ (.module: [lux (#- function) [control - ["." monad (#+ do)] - ["." state] - pipe - ["ex" exception (#+ exception:)]] + ["." monad (#+ do)]] [data - ["." maybe ("maybe/." Monad<Maybe>)] - ["." error] + ["." maybe] [collection ["." list ("list/." Functor<List> Monoid<List> Fold<List>)] ["dict" dictionary (#+ Dictionary)]]]] @@ -48,7 +44,7 @@ (-> Phase Phase) (.function (_ exprA) (let [[funcA argsA] (unfold exprA)] - (do (state.Monad<State'> error.Monad<Error>) + (do ///.Monad<Operation> [funcS (synthesize funcA) argsS (monad.map @ synthesize argsA) locals //.locals] @@ -64,23 +60,11 @@ _ (wrap (//.function/apply [funcS argsS]))))))) -(def: (prepare up down) - (-> Arity Arity (Transform Synthesis)) - (.function (_ body) - (if (nested? up) - (#.Some body) - (loop.recursion down body)))) - -(exception: #export (cannot-prepare-function-body {_ []}) - "") - -(def: return - (All [a] (-> (Maybe a) (Operation a))) - (|>> (case> (#.Some output) - (:: ///.Monad<Operation> wrap output) - - #.None - (///.throw cannot-prepare-function-body [])))) +(def: (prepare up down body) + (-> Arity Arity Synthesis Synthesis) + (if (nested? up) + body + (maybe.default body (loop.recursion down body)))) (def: #export (function synthesize environment body) (-> Phase Environment Analysis (Operation Synthesis)) @@ -127,10 +111,10 @@ (^ (//.function/abstraction [env' down-arity' bodyS'])) (let [arity' (inc down-arity')] (|> (prepare function-arity arity' bodyS') - (maybe/map (|>> [up-environment arity'] //.function/abstraction)) - ..return)) + [up-environment arity'] //.function/abstraction + wrap)) _ (|> (prepare function-arity 1 bodyS) - (maybe/map (|>> [up-environment 1] //.function/abstraction)) - ..return)))) + [up-environment 1] //.function/abstraction + wrap)))) diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux index 3cca0c060..1dcd351c8 100644 --- a/stdlib/source/lux/compiler/default/phase/translation.lux +++ b/stdlib/source/lux/compiler/default/phase/translation.lux @@ -2,8 +2,7 @@ [lux #* [control ["ex" exception (#+ exception:)] - [monad (#+ do)] - pipe] + [monad (#+ do)]] [data ["." product] ["." error (#+ Error)] @@ -168,26 +167,21 @@ (All [anchor expression statement] (Operation anchor expression statement Nat)) (do //.Monad<Operation> - [_ (extension.update (update@ #counter inc))] - (extension.read (get@ #counter)))) - -(def: (temp-label state) - (All [anchor expression statement] - (-> (State anchor expression statement) Text)) - (format (get@ [#context #scope-name] state) " " (%n (get@ #counter state)))) + [count (extension.read (get@ #counter)) + _ (extension.update (update@ #counter inc))] + (wrap count))) (do-template [<name> <inputT>] - [(def: #export (<name> code) + [(def: #export (<name> label code) (All [anchor expression statement] - (-> <inputT> (Operation anchor expression statement Any))) - (function (_ [bundle state]) - (case (:: (get@ #host state) <name> (temp-label state) code) + (-> Text <inputT> (Operation anchor expression statement Any))) + (function (_ (^@ state+ [bundle state])) + (case (:: (get@ #host state) <name> label code) (#error.Error error) (ex.throw cannot-interpret error) (#error.Success output) - (#error.Success [[bundle (update@ #counter inc state)] - output]))))] + (#error.Success [state+ output]))))] [evaluate! expression] [execute! statement] @@ -208,7 +202,8 @@ (All [anchor expression statement] (-> Name statement (Operation anchor expression statement Any))) (do //.Monad<Operation> - [_ (execute! code) + [count ..next + _ (execute! (format "save" (%n count)) code) ?buffer (extension.read (get@ #buffer))] (case ?buffer (#.Some buffer) @@ -230,14 +225,13 @@ (All [anchor expression statement] (-> Name (Operation anchor expression statement Text))) (function (_ (^@ stateE [_ state])) - (|> state - (get@ #name-cache) - (dictionary.get lux-name) - (case> (#.Some host-name) - (#error.Success [stateE host-name]) - - #.None - (ex.throw unknown-lux-name lux-name))))) + (let [cache (get@ #name-cache state)] + (case (dictionary.get lux-name cache) + (#.Some host-name) + (#error.Success [stateE host-name]) + + #.None + (ex.throw unknown-lux-name lux-name))))) (def: #export (learn lux-name host-name) (All [anchor expression statement] diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index f2277ba06..7564518f4 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -253,7 +253,8 @@ [$module (get module modules) [def-type def-anns def-value] (: (Maybe Definition) (|> (: Module $module) (get@ #.definitions) (get name)))] (if (and (macro? def-anns) - (or (export? def-anns) (text/= module this-module))) + (or (export? def-anns) + (text/= module this-module))) (#.Some (:coerce Macro def-value)) (case (get-identifier-ann (name-of #.alias) def-anns) (#.Some [r-module r-name]) @@ -359,6 +360,12 @@ _ (:: Monad<Meta> wrap (list syntax)))) +(def: #export count + (Meta Nat) + (function (_ compiler) + (#e.Success [(update@ #.seed inc compiler) + (get@ #.seed compiler)]))) + (def: #export (gensym prefix) {#.doc "Generates a unique name as an Code node (ready to be used in code templates). |