diff options
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/expression.lux | 8 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure.lux | 26 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension.lux | 32 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis.lux | 18 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis/common.lux (renamed from new-luxc/source/luxc/lang/analysis/procedure/common.lux) | 46 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux (renamed from new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux) | 39 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/statement.lux | 8 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/synthesis.lux | 2 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/extension/translation.lux | 2 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux | 2 |
10 files changed, 88 insertions, 95 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux index 1463e7ec5..d19e98bd8 100644 --- a/new-luxc/source/luxc/lang/analysis/expression.lux +++ b/new-luxc/source/luxc/lang/analysis/expression.lux @@ -13,14 +13,14 @@ (lang ["&." module] [".L" host] [".L" macro] + [".L" extension] ["la" analysis] (translation [".T" common]))) (// [".A" common] [".A" function] [".A" primitive] [".A" reference] - [".A" structure] - [".A" procedure])) + [".A" structure])) (exception: #export Macro-Expression-Must-Have-Single-Expansion) (exception: #export Unrecognized-Syntax) @@ -64,7 +64,9 @@ (referenceA.analyse-reference reference) (^ (#.Form (list& [_ (#.Text proc-name)] proc-args))) - (procedureA.analyse-procedure analyse eval proc-name proc-args) + (do macro.Monad<Meta> + [procedure (extensionL.find-analysis proc-name)] + (procedure analyse eval proc-args)) (^template [<tag> <analyser>] (^ (#.Form (list& [_ (<tag> tag)] diff --git a/new-luxc/source/luxc/lang/analysis/procedure.lux b/new-luxc/source/luxc/lang/analysis/procedure.lux deleted file mode 100644 index 25e1be335..000000000 --- a/new-luxc/source/luxc/lang/analysis/procedure.lux +++ /dev/null @@ -1,26 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - [text] - text/format - (coll [dict]))) - (luxc ["&" lang] - (lang ["la" analysis])) - (/ ["/." common] - ["/." host])) - -(exception: #export Unknown-Procedure) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (analyse-procedure analyse eval proc-name proc-args) - (-> &.Analyser &.Eval Text (List Code) (Meta la.Analysis)) - (<| (maybe.default (&.throw Unknown-Procedure (%t proc-name))) - (do maybe.Monad<Maybe> - [proc (dict.get proc-name procedures)] - (wrap ((proc proc-name) analyse eval proc-args))))) diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux index d38d564fb..248bfbb71 100644 --- a/new-luxc/source/luxc/lang/extension.lux +++ b/new-luxc/source/luxc/lang/extension.lux @@ -18,16 +18,24 @@ (exception: #export Cannot-Define-Translation-More-Than-Once) (exception: #export Cannot-Define-Statement-More-Than-Once) -(type: #export Expression +(type: #export Analysis + (-> (-> Code (Meta Code)) + (-> Type Code (Meta Top)) + (List Code) (Meta Code))) + +(type: #export Synthesis + (-> (List Code) (Meta Code))) + +(type: #export Translation (-> (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) + {#analysis (Dict Text Analysis) + #synthesis (Dict Text Synthesis) + #translation (Dict Text Translation) #statement (Dict Text Statement)}) (def: #export fresh @@ -61,10 +69,10 @@ #.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] + [find-analysis Analysis #analysis Unknown-Analysis] + [find-synthesis Synthesis #synthesis Unknown-Synthesis] + [find-translation Translation #translation Unknown-Translation] + [find-statement Statement #statement Unknown-Statement] ) (do-template [<name> <type> <category> <exception>] @@ -77,8 +85,8 @@ _ (..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] + [install-analysis Analysis #analysis Cannot-Define-Analysis-More-Than-Once] + [install-synthesis Synthesis #synthesis Cannot-Define-Synthesis-More-Than-Once] + [install-translation Translation #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 index d034f2919..30f43acef 100644 --- a/new-luxc/source/luxc/lang/extension/analysis.lux +++ b/new-luxc/source/luxc/lang/extension/analysis.lux @@ -1,9 +1,19 @@ (.module: lux (lux (data [text] - (coll [dict #+ Dict]))) - [//]) + (coll [list "list/" Functor<List>] + [dict #+ Dict]))) + [//] + [/common] + [/host]) + +(def: realize + (-> /common.Bundle (Dict Text //.Analysis)) + (|>> dict.entries + (list/map (function [[name proc]] [name (proc name)])) + (dict.from-list text.Hash<Text>))) (def: #export defaults - (Dict Text //.Expression) - (dict.new text.Hash<Text>)) + (Dict Text //.Analysis) + (realize (dict.merge /common.procedures + /host.procedures))) diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux index ecdcd0bfd..079001b26 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux @@ -17,20 +17,18 @@ (analysis ["&." common] [".A" function] [".A" case] - [".A" type])))) + [".A" type]))) + [///]) (exception: #export Incorrect-Procedure-Arity) (exception: #export Invalid-Syntax) ## [Utils] -(type: #export Proc - (-> &.Analyser &.Eval (List Code) (Meta la.Analysis))) - (type: #export Bundle - (Dict Text (-> Text Proc))) + (Dict Text (-> Text ///.Analysis))) (def: #export (install name unnamed) - (-> Text (-> Text Proc) + (-> Text (-> Text ///.Analysis) (-> Bundle Bundle)) (dict.put name unnamed)) @@ -48,7 +46,7 @@ " Actual Arity: " (|> actual nat-to-int %i))) (def: (simple proc inputsT+ outputT) - (-> Text (List Type) Type Proc) + (-> Text (List Type) Type ///.Analysis) (let [num-expected (list.size inputsT+)] (function [analyse eval args] (let [num-actual (list.size args)] @@ -64,25 +62,25 @@ (&.throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual))))))) (def: #export (nullary valueT proc) - (-> Type Text Proc) + (-> Type Text ///.Analysis) (simple proc (list) valueT)) (def: #export (unary inputT outputT proc) - (-> Type Type Text Proc) + (-> Type Type Text ///.Analysis) (simple proc (list inputT) outputT)) (def: #export (binary subjectT paramT outputT proc) - (-> Type Type Type Text Proc) + (-> Type Type Type Text ///.Analysis) (simple proc (list subjectT paramT) outputT)) (def: #export (trinary subjectT param0T param1T outputT proc) - (-> Type Type Type Type Text Proc) + (-> Type Type Type Type Text ///.Analysis) (simple proc (list subjectT param0T param1T) outputT)) ## [Analysers] ## "lux is" represents reference/pointer equality. (def: (lux//is proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] @@ -92,7 +90,7 @@ ## "lux try" provides a simple way to interact with the host platform's ## error-handling facilities. (def: (lux//try proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list opC)) @@ -107,7 +105,7 @@ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args)))))) (def: (lux//function proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list [_ (#.Symbol ["" func-name])] @@ -119,7 +117,7 @@ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list.size args)))))) (def: (lux//case proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list input [_ (#.Record branches)])) @@ -129,7 +127,7 @@ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args)))))) (def: (lux//in-module proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval argsC+] (case argsC+ (^ (list [_ (#.Text module-name)] exprC)) @@ -146,7 +144,7 @@ (do-template [<name> <analyser>] [(def: (<name> proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list typeC valueC)) @@ -159,7 +157,7 @@ [lux//coerce typeA.analyse-coerce]) (def: (lux//check//type proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list valueC)) @@ -296,7 +294,7 @@ ))) (def: (array//get proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] @@ -304,7 +302,7 @@ analyse eval args)))) (def: (array//put proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] @@ -312,7 +310,7 @@ analyse eval args)))) (def: (array//remove proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] @@ -355,7 +353,7 @@ ))) (def: (atom-new proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list initC)) @@ -370,7 +368,7 @@ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args)))))) (def: (atom-read proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] @@ -378,7 +376,7 @@ analyse eval args)))) (def: (atom//compare-and-swap proc) - (-> Text Proc) + (-> Text ///.Analysis) (function [analyse eval args] (do macro.Monad<Meta> [[var-id varT] (&.with-type-env tc.var)] diff --git a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux index 3c29410d0..dba0e3e66 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux @@ -26,6 +26,7 @@ (analysis ["&." common] [".A" inference]))) ["@" //common] + [///] ) (exception: #export Wrong-Syntax) @@ -190,7 +191,7 @@ (dict.from-list text.Hash<Text>))) (def: (array-length proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list arrayC)) @@ -205,7 +206,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args)))))) (def: (array-new proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list lengthC)) @@ -296,7 +297,7 @@ (&.throw Invalid-Type-For-Array-Element (%type elemT)))) (def: (array-read proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list arrayC idxC)) @@ -316,7 +317,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args)))))) (def: (array-write proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list arrayC idxC valueC)) @@ -348,7 +349,7 @@ ))) (def: (object-null proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list)) @@ -361,7 +362,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +0 (list.size args)))))) (def: (object-null? proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list objectC)) @@ -376,7 +377,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args)))))) (def: (object-synchronized proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list monitorC exprC)) @@ -471,7 +472,7 @@ (wrap (Class::isAssignableFrom [sub] super)))) (def: (object-throw proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list exceptionC)) @@ -491,7 +492,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args)))))) (def: (object-class proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list classC)) @@ -509,7 +510,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args)))))) (def: (object-instance? proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list classC objectC)) @@ -804,7 +805,7 @@ (wrap [castT unboxed sourceA]))) (def: (static-get proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list classC fieldC)) @@ -823,7 +824,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args)))))) (def: (static-put proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list classC fieldC valueC)) @@ -847,7 +848,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args)))))) (def: (virtual-get proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list classC fieldC objectC)) @@ -867,7 +868,7 @@ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args)))))) (def: (virtual-put proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case args (^ (list classC fieldC valueC objectC)) @@ -1111,7 +1112,7 @@ (wrap argA)))) (def: (invoke//static proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case (: (e.Error [Text Text (List [Text Code])]) (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any)))))) @@ -1128,7 +1129,7 @@ (&.throw Wrong-Syntax (wrong-syntax proc args))))) (def: (invoke//virtual proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case (: (e.Error [Text Text Code (List [Text Code])]) (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any)))))) @@ -1151,7 +1152,7 @@ (&.throw Wrong-Syntax (wrong-syntax proc args))))) (def: (invoke//special proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Unit]]) (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!))) @@ -1168,7 +1169,7 @@ (&.throw Wrong-Syntax (wrong-syntax proc args))))) (def: (invoke//interface proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case (: (e.Error [Text Text Code (List [Text Code])]) (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any)))))) @@ -1189,7 +1190,7 @@ (&.throw Wrong-Syntax (wrong-syntax proc args))))) (def: (invoke//constructor proc) - (-> Text @.Proc) + (-> Text ///.Analysis) (function [analyse eval args] (case (: (e.Error [Text (List [Text Code])]) (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any)))))) diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux index 6e9530f38..7cb404b13 100644 --- a/new-luxc/source/luxc/lang/extension/statement.lux +++ b/new-luxc/source/luxc/lang/extension/statement.lux @@ -126,10 +126,10 @@ _ (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]) + [lux//analysis //.Analysis //.install-analysis] + [lux//synthesis //.Synthesis //.install-synthesis] + [lux//translation //.Translation //.install-translation] + [lux//statement //.Statement //.install-statement]) (def: #export defaults (Dict Text //.Statement) diff --git a/new-luxc/source/luxc/lang/extension/synthesis.lux b/new-luxc/source/luxc/lang/extension/synthesis.lux index d034f2919..32d726796 100644 --- a/new-luxc/source/luxc/lang/extension/synthesis.lux +++ b/new-luxc/source/luxc/lang/extension/synthesis.lux @@ -5,5 +5,5 @@ [//]) (def: #export defaults - (Dict Text //.Expression) + (Dict Text //.Synthesis) (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 index d034f2919..663babdb6 100644 --- a/new-luxc/source/luxc/lang/extension/translation.lux +++ b/new-luxc/source/luxc/lang/extension/translation.lux @@ -5,5 +5,5 @@ [//]) (def: #export defaults - (Dict Text //.Expression) + (Dict Text //.Translation) (dict.new text.Hash<Text>)) diff --git a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux index f2f88904d..f737e81fc 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux @@ -21,7 +21,7 @@ ["$d" def] ["$i" inst])) ["la" analysis] - (analysis (procedure ["&." host])) + (extension (analysis ["&." host])) ["ls" synthesis])) ["@" //common]) |