aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation.lux278
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux4
-rw-r--r--stdlib/source/lux/compiler/default.lux187
-rw-r--r--stdlib/source/lux/compiler/default/init.lux24
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis.lux10
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/module.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/statement.lux41
-rw-r--r--stdlib/source/lux/compiler/default/phase/statement.lux17
-rw-r--r--stdlib/source/lux/compiler/default/phase/statement/total.lux27
-rw-r--r--stdlib/source/lux/compiler/default/syntax.lux5
-rw-r--r--stdlib/source/lux/compiler/meta/io/context.lux4
11 files changed, 283 insertions, 316 deletions
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
deleted file mode 100644
index 3348953bb..000000000
--- a/new-luxc/source/luxc/lang/translation.lux
+++ /dev/null
@@ -1,278 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do]
- ["ex" exception #+ exception:])
- (concurrency ["P" promise]
- ["T" task])
- (data [product]
- ["e" error]
- [text "text/" Hash<Text>]
- text/format
- (coll [list "list/" Functor<List>]
- (dictionary ["dict" unordered])))
- [macro]
- (lang [syntax #+ Aliases]
- (type ["tc" check]))
- [host]
- [io #+ IO Process io]
- (world [binary #+ Binary]
- [file #+ File]))
- (luxc ["&" lang]
- ["&." io]
- [cache]
- [cache/description]
- [cache/io]
- (lang [".L" module]
- [".L" host]
- [".L" macro]
- [".L" extension]
- [".L" init]
- (host ["$" jvm])
- (analysis [".A" expression]
- [".A" common])
- (synthesis [".S" expression])
- ["&." eval]))
- (/ ## [js]
- (jvm [".T" runtime]
- [".T" statement]
- [".T" common #+ Artifacts]
- [".T" expression]
- [".T" eval]
- [".T" imports])))
-
-(def: analyse
- (&.Analyser)
- (expressionA.analyser &eval.eval))
-
-(do-template [<name>]
- [(exception: #export (<name> {message Text})
- message)]
-
- [Macro-Expansion-Failed]
- [Unrecognized-Statement]
- [Invalid-Macro]
- )
-
-(def: (process-annotations annsC)
- (-> Code (Meta [## js.Expression
- $.Inst
- Code]))
- (do macro.Monad<Meta>
- [[_ annsA] (&.with-scope
- (&.with-type Code
- (analyse annsC)))
- syntheses extensionL.all-syntheses
- annsI (expressionT.translate (expressionS.synthesize syntheses annsA))
- annsV (evalT.eval annsI)]
- (wrap [annsI (:coerce Code annsV)])))
-
-(def: (switch-compiler new-compiler)
- (-> Lux (Meta Aliases))
- (function (_ old-compiler)
- ((do macro.Monad<Meta>
- [this macro.current-module]
- (wrap (|> this (get@ #.module-aliases) (dict.from-list text.Hash<Text>) (: Aliases))))
- new-compiler)))
-
-(def: #export (translate translate-module aliases code)
- (-> (-> Text Lux (Process Lux)) Aliases Code (Meta Aliases))
- (case code
- (^code ("lux module" (~ annsC)))
- (do macro.Monad<Meta>
- [[annsI annsV] (process-annotations annsC)
- process (importsT.translate-imports translate-module annsV)]
- (case (io.run process)
- (#e.Success compiler')
- (switch-compiler compiler')
-
- (#e.Error error)
- (macro.fail error)))
-
- (^code ((~ [_ (#.Text statement)]) (~+ argsC+)))
- (do macro.Monad<Meta>
- [statement (extensionL.find-statement statement)
- _ (statement argsC+)]
- (wrap aliases))
-
- (^code ((~ macroC) (~+ argsC+)))
- (do macro.Monad<Meta>
- [[_ macroA] (&.with-scope
- (&.with-type Macro
- (analyse macroC)))
- [_macroT _macroM _macroV] (case macroA
- [_ (#.Identifier macro-name)]
- (macro.find-def macro-name)
-
- _
- (&.throw Invalid-Macro (%code code)))
- expansion (: (Meta (List Code))
- (function (_ compiler)
- (case (macroL.expand (:coerce Macro _macroV) argsC+ compiler)
- (#e.Error error)
- ((&.throw Macro-Expansion-Failed error) compiler)
-
- output
- output)))
- expansion-aliases (monad.map @ (translate translate-module aliases) expansion)]
- (wrap (if (dict.empty? aliases)
- (loop [expansion-aliases expansion-aliases]
- (case expansion-aliases
- #.Nil
- aliases
-
- (#.Cons head tail)
- (if (dict.empty? head)
- (recur tail)
- head)))
- aliases)))
-
- _
- (&.throw Unrecognized-Statement (%code code))))
-
-(def: (forgive-eof action)
- (-> (Meta Any) (Meta Any))
- (function (_ compiler)
- (case (action compiler)
- (#e.Error error)
- (if (ex.match? syntax.end-of-file error)
- (#e.Success [compiler []])
- (#e.Error error))
-
- output
- output)))
-
-(def: #export prelude Text "lux")
-
-(def: (with-active-compilation [module-name file-name source-code] action)
- (All [a] (-> [Text Text Text] (Meta a) (Meta a)))
- (do macro.Monad<Meta>
- [output (&.with-source-code (initL.source file-name source-code)
- action)
- _ (moduleL.flag-compiled! module-name)]
- (wrap output)))
-
-(def: (read current-module aliases)
- (-> Text Aliases (Meta Code))
- (function (_ compiler)
- (case (syntax.read current-module aliases (get@ #.source compiler))
- (#e.Error error)
- (#e.Error error)
-
- (#e.Success [source' output])
- (#e.Success [(set@ #.source source' compiler)
- output]))))
-
-(for {"JVM" (as-is (host.import: java/lang/String
- (getBytes [String] #try (Array byte)))
-
- (def: text-to-binary
- (-> Text Binary)
- (|>> (:coerce String)
- (String::getBytes ["UTF-8"])
- e.assume)))})
-
-## (def: (write-module target-dir file-name module-name module artifacts)
-## (-> File Text Text Module Artifacts (Process Any))
-## (do io.Monad<Process>
-## [_ (monad.map @ (product.uncurry (&io.write target-dir))
-## (dict.entries artifacts))]
-## (&io.write target-dir
-## (format module-name "/" cache.descriptor-name)
-## (text-to-binary (%code (cache/description.write file-name module))))))
-
-(def: no-aliases Aliases (dict.new text.Hash<Text>))
-
-(def: #export (translate-module source-dirs target-dir module-name compiler)
- (-> (List File) File Text Lux (Process Lux))
- (do io.Monad<Process>
- [[file-name file-content] (&io.read source-dirs module-name)
- #let [module-hash (text/hash file-content)
- translate-module (translate-module source-dirs target-dir)]]
- (case (macro.run' compiler
- (do macro.Monad<Meta>
- [[module _] (moduleL.with-module module-hash module-name
- (with-active-compilation [module-name
- file-name
- file-content]
- (forgive-eof
- (loop [aliases no-aliases]
- (do @
- [code (read module-name aliases)
- #let [[cursor _] code]
- aliases' (&.with-cursor cursor
- (translate translate-module aliases code))]
- (forgive-eof (recur aliases')))))))]
- (wrap module)))
- (#e.Success [compiler module])
- (do @
- [## _ (&io.prepare-module target-dir module-name)
- ## _ (write-module target-dir file-name module-name module artifacts)
- ]
- (wrap compiler))
-
- (#e.Error error)
- (io.fail error))
- ## (case (macro.run' compiler
- ## (do macro.Monad<Meta>
- ## [[module artifacts _] (moduleL.with-module module-hash module-name
- ## (commonT.with-artifacts
- ## (with-active-compilation [module-name
- ## file-name
- ## file-content]
- ## (forgive-eof
- ## (loop [aliases no-aliases]
- ## (do @
- ## [code (read module-name aliases)
- ## #let [[cursor _] code]
- ## aliases' (&.with-cursor cursor
- ## (translate translate-module aliases code))]
- ## (forgive-eof (recur aliases'))))))))]
- ## (wrap [module artifacts])))
- ## (#e.Success [compiler [module artifacts]])
- ## (do @
- ## [## _ (&io.prepare-module target-dir module-name)
- ## ## _ (write-module target-dir file-name module-name module artifacts)
- ## ]
- ## (wrap compiler))
-
- ## (#e.Error error)
- ## (io.fail error))
- ))
-
-(def: (initialize sources target)
- (-> (List File) File (Process Lux))
- (do io.Monad<Process>
- [compiler (case (runtimeT.translate ## (initL.compiler (io.run js.init))
- (initL.compiler (io.run hostL.init-host))
- )
- ## (#e.Success [compiler disk-write])
- ## (do @
- ## [_ (&io.prepare-target target)
- ## _ disk-write
- ## ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
- ## ]
- ## (wrap (|> compiler
- ## (set@ [#.info #.mode] #.Build))))
-
- (#e.Success [compiler [runtime-bc function-bc]])
- (do @
- [_ (&io.prepare-target target)
- ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
- ## _ (&io.write target (format hostL.function-class ".class") function-bc)
- ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
- ]
- (wrap (|> compiler
- (set@ [#.info #.mode] #.Build))))
-
- (#e.Error error)
- (io.fail error))]
- (translate-module sources target prelude compiler)))
-
-(def: #export (translate-program sources target program)
- (-> (List File) File Text (Process Any))
- (do io.Monad<Process>
- [compiler (initialize sources target)
- _ (translate-module sources target program compiler)
- ## _ (cache/io.clean target ...)
- #let [_ (log! "Compilation complete!")]]
- (wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index eec57610d..4b3259efd 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -415,8 +415,8 @@
(wrap bytecode))))
(def: #export translate
- (Operation [ByteCode ByteCode])
+ (Operation Any)
(do phase.Monad<Operation>
[runtime-bc translate-runtime
function-bc translate-function]
- (wrap [runtime-bc function-bc])))
+ (wrap [])))
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index 197befb10..d5b97ad36 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -1,2 +1,187 @@
(.module:
- [lux #*])
+ [lux #*
+ [control
+ [monad (#+ do)]
+ ["ex" exception (#+ exception:)]]
+ [data
+ ["." product]
+ ["." error]
+ [text ("text/." Hash<Text>)
+ format
+ ["." encoding]]
+ [collection
+ ["." dictionary]]]
+ [type (#+ :share)]
+ ["." macro]
+ [concurrency
+ ["." promise ("promise/." Monad<Promise>)]
+ ["." task (#+ Task)]]
+ [world
+ ["." file (#+ File)]]]
+ [//
+ [meta
+ [io
+ ["." context]]]]
+ [/
+ ["." init]
+ ["." syntax (#+ Aliases)]
+ ["." phase
+ ["." analysis
+ ["." module]
+ [".A" expression]]
+ ["." translation (#+ Host)]
+ ["." statement
+ [".S" total]]]]
+ ## (luxc [cache]
+ ## [cache/description]
+ ## [cache/io])
+ )
+
+(def: (forgive-eof operation)
+ (All [s o]
+ (-> (phase.Operation s o) (phase.Operation s Any)))
+ (function (_ compiler)
+ (ex.catch syntax.end-of-file
+ (|>> [compiler])
+ (operation compiler))))
+
+(def: #export prelude Text "lux")
+
+(def: (read current-module aliases)
+ (-> Text Aliases (analysis.Operation Code))
+ (function (_ [bundle compiler])
+ (case (syntax.read current-module aliases (get@ #.source compiler))
+ (#error.Error error)
+ (#error.Error error)
+
+ (#error.Success [source' output])
+ (#error.Success [[bundle (set@ #.source source' compiler)]
+ output]))))
+
+## ## (def: (write-module target-dir file-name module-name module artifacts)
+## ## (-> File Text Text Module Artifacts (Process Any))
+## ## (do io.Monad<Process>
+## ## [_ (monad.map @ (product.uncurry (&io.write target-dir))
+## ## (dictionary.entries artifacts))]
+## ## (&io.write target-dir
+## ## (format module-name "/" cache.descriptor-name)
+## ## (encoding.to-utf8 (%code (cache/description.write file-name module))))))
+
+(type: Configuration
+ {#sources (List File)
+ #target File})
+
+(type: (Platform anchor expression statement)
+ {#host (Host expression statement)
+ #phase (translation.Phase anchor expression statement)
+ #runtime (translation.Operation anchor expression statement Any)
+ #file-system (file.System Task)})
+
+(with-expansions [<Platform> (as-is (Platform anchor expression statement))
+ <Operation> (as-is (statement.Operation anchor expression statement Any))
+ <Compiler> (as-is (statement.State+ anchor expression statement))]
+
+ (def: (begin-module-compilation module-name file-name source-code)
+ (All [anchor expression statement]
+ (-> Text Text Text <Operation>))
+ (statement.lift-analysis!
+ (do phase.Monad<Operation>
+ [_ (module.create (text/hash source-code) module-name)
+ _ (analysis.set-current-module module-name)]
+ (analysis.set-source-code (init.source file-name source-code)))))
+
+ (def: (end-module-compilation module-name)
+ (All [anchor expression statement]
+ (-> Text <Operation>))
+ (statement.lift-analysis!
+ (module.set-compiled module-name)))
+
+ (def: (loop-module-compilation module-name)
+ (All [anchor expression statement]
+ (-> Text <Operation>))
+ (forgive-eof
+ (loop [_ []]
+ (do phase.Monad<Operation>
+ [code (statement.lift-analysis!
+ (do @
+ [code (..read module-name syntax.no-aliases)
+ #let [[cursor _] code]
+ _ (analysis.set-cursor cursor)]
+ (wrap code)))
+ _ (totalS.phase code)]
+ (forgive-eof (recur []))))))
+
+ (def: (perform-module-compilation module-name file-name source-code)
+ (All [anchor expression statement]
+ (-> Text Text Text <Operation>))
+ (do phase.Monad<Operation>
+ [_ (begin-module-compilation module-name file-name source-code)
+ _ (loop-module-compilation module-name)]
+ (end-module-compilation module-name)))
+
+ (def: #export (compile-module platform configuration module-name compiler)
+ (All [anchor expression statement]
+ (-> <Platform> Configuration Text <Compiler> (Task <Compiler>)))
+ (do task.Monad<Task>
+ [[file-name source-code] (context.read (get@ #file-system platform)
+ (get@ #sources configuration)
+ module-name)
+ [compiler' _] (<| promise/wrap
+ (phase.run' compiler)
+ (:share [anchor expression statement]
+ {<Platform>
+ platform}
+ {<Operation>
+ (perform-module-compilation module-name file-name source-code)}))
+ ## _ (&io.prepare-module target-dir module-name)
+ ## _ (write-module target-dir file-name module-name module artifacts)
+ ]
+ (wrap compiler')))
+
+ (def: (initialize platform configuration)
+ (All [anchor expression statement]
+ (-> <Platform> Configuration (Task <Compiler>)))
+ (do task.Monad<Task>
+ [[compiler _] (|> platform
+ (get@ #runtime)
+ statement.lift-translation!
+ (phase.run' (init.state (get@ #host platform)
+ (get@ #phase platform)))
+ promise/wrap)
+ ## compiler (case (runtimeT.translate ## (initL.compiler (io.run js.init))
+ ## (initL.compiler (io.run hostL.init-host))
+ ## )
+ ## ## (#error.Success [compiler disk-write])
+ ## ## (do @
+ ## ## [_ (&io.prepare-target target)
+ ## ## _ disk-write
+ ## ## ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
+ ## ## ]
+ ## ## (wrap (|> compiler
+ ## ## (set@ [#.info #.mode] #.Build))))
+
+ ## (#error.Success [compiler [runtime-bc function-bc]])
+ ## (do @
+ ## [_ (&io.prepare-target target)
+ ## ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
+ ## ## _ (&io.write target (format hostL.function-class ".class") function-bc)
+ ## ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
+ ## ]
+ ## (wrap (|> compiler
+ ## (set@ [#.info #.mode] #.Build))))
+
+ ## (#error.Error error)
+ ## (io.fail error))
+ ]
+ (compile-module platform configuration prelude compiler)))
+
+ (def: #export (compile platform configuration program)
+ (All [anchor expression statement]
+ (-> <Platform> Configuration Text (Task Any)))
+ (do task.Monad<Task>
+ [compiler (initialize platform configuration)
+ _ (compile-module platform configuration program compiler)
+ ## _ (cache/io.clean target ...)
+ #let [_ (log! "Compilation complete!")]]
+ (wrap [])))
+ )
diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux
index d768f5f7d..4bd2f807d 100644
--- a/stdlib/source/lux/compiler/default/init.lux
+++ b/stdlib/source/lux/compiler/default/init.lux
@@ -1,6 +1,7 @@
(.module:
lux
[//
+ ["." evaluation]
[phase (#+ Eval)
[analysis
[".A" expression]]
@@ -67,16 +68,19 @@
#.extensions []
#.host host})
-(def: #export (state eval translate host)
+(def: #export (state host translate)
(All [anchor expression statement]
- (-> Eval
+ (-> (Host expression statement)
(translation.Phase anchor expression statement)
- (Host expression statement)
(statement.State+ anchor expression statement)))
- [statementE.bundle
- {#statement.analysis {#statement.state [analysisE.bundle (..compiler [])]
- #statement.phase (expressionA.analyser eval)}
- #statement.synthesis {#statement.state [synthesisE.bundle synthesis.init]
- #statement.phase expressionS.synthesize}
- #statement.translation {#statement.state [translationE.bundle (translation.state host)]
- #statement.phase translate}}])
+ (let [analysis-state [analysisE.bundle (..compiler host)]
+ synthesis-state [synthesisE.bundle synthesis.init]
+ translation-state [translationE.bundle (translation.state host)]
+ eval (evaluation.evaluator analysis-state synthesis-state translation-state translate)]
+ [statementE.bundle
+ {#statement.analysis {#statement.state analysis-state
+ #statement.phase (expressionA.analyser eval)}
+ #statement.synthesis {#statement.state synthesis-state
+ #statement.phase expressionS.synthesize}
+ #statement.translation {#statement.state translation-state
+ #statement.phase translate}}]))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index b0776141a..974fc2473 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -280,3 +280,13 @@
(#error.Error error)
(#error.Error error))))))
+
+(do-template [<name> <type> <field> <value>]
+ [(def: #export (<name> value)
+ (-> <type> (Operation Any))
+ (extension.update (set@ <field> <value>)))]
+
+ [set-source-code Source #.source value]
+ [set-current-module Text #.current-module (#.Some value)]
+ [set-cursor Cursor #.cursor value]
+ )
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
index 5812ef3d2..47b7d7331 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/module.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
@@ -133,7 +133,7 @@
((///.throw cannot-define-more-than-once [self-name name]) state))))))
(def: #export (create hash name)
- (-> Nat Text (Operation []))
+ (-> Nat Text (Operation Any))
(extension.lift
(function (_ state)
(let [module (new hash)]
diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
index 2c2bf4464..b1b28b6a3 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/statement.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux
@@ -23,20 +23,6 @@
[//
["." 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
@@ -46,7 +32,7 @@
#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!
+ [_ code//type codeA] (statement.lift-analysis!
(analysis.with-scope
(type.with-fresh-env
(case ?type
@@ -62,9 +48,9 @@
code//type (type.with-env
(check.clean code//type))]
(wrap [code//type codeA]))))))
- codeS (lift-synthesis!
+ codeS (statement.lift-synthesis!
(synthesize codeA))]
- (lift-translation!
+ (statement.lift-translation!
(do @
[codeT (translate codeS)
codeV (case ?name
@@ -83,7 +69,7 @@
(do ///.Monad<Operation>
[[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC)
#let [annotationsV (:coerce Code annotationsV)]
- current-module (lift-analysis!
+ current-module (statement.lift-analysis!
(extension.lift
macro.current-module-name))
[value//type valueT valueV] (compile (#.Some [current-module def-name])
@@ -91,7 +77,7 @@
(#.Some Type)
#.None)
valueC)]
- (lift-analysis!
+ (statement.lift-analysis!
(do @
[_ (module.define def-name [value//type annotationsV valueV])]
(if (macro.type? annotationsV)
@@ -112,6 +98,20 @@
[definition (extension.lift (macro.find-def def-name))]
(module.define alias definition)))
+(def: def::module
+ Handler
+ (function (_ extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list annotationsC))
+ (do ///.Monad<Operation>
+ [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC)
+ _ (statement.lift-analysis!
+ (module.set-annotations (:coerce Code annotationsV)))]
+ (wrap []))
+
+ _
+ (///.throw bundle.invalid-syntax [extension-name]))))
+
(def: def::alias
Handler
(function (_ extension-name phase inputsC+)
@@ -151,7 +151,7 @@
_
(///.throw bundle.invalid-syntax [extension-name]))))]
- [def::analysis analysis.Handler lift-analysis!]
+ [def::analysis analysis.Handler statement.lift-analysis!]
[def::synthesis synthesis.Handler
(<| extension.lift
(///.sub [(get@ [#statement.synthesis #statement.state])
@@ -169,6 +169,7 @@
Bundle
(<| (bundle.prefix "def")
(|> bundle.empty
+ (dictionary.put "module" def::module)
(dictionary.put "alias" def::alias)
(dictionary.put "analysis" def::analysis)
(dictionary.put "synthesis" def::synthesis)
diff --git a/stdlib/source/lux/compiler/default/phase/statement.lux b/stdlib/source/lux/compiler/default/phase/statement.lux
index 8b0876cdd..daaea020c 100644
--- a/stdlib/source/lux/compiler/default/phase/statement.lux
+++ b/stdlib/source/lux/compiler/default/phase/statement.lux
@@ -1,6 +1,6 @@
(.module:
[lux #*]
- [//
+ ["." //
["." analysis]
["." synthesis]
["." translation]
@@ -28,3 +28,18 @@
[Handler extension.Handler]
[Bundle extension.Bundle]
)
+
+(do-template [<name> <component> <operation>]
+ [(def: #export (<name> operation)
+ (All [anchor expression statement output]
+ (-> (<operation> output)
+ (Operation anchor expression statement output)))
+ (extension.lift
+ (//.sub [(get@ [<component> #..state])
+ (set@ [<component> #..state])]
+ operation)))]
+
+ [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/statement/total.lux b/stdlib/source/lux/compiler/default/phase/statement/total.lux
new file mode 100644
index 000000000..d2b046f5f
--- /dev/null
+++ b/stdlib/source/lux/compiler/default/phase/statement/total.lux
@@ -0,0 +1,27 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]
+ ["ex" exception (#+ exception:)]]
+ [data
+ [text
+ format]]]
+ ["." // (#+ Phase)
+ ["/." //
+ ["." extension]]])
+
+(do-template [<name>]
+ [(exception: #export (<name> {code Code})
+ (ex.report ["Statement" (%code code)]))]
+
+ [unrecognized-statement]
+ )
+
+(def: #export (phase code)
+ Phase
+ (case code
+ (^ [_ (#.Form (list& [_ (#.Text extension-name)] extension-args))])
+ (extension.apply phase [extension-name extension-args])
+
+ _
+ (///.throw unrecognized-statement code)))
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index 5b20dcff5..7faa5a4ea 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -40,9 +40,10 @@
format]
[collection
["." row (#+ Row)]
- ["dict" dictionary (#+ Dictionary)]]]])
+ ["." dictionary (#+ Dictionary)]]]])
(type: #export Aliases (Dictionary Text Text))
+(def: #export no-aliases Aliases (dictionary.new text.Hash<Text>))
(def: white-space Text "\t\v \r\f")
(def: new-line Text "\n")
@@ -555,7 +556,7 @@
(p.either (do @
[_ (l.this name-separator)
second-part name-part^]
- (wrap [[(|> aliases (dict.get first-part) (maybe.default first-part))
+ (wrap [[(|> aliases (dictionary.get first-part) (maybe.default first-part))
second-part]
($_ n/+
(text.size first-part)
diff --git a/stdlib/source/lux/compiler/meta/io/context.lux b/stdlib/source/lux/compiler/meta/io/context.lux
index 6d90483e2..b0a35cf61 100644
--- a/stdlib/source/lux/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/compiler/meta/io/context.lux
@@ -78,7 +78,9 @@
(type: #export Code Text)
(def: #export (read System<m> contexts name)
- (All [m] (-> (System m) (List Context) Module (m [Text Code])))
+ (All [m]
+ (-> (System m) (List Context) Module
+ (m [Text Code])))
(let [find-source' (find-source System<m> contexts name)]
(do (:: System<m> &monad)
[[path file] (try System<m>