aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
authorEduardo Julian2017-12-05 02:41:59 -0400
committerEduardo Julian2017-12-05 02:41:59 -0400
commit7e18f589a05bde28b3f710d92f72b7bd6b6e144f (patch)
treecea41a63fa361d82300e52720f1d96da89312b52 /new-luxc/source/luxc/lang
parent9641cfa9ed5043f3df2792f5aeab4e42b2f79a44 (diff)
- Added analysis, synthesis, translation and statement extensions.
- No longer doing ad-hoc I/O in new-luxc. - Minor fixes and adjustments.
Diffstat (limited to 'new-luxc/source/luxc/lang')
-rw-r--r--new-luxc/source/luxc/lang/extension.lux84
-rw-r--r--new-luxc/source/luxc/lang/extension/analysis.lux9
-rw-r--r--new-luxc/source/luxc/lang/extension/statement.lux146
-rw-r--r--new-luxc/source/luxc/lang/extension/synthesis.lux9
-rw-r--r--new-luxc/source/luxc/lang/extension/translation.lux9
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/module.lux10
-rw-r--r--new-luxc/source/luxc/lang/translation.lux164
-rw-r--r--new-luxc/source/luxc/lang/translation/common.jvm.lux2
9 files changed, 336 insertions, 99 deletions
diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux
new file mode 100644
index 000000000..d38d564fb
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension.lux
@@ -0,0 +1,84 @@
+(.module:
+ lux
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:])
+ (data ["e" error]
+ [text]
+ (coll [dict #+ Dict]))
+ [macro])
+ [//])
+
+(exception: #export Unknown-Analysis)
+(exception: #export Unknown-Synthesis)
+(exception: #export Unknown-Translation)
+(exception: #export Unknown-Statement)
+
+(exception: #export Cannot-Define-Analysis-More-Than-Once)
+(exception: #export Cannot-Define-Synthesis-More-Than-Once)
+(exception: #export Cannot-Define-Translation-More-Than-Once)
+(exception: #export Cannot-Define-Statement-More-Than-Once)
+
+(type: #export Expression
+ (-> (List Code) (Meta Code)))
+
+(type: #export Statement
+ (-> (List Code) (Meta Unit)))
+
+(type: #export Extensions
+ {#analysis (Dict Text Expression)
+ #synthesis (Dict Text Expression)
+ #translation (Dict Text Expression)
+ #statement (Dict Text Statement)})
+
+(def: #export fresh
+ Extensions
+ {#analysis (dict.new text.Hash<Text>)
+ #synthesis (dict.new text.Hash<Text>)
+ #translation (dict.new text.Hash<Text>)
+ #statement (dict.new text.Hash<Text>)})
+
+(def: get
+ (Meta Extensions)
+ (function [compiler]
+ (#e.Success [compiler
+ (|> compiler (get@ #.extensions) (:! Extensions))])))
+
+(def: (set extensions)
+ (-> Extensions (Meta Unit))
+ (function [compiler]
+ (#e.Success [(set@ #.extensions (:! Void extensions) compiler)
+ []])))
+
+(do-template [<name> <type> <category> <exception>]
+ [(def: #export (<name> name)
+ (-> Text (Meta <type>))
+ (do macro.Monad<Meta>
+ [extensions ..get]
+ (case (dict.get name (get@ <category> extensions))
+ (#.Some extension)
+ (wrap extension)
+
+ #.None
+ (//.throw <exception> name))))]
+
+ [find-analysis Expression #analysis Unknown-Analysis]
+ [find-synthesis Expression #synthesis Unknown-Synthesis]
+ [find-translation Expression #translation Unknown-Translation]
+ [find-statement Statement #statement Unknown-Statement]
+ )
+
+(do-template [<name> <type> <category> <exception>]
+ [(def: #export (<name> name extension)
+ (-> Text <type> (Meta Unit))
+ (do macro.Monad<Meta>
+ [extensions ..get
+ _ (//.assert <exception> name
+ (not (dict.contains? name (get@ <category> extensions))))
+ _ (..set (update@ <category> (dict.put name extension) extensions))]
+ (wrap [])))]
+
+ [install-analysis Expression #analysis Cannot-Define-Analysis-More-Than-Once]
+ [install-synthesis Expression #synthesis Cannot-Define-Synthesis-More-Than-Once]
+ [install-translation Expression #translation Cannot-Define-Translation-More-Than-Once]
+ [install-statement Statement #statement Cannot-Define-Statement-More-Than-Once]
+ )
diff --git a/new-luxc/source/luxc/lang/extension/analysis.lux b/new-luxc/source/luxc/lang/extension/analysis.lux
new file mode 100644
index 000000000..d034f2919
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/analysis.lux
@@ -0,0 +1,9 @@
+(.module:
+ lux
+ (lux (data [text]
+ (coll [dict #+ Dict])))
+ [//])
+
+(def: #export defaults
+ (Dict Text //.Expression)
+ (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux
new file mode 100644
index 000000000..6e9530f38
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/statement.lux
@@ -0,0 +1,146 @@
+(.module:
+ lux
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:])
+ (data [text]
+ text/format
+ (coll [list "list/" Functor<List>]
+ [dict #+ Dict]))
+ [macro]
+ (lang (type ["tc" check]))
+ [io #+ IO])
+ [//]
+ (luxc [lang]
+ (lang [".L" host]
+ (host ["$" jvm])
+ (analysis [".A" common]
+ [".A" expression])
+ (synthesis [".S" expression])
+ (translation [".T" expression]
+ [".T" statement]
+ [".T" eval])
+ [".L" eval])))
+
+(exception: #export Invalid-Statement)
+(exception: #export Invalid-Alias)
+
+(def: (throw-invalid-statement procedure inputsC+)
+ (All [a] (-> Text (List Code) (Meta a)))
+ (lang.throw Invalid-Statement
+ (format "Statement: " procedure "\n"
+ " Inputs:"
+ (|> inputsC+
+ list.enumerate
+ (list/map (function [[idx inputC]]
+ (format "\n " (%n idx) " " (%code inputC))))
+ (text.join-with "")) "\n")))
+
+(def: (process-annotations annsC)
+ (-> Code (Meta [$.Inst Code]))
+ (do macro.Monad<Meta>
+ [[_ annsA] (lang.with-scope
+ (lang.with-type Code
+ (expressionA.analyser evalL.eval annsC)))
+ annsI (expressionT.translate (expressionS.synthesize annsA))
+ annsV (evalT.eval annsI)]
+ (wrap [annsI (:! Code annsV)])))
+
+(def: (ensure-valid-alias def-name annotations value)
+ (-> Text Code Code (Meta Unit))
+ (case [annotations value]
+ (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
+ (|> pairs list.size (n/= +1)))
+ (:: macro.Monad<Meta> wrap [])
+
+ _
+ (lang.throw Invalid-Alias def-name)))
+
+(def: (lux//def procedure)
+ (-> Text //.Statement)
+ (function [inputsC+]
+ (case inputsC+
+ (^ (list [_ (#.Symbol ["" def-name])] valueC annotationsC))
+ (hostL.with-context def-name
+ (lang.with-fresh-type-env
+ (do macro.Monad<Meta>
+ [[annotationsI annotationsV] (process-annotations annotationsC)]
+ (case (macro.get-symbol-ann (ident-for #.alias) annotationsV)
+ (#.Some real-def)
+ (do @
+ [_ (ensure-valid-alias def-name annotationsV valueC)
+ _ (lang.with-scope
+ (statementT.translate-def def-name Void id annotationsI annotationsV))]
+ (wrap []))
+
+ #.None
+ (do @
+ [[_ valueT valueA] (lang.with-scope
+ (if (macro.type? (:! Code annotationsV))
+ (do @
+ [valueA (lang.with-type Type
+ (expressionA.analyser evalL.eval valueC))]
+ (wrap [Type valueA]))
+ (commonA.with-unknown-type
+ (expressionA.analyser evalL.eval valueC))))
+ valueT (lang.with-type-env
+ (tc.clean valueT))
+ valueI (expressionT.translate (expressionS.synthesize valueA))
+ _ (lang.with-scope
+ (statementT.translate-def def-name valueT valueI annotationsI annotationsV))]
+ (wrap []))))))
+
+ _
+ (throw-invalid-statement procedure inputsC+))))
+
+(def: (lux//program procedure)
+ (-> Text //.Statement)
+ (function [inputsC+]
+ (case inputsC+
+ (^ (list [_ (#.Symbol ["" args])] programC))
+ (do macro.Monad<Meta>
+ [[_ programA] (lang.with-scope
+ (lang.with-type (type (IO Unit))
+ (expressionA.analyser evalL.eval programC)))
+ programI (expressionT.translate (expressionS.synthesize programA))
+ _ (statementT.translate-program args programI)]
+ (wrap []))
+
+ _
+ (throw-invalid-statement procedure inputsC+))))
+
+(do-template [<mame> <type> <installer>]
+ [(def: (<mame> procedure)
+ (-> Text //.Statement)
+ (function [inputsC+]
+ (case inputsC+
+ (^ (list [_ (#.Text name)] valueC))
+ (do macro.Monad<Meta>
+ [[_ valueA] (lang.with-scope
+ (lang.with-type <type>
+ (expressionA.analyser evalL.eval valueC)))
+ valueI (expressionT.translate (expressionS.synthesize valueA))
+ valueV (evalT.eval valueI)
+ _ (<installer> name (:! <type> valueV))]
+ (wrap []))
+
+ _
+ (throw-invalid-statement procedure inputsC+))))]
+
+ [lux//analysis //.Expression //.install-analysis]
+ [lux//synthesis //.Expression //.install-synthesis]
+ [lux//translation //.Expression //.install-translation]
+ [lux//statement //.Statement //.install-statement])
+
+(def: #export defaults
+ (Dict Text //.Statement)
+ (`` (|> (dict.new text.Hash<Text>)
+ (~~ (do-template [<name> <extension>]
+ [(dict.put <name> (<extension> <name>))]
+
+ ["lux def" lux//def]
+ ["lux program" lux//program]
+ ["lux analysis" lux//analysis]
+ ["lux synthesis" lux//synthesis]
+ ["lux translation" lux//translation]
+ ["lux statement" lux//statement]
+ )))))
diff --git a/new-luxc/source/luxc/lang/extension/synthesis.lux b/new-luxc/source/luxc/lang/extension/synthesis.lux
new file mode 100644
index 000000000..d034f2919
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/synthesis.lux
@@ -0,0 +1,9 @@
+(.module:
+ lux
+ (lux (data [text]
+ (coll [dict #+ Dict])))
+ [//])
+
+(def: #export defaults
+ (Dict Text //.Expression)
+ (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/extension/translation.lux b/new-luxc/source/luxc/lang/extension/translation.lux
new file mode 100644
index 000000000..d034f2919
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/translation.lux
@@ -0,0 +1,9 @@
+(.module:
+ lux
+ (lux (data [text]
+ (coll [dict #+ Dict])))
+ [//])
+
+(def: #export defaults
+ (Dict Text //.Expression)
+ (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index cfe71656c..67b28b7b0 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #- Type Def]
+ [lux #- Type]
(lux (control monad
["p" parser])
(data (coll [list "list/" Functor<List>]))
diff --git a/new-luxc/source/luxc/lang/module.lux b/new-luxc/source/luxc/lang/module.lux
index 58bf94571..ebc0ee7b0 100644
--- a/new-luxc/source/luxc/lang/module.lux
+++ b/new-luxc/source/luxc/lang/module.lux
@@ -25,7 +25,7 @@
(-> Nat Module)
{#.module-hash hash
#.module-aliases (list)
- #.defs (list)
+ #.definitions (list)
#.imports (list)
#.tags (list)
#.types (list)
@@ -82,16 +82,16 @@
(def: #export (define (^@ full-name [module-name def-name])
definition)
- (-> Ident Def (Meta Unit))
+ (-> Ident Definition (Meta Unit))
(function [compiler]
(case (&.pl-get module-name (get@ #.modules compiler))
(#.Some module)
- (case (&.pl-get def-name (get@ #.defs module))
+ (case (&.pl-get def-name (get@ #.definitions module))
#.None
(#e.Success [(update@ #.modules
(&.pl-put module-name
- (update@ #.defs
- (: (-> (List [Text Def]) (List [Text Def]))
+ (update@ #.definitions
+ (: (-> (List [Text Definition]) (List [Text Definition]))
(|>> (#.Cons [def-name definition])))
module))
compiler)
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 6cba6cc35..a0e5bca97 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -20,17 +20,24 @@
(lang [".L" module]
[".L" host]
[".L" macro]
+ [".L" extension]
+ (extension [".E" analysis]
+ [".E" synthesis]
+ [".E" translation]
+ [".E" statement])
(host ["$" jvm])
(analysis [".A" expression]
[".A" common])
(synthesis [".S" expression])
(translation [".T" runtime]
[".T" statement]
- [".T" common]
+ [".T" common #+ Artifacts]
[".T" expression]
[".T" eval]
[".T" imports])
- ["&." eval])
+ ["&." eval]
+ ## [".L" cache]
+ )
))
(def: analyse
@@ -39,7 +46,6 @@
(exception: #export Macro-Expansion-Failed)
(exception: #export Unrecognized-Statement)
-(exception: #export Invalid-Alias)
(exception: #export Invalid-Macro)
(def: (process-annotations annsC)
@@ -60,55 +66,9 @@
(wrap (|> this (get@ #.module-aliases) (dict.from-list text.Hash<Text>) (: Aliases))))
new-compiler)))
-(def: (ensure-valid-alias def-name annotations value)
- (-> Text Code Code (Meta Unit))
- (case [annotations value]
- (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
- (|> pairs list.size (n/= +1)))
- (:: macro.Monad<Meta> wrap [])
-
- _
- (&.throw Invalid-Alias def-name)))
-
(def: #export (translate translate-module aliases code)
(-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases))
(case code
- (^code ("lux def" (~ [_ (#.Symbol ["" def-name])]) (~ valueC) (~ annsC)))
- (hostL.with-context def-name
- (&.with-fresh-type-env
- (do macro.Monad<Meta>
- [[annsI annsV] (process-annotations annsC)]
- (case (macro.get-symbol-ann (ident-for #.alias) annsV)
- (#.Some real-def)
- (do @
- [_ (ensure-valid-alias def-name annsV valueC)
- _ (&.with-scope
- (statementT.translate-def def-name Void id annsI annsV))]
- (wrap aliases))
-
- #.None
- (do @
- [[_ valueT valueA] (&.with-scope
- (if (macro.type? (:! Code annsV))
- (do @
- [valueA (&.with-type Type
- (analyse valueC))]
- (wrap [Type valueA]))
- (commonA.with-unknown-type
- (analyse valueC))))
- valueT (&.with-type-env
- (tc.clean valueT))
- ## #let [_ (if (or (text/= "string~" def-name))
- ## (log! (format "{" def-name "}\n"
- ## " TYPE: " (%type valueT) "\n"
- ## " ANALYSIS: " (%code valueA) "\n"
- ## "SYNTHESIS: " (%code (expressionS.synthesize valueA))))
- ## [])]
- valueI (expressionT.translate (expressionS.synthesize valueA))
- _ (&.with-scope
- (statementT.translate-def def-name valueT valueI annsI annsV))]
- (wrap aliases))))))
-
(^code ("lux module" (~ annsC)))
(do macro.Monad<Meta>
[[annsI annsV] (process-annotations annsC)
@@ -120,15 +80,12 @@
(#e.Error error)
(macro.fail error)))
- (^code ("lux program" (~ [_ (#.Symbol ["" program-args])]) (~ programC)))
+ (^code ((~ [_ (#.Text statement)]) (~+ argsC+)))
(do macro.Monad<Meta>
- [[_ programA] (&.with-scope
- (&.with-type (type (io.IO Unit))
- (analyse programC)))
- programI (expressionT.translate (expressionS.synthesize programA))
- _ (statementT.translate-program program-args programI)]
+ [statement (extensionL.find-statement statement)
+ _ (statement argsC+)]
(wrap aliases))
-
+
(^code ((~ macroC) (~+ argsC+)))
(do macro.Monad<Meta>
[[_ macroA] (&.with-scope
@@ -199,6 +156,22 @@
(#e.Success [(set@ #.source source' compiler)
output]))))
+(def: (write-module target-dir module-name module artifacts)
+ (-> File Text Module Artifacts (Process Unit))
+ (do io.Monad<Process>
+ [_ (monad.map @ (function [[name content]]
+ (&io.write target-dir
+ (format module-name "/" name (for {"JVM" ".class"
+ "JS" ".js"}))
+ content))
+ (dict.entries artifacts))]
+ (wrap [])
+ ## (&io.write (format module-dir "/" cacheL.descriptor-name)
+ ## (text-to-blob (%code (cacheL.describe 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 Compiler (Process Compiler))
(do io.Monad<Process>
@@ -208,26 +181,23 @@
translate-module (translate-module source-dirs target-dir)]]
(case (macro.run' compiler
(do macro.Monad<Meta>
- [[_ artifacts _] (moduleL.with-module module-hash module-name
- (commonT.with-artifacts
- (with-active-compilation [module-name
- file-name
- file-content]
- (forgive-eof
- (loop [aliases (: Aliases
- (dict.new text.Hash<Text>))]
- (do @
- [code (read module-name aliases)
- #let [[cursor _] code]
- aliases' (&.with-cursor cursor
- (translate translate-module aliases code))]
- (forgive-eof (recur aliases'))))))))]
- (wrap artifacts)))
- (#e.Success [compiler artifacts])
+ [[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 @
- [## _ (monad.map @ (function [[class-name class-bytecode]]
- ## (&io.write-file target-dir class-name class-bytecode))
- ## (dict.entries artifacts))
+ [## _ (write-module target-dir module-name module artifacts)
]
(wrap compiler))
@@ -253,7 +223,7 @@
(-> commonT.Host Compiler)
{#.info init-info
#.source [init-cursor +0 ""]
- #.cursor init-cursor
+ #.cursor .dummy-cursor
#.current-module #.None
#.modules (list)
#.scopes (list)
@@ -261,23 +231,35 @@
#.expected #.None
#.seed +0
#.scope-type-vars (list)
+ #.extensions (:! Void extensionL.fresh)
#.host (:! Void host)})
-(def: #export (translate-program sources target program)
- (-> (List File) File Text (T.Task Unit))
- (do T.Monad<Task>
- [compiler (|> (case (runtimeT.translate (init-compiler (io.run hostL.init-host)))
- (#e.Error error)
- (T.fail error)
+(def: (initialize sources target)
+ (-> (List File) File (Process Compiler))
+ (do io.Monad<Process>
+ [compiler (: (Process Compiler)
+ (case (runtimeT.translate (init-compiler (io.run hostL.init-host)))
+ (#e.Error error)
+ (io.fail error)
- (#e.Success [compiler [runtime-bc function-bc]])
- (do @
- [_ (&io.prepare-target target)
- _ (&io.write-file target (format hostL.runtime-class ".class") runtime-bc)
- _ (&io.write-file target (format hostL.function-class ".class") function-bc)]
- (wrap compiler)))
- (: (T.Task Compiler))
- (:: @ map (|>> (translate-module sources target prelude) P.future)) (:: @ join)
- (:: @ map (|>> (translate-module sources target program) P.future)) (:: @ join))
+ (#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)]
+ (wrap (set@ #.extensions
+ (:! Void
+ {#extensionL.analysis analysisE.defaults
+ #extensionL.synthesis synthesisE.defaults
+ #extensionL.translation translationE.defaults
+ #extensionL.statement statementE.defaults})
+ compiler)))))]
+ (translate-module sources target prelude compiler)))
+
+(def: #export (translate-program sources target program)
+ (-> (List File) File Text (Process Unit))
+ (do io.Monad<Process>
+ [compiler (initialize sources target)
+ _ (translate-module sources target program compiler)
#let [_ (log! "Compilation complete!")]]
(wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index b75b0672b..1132928d0 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -98,7 +98,5 @@
(#e.Success [compiler (ClassLoader::loadClass [name] (get@ #loader host))])
(ex.throw Unknown-Class name)))))
-## (def: #export bytecode-version Int Opcodes::V1_6)
-
(def: #export value-field Text "_value")
(def: #export $Object $.Type ($t.class "java.lang.Object" (list)))