aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/extension
diff options
context:
space:
mode:
Diffstat (limited to '')
-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
5 files changed, 257 insertions, 0 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>))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 01:21:38 +0000