aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/compiler/default.lux3
-rw-r--r--stdlib/source/lux/compiler/default/evaluation.lux10
-rw-r--r--stdlib/source/lux/compiler/default/init.lux25
-rw-r--r--stdlib/source/lux/compiler/default/phase.lux8
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis.lux3
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/expression.lux82
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/function.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/macro.lux44
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux20
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/statement.lux29
-rw-r--r--stdlib/source/lux/compiler/default/phase/synthesis/function.lux40
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation.lux42
-rw-r--r--stdlib/source/lux/macro.lux9
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).