aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux10
-rw-r--r--stdlib/source/lux/compiler/default.lux8
-rw-r--r--stdlib/source/lux/compiler/default/evaluation.lux34
-rw-r--r--stdlib/source/lux/compiler/default/init.lux10
-rw-r--r--stdlib/source/lux/compiler/default/phase.lux10
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis.lux74
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/expression.lux183
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis.lux10
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux68
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/statement.lux142
-rw-r--r--stdlib/source/lux/compiler/default/phase/statement.lux6
-rw-r--r--stdlib/source/lux/compiler/default/phase/synthesis/expression.lux3
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation.lux9
-rw-r--r--stdlib/source/lux/compiler/default/reference.lux14
-rw-r--r--stdlib/source/lux/host.jvm.lux2
15 files changed, 346 insertions, 237 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 793cf5a4d..7faad6c0a 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -21,7 +21,7 @@
(1 [[dummy-cursor (7 ["lux" "doc"])]
[dummy-cursor (5 "The type of things whose type does not matter.
- It can be used to write functions or data-structures that can take, or return, anything.")]]
+ It can be used to write functions or data-structures that can take, or return, anything.")]]
(0)))))])
## (type: Nothing
@@ -37,7 +37,7 @@
(1 [[dummy-cursor (7 ["lux" "doc"])]
[dummy-cursor (5 "The type of things whose type is unknown or undefined.
- Useful for expressions that cause errors or other \"extraordinary\" conditions.")]]
+ Useful for expressions that cause errors or other \"extraordinary\" conditions.")]]
(0)))))])
## (type: (List a)
@@ -100,7 +100,7 @@
(#Cons [[dummy-cursor (7 ["lux" "doc"])]
[dummy-cursor (5 "Natural numbers (unsigned integers).
- They start at zero (0) and extend in the positive direction.")]]
+ They start at zero (0) and extend in the positive direction.")]]
#Nil))))])
("lux def" Int
@@ -126,7 +126,7 @@
(#Cons [[dummy-cursor (7 ["lux" "doc"])]
[dummy-cursor (5 "Fractional numbers that live in the interval [0,1).
- Useful for probability, and other domains that work within that interval.")]]
+ Useful for probability, and other domains that work within that interval.")]]
#Nil))))])
("lux def" Frac
@@ -164,7 +164,7 @@
(#Cons [[dummy-cursor (7 ["lux" "doc"])]
[dummy-cursor (5 "A name.
- It is used as part of Lux syntax to represent identifiers and tags.")]]
+ It is used as part of Lux syntax to represent identifiers and tags.")]]
#Nil))))])
## (type: (Maybe a)
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index e53e08142..190eee760 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -85,7 +85,7 @@
(def: (begin-module-compilation module-name source)
(All [anchor expression statement]
(-> Text Source <Operation>))
- (statement.lift-analysis!
+ (statement.lift-analysis
(do phase.Monad<Operation>
[_ (module.create (text/hash (get@ #code source)) module-name)
_ (analysis.set-current-module module-name)]
@@ -95,7 +95,7 @@
(All [anchor expression statement]
(-> Text <Operation>))
(|>> module.set-compiled
- statement.lift-analysis!))
+ statement.lift-analysis))
(def: (loop-module-compilation module-name)
(All [anchor expression statement]
@@ -103,7 +103,7 @@
(forgive-eof
(loop [_ []]
(do phase.Monad<Operation>
- [code (statement.lift-analysis!
+ [code (statement.lift-analysis
(do @
[code (..read module-name syntax.no-aliases)
#let [[cursor _] code]
@@ -144,7 +144,7 @@
(-> <Platform> Configuration (fs <Compiler>)))
(|> platform
(get@ #runtime)
- statement.lift-translation!
+ statement.lift-translation
(phase.run' (init.state (get@ #host platform)
(get@ #phase platform)))
(:: error.Functor<Error> map product.left)
diff --git a/stdlib/source/lux/compiler/default/evaluation.lux b/stdlib/source/lux/compiler/default/evaluation.lux
index 3e00d79c5..d93feca93 100644
--- a/stdlib/source/lux/compiler/default/evaluation.lux
+++ b/stdlib/source/lux/compiler/default/evaluation.lux
@@ -1,30 +1,34 @@
(.module:
[lux #*
[control
- [monad (#+ do)]
- pipe]
+ [monad (#+ do)]]
[data
["." error]]]
[//
- ["." phase (#+ Eval)
- ["." analysis
- [".A" expression]]
+ ["." phase
+ [analysis (#+ Operation)
+ [".A" expression]
+ ["." type]]
["." synthesis
[".S" expression]]
["." translation]]])
-(def: #export (evaluator analysis-state synthesis-state translation-state translate)
+(type: #export Eval
+ (-> Type Code (Operation Any)))
+
+(def: #export (evaluator synthesis-state translation-state translate)
(All [anchor expression statement]
- (-> analysis.State+
- synthesis.State+
+ (-> synthesis.State+
(translation.State+ anchor expression statement)
(translation.Phase anchor expression statement)
Eval))
(function (eval type exprC)
- (do error.Monad<Error>
- [exprA (|> exprC (expressionA.analyser eval)(phase.run analysis-state))
- exprS (|> exprA expressionS.synthesize (phase.run synthesis-state))]
- (phase.run translation-state
- (do phase.Monad<Operation>
- [exprO (translate exprS)]
- (translation.evaluate! exprO))))))
+ (do phase.Monad<Operation>
+ [exprA (type.with-type type
+ (expressionA.compile exprC))]
+ (phase.lift (do error.Monad<Error>
+ [exprS (|> exprA expressionS.synthesize (phase.run synthesis-state))]
+ (phase.run translation-state
+ (do phase.Monad<Operation>
+ [exprO (translate exprS)]
+ (translation.evaluate! exprO))))))))
diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux
index 4bd2f807d..e30f5c551 100644
--- a/stdlib/source/lux/compiler/default/init.lux
+++ b/stdlib/source/lux/compiler/default/init.lux
@@ -2,7 +2,7 @@
lux
[//
["." evaluation]
- [phase (#+ Eval)
+ [phase
[analysis
[".A" expression]]
["." synthesis
@@ -73,13 +73,13 @@
(-> (Host expression statement)
(translation.Phase anchor expression statement)
(statement.State+ anchor expression statement)))
- (let [analysis-state [analysisE.bundle (..compiler host)]
- synthesis-state [synthesisE.bundle synthesis.init]
+ (let [synthesis-state [synthesisE.bundle synthesis.init]
translation-state [translationE.bundle (translation.state host)]
- eval (evaluation.evaluator analysis-state synthesis-state translation-state translate)]
+ eval (evaluation.evaluator synthesis-state translation-state translate)
+ analysis-state [(analysisE.bundle eval) (..compiler host)]]
[statementE.bundle
{#statement.analysis {#statement.state analysis-state
- #statement.phase (expressionA.analyser eval)}
+ #statement.phase expressionA.compile}
#statement.synthesis {#statement.state synthesis-state
#statement.phase expressionS.synthesize}
#statement.translation {#statement.state translation-state
diff --git a/stdlib/source/lux/compiler/default/phase.lux b/stdlib/source/lux/compiler/default/phase.lux
index 85567e45c..920d81996 100644
--- a/stdlib/source/lux/compiler/default/phase.lux
+++ b/stdlib/source/lux/compiler/default/phase.lux
@@ -6,7 +6,7 @@
[monad (#+ do)]]
[data
["." product]
- ["." error (#+ Error)]
+ ["." error (#+ Error) ("error/." Functor<Error>)]
["." text
format]]
[macro
@@ -58,6 +58,11 @@
(state.lift error.Monad<Error>
(ex.throw exception parameters)))
+(def: #export (lift error)
+ (All [s a] (-> (Error a) (Operation s a)))
+ (function (_ state)
+ (error/map (|>> [state]) error)))
+
(syntax: #export (assert exception message test)
(wrap (list (` (if (~ test)
(:: ..Monad<Operation> (~' wrap) [])
@@ -83,6 +88,3 @@
[[pre/state' temp] (pre input pre/state)
[post/state' output] (post temp post/state)]
(wrap [[pre/state' post/state'] output]))))
-
-(type: #export Eval
- (-> Type Code (Error Any)))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 974fc2473..578560d11 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -3,9 +3,11 @@
[data
["." product]
["." error]
- [text ("text/." Equivalence<Text>)]
+ ["." maybe]
+ ["." text ("text/." Equivalence<Text>)
+ format]
[collection
- ["." list ("list/." Fold<List>)]]]
+ ["." list ("list/." Functor<List> Fold<List>)]]]
["." function]]
[//
["." extension (#+ Extension)]
@@ -128,7 +130,7 @@
value)
(list.indices (inc tag))))))]
- [sum-analysis Analysis #Structure no-op]
+ [sum-analysis Analysis #Structure ..no-op]
[sum-pattern Pattern #Complex id]
)
@@ -290,3 +292,69 @@
[set-current-module Text #.current-module (#.Some value)]
[set-cursor Cursor #.cursor value]
)
+
+(def: #export (%analysis analysis)
+ (Format Analysis)
+ (case analysis
+ (#Primitive primitive)
+ (case primitive
+ #Unit
+ "[]"
+
+ (^template [<tag> <format>]
+ (<tag> value)
+ (<format> value))
+ ([#Bit %b]
+ [#Nat %n]
+ [#Int %i]
+ [#Rev %r]
+ [#Frac %f]
+ [#Text %t]))
+
+ (#Structure structure)
+ (case structure
+ (#Sum _)
+ (let [[lefts right? value] (maybe.assume (..variant analysis))]
+ (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")"))
+
+ (#Product _)
+ (|> analysis
+ ..tuple
+ (list/map %analysis)
+ (text.join-with " ")
+ (text.enclose ["[" "]"])))
+
+ (#Reference reference)
+ (case reference
+ (#reference.Variable variable)
+ (reference.%variable variable)
+
+ (#reference.Constant constant)
+ (%name constant))
+
+ (#Case analysis match)
+ "{?}"
+
+ (#Function environment body)
+ (|> (%analysis body)
+ (format " ")
+ (format (|> environment
+ (list/map reference.%variable)
+ (text.join-with " ")
+ (text.enclose ["[" "]"])))
+ (text.enclose ["(" ")"]))
+
+ (#Apply _)
+ (|> analysis
+ ..application
+ #.Cons
+ (list/map %analysis)
+ (text.join-with " ")
+ (text.enclose ["(" ")"]))
+
+ (#Extension name parameters)
+ (|> parameters
+ (list/map %analysis)
+ (text.join-with " ")
+ (format (%t name) " ")
+ (text.enclose ["(" ")"]))))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
index 6b0d38a53..e46576201 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux
@@ -13,7 +13,8 @@
["." primitive]
["." structure]
["." reference]
- ["/." // (#+ Eval)
+ ["." case]
+ ["/." //
["." extension]
[//
## [".L" macro]
@@ -30,92 +31,94 @@
[unrecognized-syntax]
)
-(def: #export (analyser eval)
- (-> Eval Phase)
- (function (compile code)
- (do ///.Monad<Operation>
- [expectedT (extension.lift macro.expected-type)]
- (let [[cursor code'] code]
- ## The cursor must be set in the state for the sake
- ## of having useful error messages.
- (//.with-cursor cursor
- (case code'
- (^template [<tag> <analyser>]
- (<tag> value)
- (<analyser> value))
- ([#.Bit primitive.bit]
- [#.Nat primitive.nat]
- [#.Int primitive.int]
- [#.Rev primitive.rev]
- [#.Frac primitive.frac]
- [#.Text primitive.text])
-
- (^template [<tag> <analyser>]
- (^ (#.Form (list& [_ (<tag> tag)]
- values)))
- (case values
- (#.Cons value #.Nil)
- (<analyser> compile tag value)
-
- _
- (<analyser> compile tag (` [(~+ values)]))))
- ([#.Nat structure.sum]
- [#.Tag structure.tagged-sum])
-
- (#.Tag tag)
- (structure.tagged-sum compile tag (' []))
-
- (^ (#.Tuple (list)))
- primitive.unit
-
- (^ (#.Tuple (list singleton)))
- (compile singleton)
-
- (^ (#.Tuple elems))
- (structure.product compile elems)
-
- (^ (#.Record pairs))
- (structure.record compile pairs)
-
- (#.Identifier reference)
- (reference.reference reference)
-
- (^ (#.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)))
-
- _
- (///.throw unrecognized-syntax code)
- ))))))
+(def: #export (compile code)
+ Phase
+ (do ///.Monad<Operation>
+ [expectedT (extension.lift macro.expected-type)]
+ (let [[cursor code'] code]
+ ## The cursor must be set in the state for the sake
+ ## of having useful error messages.
+ (//.with-cursor cursor
+ (case code'
+ (^template [<tag> <analyser>]
+ (<tag> value)
+ (<analyser> value))
+ ([#.Bit primitive.bit]
+ [#.Nat primitive.nat]
+ [#.Int primitive.int]
+ [#.Rev primitive.rev]
+ [#.Frac primitive.frac]
+ [#.Text primitive.text])
+
+ (^template [<tag> <analyser>]
+ (^ (#.Form (list& [_ (<tag> tag)]
+ values)))
+ (case values
+ (#.Cons value #.Nil)
+ (<analyser> compile tag value)
+
+ _
+ (<analyser> compile tag (` [(~+ values)]))))
+ ([#.Nat structure.sum]
+ [#.Tag structure.tagged-sum])
+
+ (#.Tag tag)
+ (structure.tagged-sum compile tag (' []))
+
+ (^ (#.Tuple (list)))
+ primitive.unit
+
+ (^ (#.Tuple (list singleton)))
+ (compile singleton)
+
+ (^ (#.Tuple elems))
+ (structure.product compile elems)
+
+ (^ (#.Record pairs))
+ (structure.record compile pairs)
+
+ (#.Identifier reference)
+ (reference.reference reference)
+
+ (^ (#.Form (list [_ (#.Record branches)] input)))
+ (case.case compile input branches)
+
+ (^ (#.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)))
+
+ _
+ (///.throw unrecognized-syntax code)
+ )))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis.lux
index 4d78ceb43..cc4736ac0 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis.lux
@@ -4,12 +4,14 @@
[collection
["." dictionary]]]]
[///
- [analysis (#+ Bundle)]]
+ [analysis (#+ Bundle)]
+ [//
+ [evaluation (#+ Eval)]]]
[/
["." common]
["." host]])
-(def: #export bundle
- Bundle
+(def: #export (bundle eval)
+ (-> Eval Bundle)
(dictionary.merge host.bundle
- common.bundle))
+ (common.bundle eval)))
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 bf8e73b86..0d1148fbd 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
@@ -1,8 +1,7 @@
(.module:
[lux #*
[control
- ["." monad (#+ do)]
- ["ex" exception (#+ exception:)]]
+ ["." monad (#+ do)]]
[data
["." text
format]
@@ -12,13 +11,15 @@
[type
["." check]]
[io (#+ IO)]]
- ["." ////
- ["." analysis (#+ Analysis Handler Bundle)
- [".A" type]
- [".A" case]
- [".A" function]]]
["." ///
- ["." bundle]])
+ ["." bundle]
+ ["//." //
+ ["." analysis (#+ Analysis Handler Bundle)
+ [".A" type]
+ [".A" case]
+ [".A" function]]
+ [//
+ [evaluation (#+ Eval)]]]])
## [Utils]
(def: (simple inputsT+ outputT)
@@ -91,24 +92,25 @@
_
(////.throw bundle.invalid-syntax [extension-name]))))
-## (do-template [<name> <type>]
-## [(def: <name>
-## Handler
-## (function (_ extension-name analyse args)
-## (case args
-## (^ (list typeC valueC))
-## (do ////.Monad<Operation>
-## [actualT (eval Type typeC)
-## _ (typeA.infer (:coerce Type actualT))]
-## (typeA.with-type <type>
-## (analyse valueC)))
-
-## _
-## (////.throw bundle.incorrect-arity [extension-name 2 (list.size args)]))))]
-
-## [lux::check (:coerce Type actualT)]
-## [lux::coerce Any]
-## )
+(do-template [<name> <type>]
+ [(def: (<name> eval)
+ (-> Eval Handler)
+ (function (_ extension-name analyse args)
+ (case args
+ (^ (list typeC valueC))
+ (do ////.Monad<Operation>
+ [actualT (:: @ map (|>> (:coerce Type))
+ (eval Type typeC))
+ _ (typeA.infer actualT)]
+ (typeA.with-type <type>
+ (analyse valueC)))
+
+ _
+ (////.throw bundle.incorrect-arity [extension-name 2 (list.size args)]))))]
+
+ [lux::check actualT]
+ [lux::coerce Any]
+ )
(def: lux::check::type
Handler
@@ -124,13 +126,13 @@
_
(////.throw bundle.incorrect-arity [extension-name 1 (list.size args)]))))
-(def: bundle::lux
- Bundle
+(def: (bundle::lux eval)
+ (-> Eval Bundle)
(|> bundle.empty
(bundle.install "is" lux::is)
(bundle.install "try" lux::try)
- ## (bundle.install "check" lux::check)
- ## (bundle.install "coerce" lux::coerce)
+ (bundle.install "check" (lux::check eval))
+ (bundle.install "coerce" (lux::coerce eval))
(bundle.install "check type" lux::check::type)
(bundle.install "in-module" lux::in-module)))
@@ -201,11 +203,11 @@
(bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text))))
)))
-(def: #export bundle
- Bundle
+(def: #export (bundle eval)
+ (-> Eval Bundle)
(<| (bundle.prefix "lux")
(|> bundle.empty
- (dict.merge bundle::lux)
+ (dict.merge (bundle::lux eval))
(dict.merge bundle::bit)
(dict.merge bundle::int)
(dict.merge bundle::frac)
diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
index b1b28b6a3..7daf27227 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/statement.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
@@ -4,35 +4,57 @@
[monad (#+ do)]
pipe]
[data
+ [text
+ format]
[collection
[list ("list/." Functor<List>)]
["." dictionary]]]
["." macro]
[type (#+ :share)
["." check]]]
- [//
- ["/." // (#+ Eval)
- ["." analysis
- ["." module]
- ["." type]]
- ["." synthesis]
- ["." translation]
- ["." statement (#+ Operation Handler Bundle)]
- ["." extension
- ["." bundle]]
- [//
- ["." evaluation]]]])
-
-(def: (compile ?name ?type codeC)
+ ["." ///
+ ["." analysis
+ ["." module]
+ ["." type]]
+ ["." synthesis]
+ ["." translation]
+ ["." statement (#+ Operation Handler Bundle)]
+ ["." extension
+ ["." bundle]]])
+
+(def: (evaluate! type codeC)
(All [anchor expression statement]
- (-> (Maybe Name) (Maybe Type) Code
- (Operation anchor expression statement [Type expression Any])))
+ (-> 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] (statement.lift-analysis!
+ [_ code//type codeA] (statement.lift-analysis
+ (analysis.with-scope
+ (type.with-fresh-env
+ (type.with-type type
+ (do @
+ [codeA (analyse codeC)]
+ (wrap [type codeA]))))))
+ codeS (statement.lift-synthesis
+ (synthesize codeA))]
+ (statement.lift-translation
+ (do @
+ [codeT (translate codeS)
+ codeV (translation.evaluate! 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)
+ #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] (statement.lift-analysis
(analysis.with-scope
(type.with-fresh-env
(case ?type
@@ -48,18 +70,13 @@
code//type (type.with-env
(check.clean code//type))]
(wrap [code//type codeA]))))))
- codeS (statement.lift-synthesis!
+ codeS (statement.lift-synthesis
(synthesize codeA))]
- (statement.lift-translation!
+ (statement.lift-translation
(do @
[codeT (translate codeS)
- codeV (case ?name
- (#.Some name)
- (translation.define! name codeT)
-
- #.None
- (translation.evaluate! codeT))]
- (wrap [code//type codeT codeV])))))
+ codeN+V (translation.define! name codeT)]
+ (wrap [code//type codeT codeN+V])))))
(def: lux::def
Handler
@@ -67,27 +84,31 @@
(case inputsC+
(^ (list [_ (#.Identifier ["" def-name])] valueC annotationsC))
(do ///.Monad<Operation>
- [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC)
+ [[_ annotationsT annotationsV] (evaluate! Code annotationsC)
#let [annotationsV (:coerce Code annotationsV)]
- current-module (statement.lift-analysis!
+ current-module (statement.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)]
- (statement.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 [])))))
+ #let [full-name [current-module def-name]]
+ [value//type valueT valueN valueV] (define! full-name
+ (if (macro.type? annotationsV)
+ (#.Some Type)
+ #.None)
+ valueC)
+ _ (statement.lift-analysis
+ (do @
+ [_ (module.define def-name [value//type annotationsV valueV])
+ #let [_ (log! (format "Definition " (%name full-name)))]]
+ (if (macro.type? annotationsV)
+ (case (macro.declared-tags annotationsV)
+ #.Nil
+ (wrap [])
+
+ tags
+ (module.declare-tags tags (macro.export? annotationsV) (:coerce Type valueV)))
+ (wrap []))))]
+ (statement.lift-translation
+ (translation.learn full-name valueN)))
_
(///.throw bundle.invalid-syntax [extension-name]))))
@@ -104,8 +125,8 @@
(case inputsC+
(^ (list annotationsC))
(do ///.Monad<Operation>
- [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC)
- _ (statement.lift-analysis!
+ [[_ annotationsT annotationsV] (evaluate! Code annotationsC)
+ _ (statement.lift-analysis
(module.set-annotations (:coerce Code annotationsV)))]
(wrap []))
@@ -133,13 +154,12 @@
(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)]
+ [[_ handlerT handlerV] (evaluate! (:of (:share [anchor expression statement]
+ {(Handler anchor expression statement)
+ handler}
+ {<type>
+ (:assume [])}))
+ valueC)]
(<| <scope>
(extension.install name)
(:share [anchor expression statement]
@@ -151,18 +171,10 @@
_
(///.throw bundle.invalid-syntax [extension-name]))))]
- [def::analysis analysis.Handler statement.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::analysis analysis.Handler statement.lift-analysis]
+ [def::synthesis synthesis.Handler statement.lift-synthesis]
+ [def::translation (translation.Handler anchor expression statement) statement.lift-translation]
+ [def::statement (statement.Handler anchor expression statement) (<|)]
)
(def: bundle::def
diff --git a/stdlib/source/lux/compiler/default/phase/statement.lux b/stdlib/source/lux/compiler/default/phase/statement.lux
index daaea020c..c7ff3719f 100644
--- a/stdlib/source/lux/compiler/default/phase/statement.lux
+++ b/stdlib/source/lux/compiler/default/phase/statement.lux
@@ -39,7 +39,7 @@
(set@ [<component> #..state])]
operation)))]
- [lift-analysis! #..analysis analysis.Operation]
- [lift-synthesis! #..synthesis synthesis.Operation]
- [lift-translation! #..translation (translation.Operation anchor expression statement)]
+ [lift-analysis #..analysis analysis.Operation]
+ [lift-synthesis #..synthesis synthesis.Operation]
+ [lift-translation #..translation (translation.Operation anchor expression statement)]
)
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
index 241896e58..4a5f2979c 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
@@ -82,6 +82,9 @@
(#analysis.Case inputA branchesAB+)
(case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+)
+ (^ (analysis.no-op value))
+ (synthesize value)
+
(#analysis.Apply _)
(function.apply (|>> synthesize //.indirectly) analysis)
diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux
index 3bf09937f..3cca0c060 100644
--- a/stdlib/source/lux/compiler/default/phase/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation.lux
@@ -57,7 +57,7 @@
evaluate!)
(: (-> Text statement (Error Any))
execute!)
- (: (-> Name expression (Error Any))
+ (: (-> Name expression (Error [Text Any]))
define!))
(type: #export (Buffer statement) (Row [Name statement]))
@@ -180,13 +180,14 @@
[(def: #export (<name> code)
(All [anchor expression statement]
(-> <inputT> (Operation anchor expression statement Any)))
- (function (_ (^@ stateE [bundle state]))
+ (function (_ [bundle state])
(case (:: (get@ #host state) <name> (temp-label state) code)
(#error.Error error)
(ex.throw cannot-interpret error)
(#error.Success output)
- (#error.Success [stateE output]))))]
+ (#error.Success [[bundle (update@ #counter inc state)]
+ output]))))]
[evaluate! expression]
[execute! statement]
@@ -194,7 +195,7 @@
(def: #export (define! name code)
(All [anchor expression statement]
- (-> Name expression (Operation anchor expression statement Any)))
+ (-> Name expression (Operation anchor expression statement [Text Any])))
(function (_ (^@ stateE [bundle state]))
(case (:: (get@ #host state) define! name code)
(#error.Error error)
diff --git a/stdlib/source/lux/compiler/default/reference.lux b/stdlib/source/lux/compiler/default/reference.lux
index 0bbeb2db5..cde1f5b5c 100644
--- a/stdlib/source/lux/compiler/default/reference.lux
+++ b/stdlib/source/lux/compiler/default/reference.lux
@@ -3,7 +3,10 @@
[control
[equivalence (#+ Equivalence)]
[hash (#+ Hash)]
- pipe]])
+ pipe]
+ [data
+ [text
+ format]]])
(type: #export Register Nat)
@@ -65,3 +68,12 @@
_
#0)))
+
+(def: #export (%variable variable)
+ (Format Variable)
+ (case variable
+ (#Local local)
+ (format "+" (%n local))
+
+ (#Foreign foreign)
+ (format "-" (%n foreign))))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 201c49094..b7a55dfaa 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1589,7 +1589,7 @@
_
[return-type return-term]))]
- [decorate-return-try #import-member-try? (` ((~! error.Error) (~ return-type))) (` (try (~ return-term)))]
+ [decorate-return-try #import-member-try? (` ((~! error.Error) (~ return-type))) (` (..try (~ return-term)))]
[decorate-return-io #import-member-io? (` ((~! io.IO) (~ return-type))) (` ((~! io.io) (~ return-term)))]
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 06:33:39 +0000