aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-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
9 files changed, 281 insertions, 36 deletions
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>