aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang.lux172
-rw-r--r--new-luxc/source/luxc/lang/analysis.lux40
-rw-r--r--new-luxc/source/luxc/lang/analysis/case.lux312
-rw-r--r--new-luxc/source/luxc/lang/analysis/case/coverage.lux106
-rw-r--r--new-luxc/source/luxc/lang/analysis/common.lux12
-rw-r--r--new-luxc/source/luxc/lang/analysis/expression.lux106
-rw-r--r--new-luxc/source/luxc/lang/analysis/function.lux84
-rw-r--r--new-luxc/source/luxc/lang/analysis/inference.lux188
-rw-r--r--new-luxc/source/luxc/lang/analysis/primitive.lux22
-rw-r--r--new-luxc/source/luxc/lang/analysis/procedure.lux20
-rw-r--r--new-luxc/source/luxc/lang/analysis/procedure/common.lux168
-rw-r--r--new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux1130
-rw-r--r--new-luxc/source/luxc/lang/analysis/reference.lux44
-rw-r--r--new-luxc/source/luxc/lang/analysis/structure.lux278
-rw-r--r--new-luxc/source/luxc/lang/analysis/type.lux18
-rw-r--r--new-luxc/source/luxc/lang/eval.lux24
-rw-r--r--new-luxc/source/luxc/lang/host.jvm.lux176
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux60
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux305
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux212
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/type.lux148
-rw-r--r--new-luxc/source/luxc/lang/macro.lux42
-rw-r--r--new-luxc/source/luxc/lang/module.lux188
-rw-r--r--new-luxc/source/luxc/lang/scope.lux142
-rw-r--r--new-luxc/source/luxc/lang/synthesis.lux2
-rw-r--r--new-luxc/source/luxc/lang/synthesis/case.lux56
-rw-r--r--new-luxc/source/luxc/lang/synthesis/expression.lux160
-rw-r--r--new-luxc/source/luxc/lang/synthesis/function.lux18
-rw-r--r--new-luxc/source/luxc/lang/synthesis/loop.lux118
-rw-r--r--new-luxc/source/luxc/lang/synthesis/variable.lux64
-rw-r--r--new-luxc/source/luxc/lang/translation.lux268
-rw-r--r--new-luxc/source/luxc/lang/translation/case.jvm.lux262
-rw-r--r--new-luxc/source/luxc/lang/translation/common.jvm.lux74
-rw-r--r--new-luxc/source/luxc/lang/translation/eval.jvm.lux88
-rw-r--r--new-luxc/source/luxc/lang/translation/expression.jvm.lux74
-rw-r--r--new-luxc/source/luxc/lang/translation/function.jvm.lux376
-rw-r--r--new-luxc/source/luxc/lang/translation/imports.jvm.lux102
-rw-r--r--new-luxc/source/luxc/lang/translation/loop.jvm.lux72
-rw-r--r--new-luxc/source/luxc/lang/translation/primitive.jvm.lux30
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure.jvm.lux22
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux576
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux1012
-rw-r--r--new-luxc/source/luxc/lang/translation/reference.jvm.lux40
-rw-r--r--new-luxc/source/luxc/lang/translation/runtime.jvm.lux884
-rw-r--r--new-luxc/source/luxc/lang/translation/statement.jvm.lux87
-rw-r--r--new-luxc/source/luxc/lang/translation/structure.jvm.lux52
-rw-r--r--new-luxc/source/luxc/lang/variable.lux18
47 files changed, 4193 insertions, 4259 deletions
diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux
index b85409fb9..5a00794f8 100644
--- a/new-luxc/source/luxc/lang.lux
+++ b/new-luxc/source/luxc/lang.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -17,59 +17,59 @@
(-> Type Code (Meta Top)))
(type: #export Analyser
- (-> Code (Meta la;Analysis)))
+ (-> Code (Meta la.Analysis)))
(def: #export version Text "0.6.0")
(def: #export (fail message)
(All [a] (-> Text (Meta a)))
- (do macro;Monad<Meta>
- [[file line col] macro;cursor
+ (do macro.Monad<Meta>
+ [[file line col] macro.cursor
#let [location (format file
"," (|> line nat-to-int %i)
"," (|> col nat-to-int %i))]]
- (macro;fail (format message "\n\n"
+ (macro.fail (format message "\n\n"
"@ " location))))
(def: #export (throw exception message)
- (All [a] (-> ex;Exception Text (Meta a)))
+ (All [a] (-> ex.Exception Text (Meta a)))
(fail (exception message)))
(syntax: #export (assert exception message test)
(wrap (list (` (if (~ test)
- (:: macro;Monad<Meta> (~' wrap) [])
- (;;throw (~ exception) (~ message)))))))
+ (:: macro.Monad<Meta> (~' wrap) [])
+ (..throw (~ exception) (~ message)))))))
(def: #export (with-type expected action)
(All [a] (-> Type (Meta a) (Meta a)))
(function [compiler]
- (case (action (set@ #;expected (#;Some expected) compiler))
- (#e;Success [compiler' output])
- (let [old-expected (get@ #;expected compiler)]
- (#e;Success [(set@ #;expected old-expected compiler')
+ (case (action (set@ #.expected (#.Some expected) compiler))
+ (#e.Success [compiler' output])
+ (let [old-expected (get@ #.expected compiler)]
+ (#e.Success [(set@ #.expected old-expected compiler')
output]))
- (#e;Error error)
- (#e;Error error))))
+ (#e.Error error)
+ (#e.Error error))))
(def: #export (with-type-env action)
- (All [a] (-> (tc;Check a) (Meta a)))
+ (All [a] (-> (tc.Check a) (Meta a)))
(function [compiler]
- (case (action (get@ #;type-context compiler))
- (#e;Error error)
+ (case (action (get@ #.type-context compiler))
+ (#e.Error error)
((fail error) compiler)
- (#e;Success [context' output])
- (#e;Success [(set@ #;type-context context' compiler)
+ (#e.Success [context' output])
+ (#e.Success [(set@ #.type-context context' compiler)
output]))))
(def: #export (with-fresh-type-env action)
(All [a] (-> (Meta a) (Meta a)))
(function [compiler]
- (let [old (get@ #;type-context compiler)]
- (case (action (set@ #;type-context tc;fresh-context compiler))
- (#e;Success [compiler' output])
- (#e;Success [(set@ #;type-context old compiler')
+ (let [old (get@ #.type-context compiler)]
+ (case (action (set@ #.type-context tc.fresh-context compiler))
+ (#e.Success [compiler' output])
+ (#e.Success [(set@ #.type-context old compiler')
output])
output
@@ -77,133 +77,133 @@
(def: #export (infer actualT)
(-> Type (Meta Unit))
- (do macro;Monad<Meta>
- [expectedT macro;expected-type]
+ (do macro.Monad<Meta>
+ [expectedT macro.expected-type]
(with-type-env
- (tc;check expectedT actualT))))
+ (tc.check expectedT actualT))))
(def: #export (pl-get key table)
(All [a] (-> Text (List [Text a]) (Maybe a)))
(case table
- #;Nil
- #;None
+ #.Nil
+ #.None
- (#;Cons [k' v'] table')
+ (#.Cons [k' v'] table')
(if (text/= key k')
- (#;Some v')
+ (#.Some v')
(pl-get key table'))))
(def: #export (pl-contains? key table)
(All [a] (-> Text (List [Text a]) Bool))
(case (pl-get key table)
- (#;Some _)
+ (#.Some _)
true
- #;None
+ #.None
false))
(def: #export (pl-put key val table)
(All [a] (-> Text a (List [Text a]) (List [Text a])))
(case table
- #;Nil
+ #.Nil
(list [key val])
- (#;Cons [k' v'] table')
+ (#.Cons [k' v'] table')
(if (text/= key k')
- (#;Cons [key val]
+ (#.Cons [key val]
table')
- (#;Cons [k' v']
+ (#.Cons [k' v']
(pl-put key val table')))))
(def: #export (pl-update key f table)
(All [a] (-> Text (-> a a) (List [Text a]) (List [Text a])))
(case table
- #;Nil
- #;Nil
+ #.Nil
+ #.Nil
- (#;Cons [k' v'] table')
+ (#.Cons [k' v'] table')
(if (text/= key k')
- (#;Cons [k' (f v')] table')
- (#;Cons [k' v'] (pl-update key f table')))))
+ (#.Cons [k' (f v')] table')
+ (#.Cons [k' v'] (pl-update key f table')))))
(def: #export (with-source-code source action)
(All [a] (-> Source (Meta a) (Meta a)))
(function [compiler]
- (let [old-source (get@ #;source compiler)]
- (case (action (set@ #;source source compiler))
- (#e;Error error)
- (#e;Error error)
+ (let [old-source (get@ #.source compiler)]
+ (case (action (set@ #.source source compiler))
+ (#e.Error error)
+ (#e.Error error)
- (#e;Success [compiler' output])
- (#e;Success [(set@ #;source old-source compiler')
+ (#e.Success [compiler' output])
+ (#e.Success [(set@ #.source old-source compiler')
output])))))
(def: #export (with-stacked-errors handler action)
(All [a] (-> (-> [] Text) (Meta a) (Meta a)))
(function [compiler]
(case (action compiler)
- (#e;Success [compiler' output])
- (#e;Success [compiler' output])
+ (#e.Success [compiler' output])
+ (#e.Success [compiler' output])
- (#e;Error error)
- (#e;Error (if (text/= "" error)
+ (#e.Error error)
+ (#e.Error (if (text/= "" error)
(handler [])
(format (handler []) "\n\n-----------------------------------------\n\n" error))))))
(def: fresh-bindings
(All [k v] (Bindings k v))
- {#;counter +0
- #;mappings (list)})
+ {#.counter +0
+ #.mappings (list)})
(def: fresh-scope
Scope
- {#;name (list)
- #;inner +0
- #;locals fresh-bindings
- #;captured fresh-bindings})
+ {#.name (list)
+ #.inner +0
+ #.locals fresh-bindings
+ #.captured fresh-bindings})
(def: #export (with-scope action)
(All [a] (-> (Meta a) (Meta [Scope a])))
(function [compiler]
- (case (action (update@ #;scopes (|>. (#;Cons fresh-scope)) compiler))
- (#e;Success [compiler' output])
- (case (get@ #;scopes compiler')
- #;Nil
- (#e;Error "Impossible error: Drained scopes!")
-
- (#;Cons head tail)
- (#e;Success [(set@ #;scopes tail compiler')
+ (case (action (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler))
+ (#e.Success [compiler' output])
+ (case (get@ #.scopes compiler')
+ #.Nil
+ (#e.Error "Impossible error: Drained scopes!")
+
+ (#.Cons head tail)
+ (#e.Success [(set@ #.scopes tail compiler')
[head output]]))
- (#e;Error error)
- (#e;Error error))))
+ (#e.Error error)
+ (#e.Error error))))
(def: #export (with-current-module name action)
(All [a] (-> Text (Meta a) (Meta a)))
(function [compiler]
- (case (action (set@ #;current-module (#;Some name) compiler))
- (#e;Success [compiler' output])
- (#e;Success [(set@ #;current-module
- (get@ #;current-module compiler)
+ (case (action (set@ #.current-module (#.Some name) compiler))
+ (#e.Success [compiler' output])
+ (#e.Success [(set@ #.current-module
+ (get@ #.current-module compiler)
compiler')
output])
- (#e;Error error)
- (#e;Error error))))
+ (#e.Error error)
+ (#e.Error error))))
(def: #export (with-cursor cursor action)
(All [a] (-> Cursor (Meta a) (Meta a)))
- (if (text/= "" (product;left cursor))
+ (if (text/= "" (product.left cursor))
action
(function [compiler]
- (let [old-cursor (get@ #;cursor compiler)]
- (case (action (set@ #;cursor cursor compiler))
- (#e;Success [compiler' output])
- (#e;Success [(set@ #;cursor old-cursor compiler')
+ (let [old-cursor (get@ #.cursor compiler)]
+ (case (action (set@ #.cursor cursor compiler))
+ (#e.Success [compiler' output])
+ (#e.Success [(set@ #.cursor old-cursor compiler')
output])
- (#e;Error error)
- (#e;Error error))))))
+ (#e.Error error)
+ (#e.Error error))))))
(def: (normalize-char char)
(-> Nat Text)
@@ -232,17 +232,17 @@
(^ (char "~")) "_TILDE_"
(^ (char "|")) "_PIPE_"
_
- (text;from-code char)))
+ (text.from-code char)))
-(def: underflow Nat (n.dec +0))
+(def: underflow Nat (n/dec +0))
(def: #export (normalize-name name)
(-> Text Text)
- (loop [idx (n.dec (text;size name))
+ (loop [idx (n/dec (text.size name))
output ""]
- (if (n.= underflow idx)
+ (if (n/= underflow idx)
output
- (recur (n.dec idx) (format (|> (text;nth idx name) maybe;assume normalize-char) output)))))
+ (recur (n/dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output)))))
(exception: #export Error)
@@ -250,7 +250,7 @@
(All [a] (-> (Meta a) (Meta a)))
(function [compiler]
(case (action compiler)
- (#e;Error error)
+ (#e.Error error)
((throw Error error) compiler)
output
diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index f6163feb1..107d4979e 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -1,9 +1,9 @@
-(;module:
+(.module:
lux
(lux [function]
(data (coll [list "list/" Fold<List>]))
(macro [code]))
- (luxc (lang [";L" variable #+ Variable])))
+ (luxc (lang [".L" variable #+ Variable])))
(type: #export Pattern Code)
@@ -28,23 +28,23 @@
(def: #export (sum tag size temp value)
(-> Nat Nat Nat Analysis Analysis)
- (if (n.= (n.dec size) tag)
- (if (n.= +1 tag)
+ (if (n/= (n/dec size) tag)
+ (if (n/= +1 tag)
(sum-right value)
- (list/fold (function;const sum-left)
+ (list/fold (function.const sum-left)
(sum-right value)
- (list;n.range +0 (n.- +2 tag))))
- (list/fold (function;const sum-left)
+ (list.n/range +0 (n/- +2 tag))))
+ (list/fold (function.const sum-left)
(case value
(^or (^code ("lux sum left" (~ inner)))
(^code ("lux sum right" (~ inner))))
(` ("lux case" (~ value)
- {("lux case bind" (~ (code;nat temp)))
- ((~ (code;int (local-variable temp))))}))
+ {("lux case bind" (~ (code.nat temp)))
+ ((~ (code.int (local-variable temp))))}))
_
value)
- (list;n.range +0 tag))))
+ (list.n/range +0 tag))))
## Tuples get analysed into binary products for the sake of semantic
## simplicity, since products/pairs can encode tuples of any length
@@ -53,13 +53,13 @@
(def: #export (product members)
(-> (List Analysis) Analysis)
(case members
- #;Nil
+ #.Nil
(` [])
- (#;Cons singleton #;Nil)
+ (#.Cons singleton #.Nil)
singleton
- (#;Cons left right)
+ (#.Cons left right)
(` [(~ left) (~ (product right))])))
## Function application gets analysed into single-argument
@@ -75,17 +75,17 @@
(def: #export (procedure name args)
(-> Text (List Analysis) Analysis)
- (` ((~ (code;text name)) (~@ args))))
+ (` ((~ (code.text name)) (~@ args))))
(def: #export (var idx)
(-> Variable Analysis)
- (` ((~ (code;int idx)))))
+ (` ((~ (code.int idx)))))
(def: #export (unfold-tuple analysis)
(-> Analysis (List Analysis))
(case analysis
(^code [(~ left) (~ right)])
- (#;Cons left (unfold-tuple right))
+ (#.Cons left (unfold-tuple right))
_
(list analysis)))
@@ -99,13 +99,13 @@
(case valueA
(^or (^code ("lux sum left" (~ _)))
(^code ("lux sum right" (~ _))))
- (recur (n.inc so-far) valueA)
+ (recur (n/inc so-far) valueA)
_
- (#;Some [so-far false valueA]))
+ (#.Some [so-far false valueA]))
(^code ("lux sum right" (~ valueA)))
- (#;Some [(n.inc so-far) true valueA])
+ (#.Some [(n/inc so-far) true valueA])
_
- #;None)))
+ #.None)))
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index 949e18a26..16f775907 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
@@ -16,11 +16,11 @@
(lang [type]
(type ["tc" check])))
(luxc ["&" lang]
- (lang ["&;" scope]
+ (lang ["&." scope]
["la" analysis]
- (analysis [";A" common]
- [";A" structure]
- (case [";A" coverage])))))
+ (analysis [".A" common]
+ [".A" structure]
+ (case [".A" coverage])))))
(exception: #export Cannot-Match-Type-With-Pattern)
(exception: #export Sum-Type-Has-No-Case)
@@ -38,11 +38,11 @@
(def: (re-quantify envs baseT)
(-> (List (List Type)) Type Type)
(case envs
- #;Nil
+ #.Nil
baseT
- (#;Cons head tail)
- (re-quantify tail (#;UnivQ head baseT))))
+ (#.Cons head tail)
+ (re-quantify tail (#.UnivQ head baseT))))
## Type-checking on the input value is done during the analysis of a
## "case" expression, to ensure that the patterns being used make
@@ -57,70 +57,70 @@
(list))
caseT caseT]
(case caseT
- (#;Var id)
- (do macro;Monad<Meta>
- [?caseT' (&;with-type-env
- (tc;read id))]
+ (#.Var id)
+ (do macro.Monad<Meta>
+ [?caseT' (&.with-type-env
+ (tc.read id))]
(case ?caseT'
- (#;Some caseT')
+ (#.Some caseT')
(recur envs caseT')
_
- (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
+ (&.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
- (#;Named name unnamedT)
+ (#.Named name unnamedT)
(recur envs unnamedT)
- (#;UnivQ env unquantifiedT)
- (recur (#;Cons env envs) unquantifiedT)
+ (#.UnivQ env unquantifiedT)
+ (recur (#.Cons env envs) unquantifiedT)
## (^template [<tag> <instancer>]
## (<tag> _)
- ## (do macro;Monad<Meta>
- ## [[_ instanceT] (&;with-type-env
+ ## (do macro.Monad<Meta>
+ ## [[_ instanceT] (&.with-type-env
## <instancer>)]
- ## (recur (maybe;assume (type;apply (list instanceT) caseT)))))
- ## ([#;UnivQ tc;var]
- ## [#;ExQ tc;existential])
+ ## (recur (maybe.assume (type.apply (list instanceT) caseT)))))
+ ## ([#.UnivQ tc.var]
+ ## [#.ExQ tc.existential])
- (#;ExQ _)
- (do macro;Monad<Meta>
- [[ex-id exT] (&;with-type-env
- tc;existential)]
- (recur envs (maybe;assume (type;apply (list exT) caseT))))
+ (#.ExQ _)
+ (do macro.Monad<Meta>
+ [[ex-id exT] (&.with-type-env
+ tc.existential)]
+ (recur envs (maybe.assume (type.apply (list exT) caseT))))
- (#;Apply inputT funcT)
+ (#.Apply inputT funcT)
(case funcT
- (#;Var funcT-id)
- (do macro;Monad<Meta>
- [funcT' (&;with-type-env
- (do tc;Monad<Check>
- [?funct' (tc;read funcT-id)]
+ (#.Var funcT-id)
+ (do macro.Monad<Meta>
+ [funcT' (&.with-type-env
+ (do tc.Monad<Check>
+ [?funct' (tc.read funcT-id)]
(case ?funct'
- (#;Some funct')
+ (#.Some funct')
(wrap funct')
_
- (tc;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))))]
- (recur envs (#;Apply inputT funcT')))
+ (tc.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))))]
+ (recur envs (#.Apply inputT funcT')))
_
- (case (type;apply (list inputT) funcT)
- (#;Some outputT)
+ (case (type.apply (list inputT) funcT)
+ (#.Some outputT)
(recur envs outputT)
- #;None
- (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
+ #.None
+ (&.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
- (#;Product _)
+ (#.Product _)
(|> caseT
- type;flatten-tuple
+ type.flatten-tuple
(list/map (re-quantify envs))
- type;tuple
- (:: macro;Monad<Meta> wrap))
+ type.tuple
+ (:: macro.Monad<Meta> wrap))
_
- (:: macro;Monad<Meta> wrap (re-quantify envs caseT)))))
+ (:: macro.Monad<Meta> wrap (re-quantify envs caseT)))))
## This function handles several concerns at once, but it must be that
## way because those concerns are interleaved when doing
@@ -139,169 +139,169 @@
## That is why the body must be analysed in the context of the
## pattern, and not separately.
(def: (analyse-pattern num-tags inputT pattern next)
- (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la;Pattern a])))
+ (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la.Pattern a])))
(case pattern
- [cursor (#;Symbol ["" name])]
- (&;with-cursor cursor
- (do macro;Monad<Meta>
- [outputA (&scope;with-local [name inputT]
+ [cursor (#.Symbol ["" name])]
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [outputA (&scope.with-local [name inputT]
next)
- idx &scope;next-local]
- (wrap [(` ("lux case bind" (~ (code;nat idx)))) outputA])))
+ idx &scope.next-local]
+ (wrap [(` ("lux case bind" (~ (code.nat idx)))) outputA])))
- [cursor (#;Symbol ident)]
- (&;with-cursor cursor
- (&;throw Symbols-Must-Be-Unqualified-Inside-Patterns (%ident ident)))
+ [cursor (#.Symbol ident)]
+ (&.with-cursor cursor
+ (&.throw Symbols-Must-Be-Unqualified-Inside-Patterns (%ident ident)))
(^template [<type> <code-tag>]
[cursor (<code-tag> test)]
- (&;with-cursor cursor
- (do macro;Monad<Meta>
- [_ (&;with-type-env
- (tc;check inputT <type>))
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [_ (&.with-type-env
+ (tc.check inputT <type>))
outputA next]
(wrap [pattern outputA]))))
- ([Bool #;Bool]
- [Nat #;Nat]
- [Int #;Int]
- [Deg #;Deg]
- [Frac #;Frac]
- [Text #;Text])
-
- (^ [cursor (#;Tuple (list))])
- (&;with-cursor cursor
- (do macro;Monad<Meta>
- [_ (&;with-type-env
- (tc;check inputT Unit))
+ ([Bool #.Bool]
+ [Nat #.Nat]
+ [Int #.Int]
+ [Deg #.Deg]
+ [Frac #.Frac]
+ [Text #.Text])
+
+ (^ [cursor (#.Tuple (list))])
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [_ (&.with-type-env
+ (tc.check inputT Unit))
outputA next]
(wrap [(` ("lux case tuple" [])) outputA])))
- (^ [cursor (#;Tuple (list singleton))])
- (analyse-pattern #;None inputT singleton next)
+ (^ [cursor (#.Tuple (list singleton))])
+ (analyse-pattern #.None inputT singleton next)
- [cursor (#;Tuple sub-patterns)]
- (&;with-cursor cursor
- (do macro;Monad<Meta>
+ [cursor (#.Tuple sub-patterns)]
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
[inputT' (simplify-case-type inputT)]
(case inputT'
- (#;Product _)
- (let [sub-types (type;flatten-tuple inputT')
- num-sub-types (maybe;default (list;size sub-types)
+ (#.Product _)
+ (let [sub-types (type.flatten-tuple inputT')
+ num-sub-types (maybe.default (list.size sub-types)
num-tags)
- num-sub-patterns (list;size sub-patterns)
- matches (cond (n.< num-sub-types num-sub-patterns)
- (let [[prefix suffix] (list;split (n.dec num-sub-patterns) sub-types)]
- (list;zip2 (list/compose prefix (list (type;tuple suffix))) sub-patterns))
-
- (n.> num-sub-types num-sub-patterns)
- (let [[prefix suffix] (list;split (n.dec num-sub-types) sub-patterns)]
- (list;zip2 sub-types (list/compose prefix (list (code;tuple suffix)))))
+ num-sub-patterns (list.size sub-patterns)
+ matches (cond (n/< num-sub-types num-sub-patterns)
+ (let [[prefix suffix] (list.split (n/dec num-sub-patterns) sub-types)]
+ (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns))
+
+ (n/> num-sub-types num-sub-patterns)
+ (let [[prefix suffix] (list.split (n/dec num-sub-types) sub-patterns)]
+ (list.zip2 sub-types (list/compose prefix (list (code.tuple suffix)))))
- ## (n.= num-sub-types num-sub-patterns)
- (list;zip2 sub-types sub-patterns)
+ ## (n/= num-sub-types num-sub-patterns)
+ (list.zip2 sub-types sub-patterns)
)]
(do @
[[memberP+ thenA] (list/fold (: (All [a]
- (-> [Type Code] (Meta [(List la;Pattern) a])
- (Meta [(List la;Pattern) a])))
+ (-> [Type Code] (Meta [(List la.Pattern) a])
+ (Meta [(List la.Pattern) a])))
(function [[memberT memberC] then]
(do @
- [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la;Pattern a])))
+ [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la.Pattern a])))
analyse-pattern)
- #;None memberT memberC then)]
+ #.None memberT memberC then)]
(wrap [(list& memberP memberP+) thenA]))))
(do @
[nextA next]
(wrap [(list) nextA]))
- (list;reverse matches))]
+ (list.reverse matches))]
(wrap [(` ("lux case tuple" [(~@ memberP+)]))
thenA])))
_
- (&;throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern))
+ (&.throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern))
)))
- [cursor (#;Record record)]
- (do macro;Monad<Meta>
- [record (structureA;normalize record)
- [members recordT] (structureA;order record)
- _ (&;with-type-env
- (tc;check inputT recordT))]
- (analyse-pattern (#;Some (list;size members)) inputT [cursor (#;Tuple members)] next))
-
- [cursor (#;Tag tag)]
- (&;with-cursor cursor
- (analyse-pattern #;None inputT (` ((~ pattern))) next))
-
- (^ [cursor (#;Form (list& [_ (#;Nat idx)] values))])
- (&;with-cursor cursor
- (do macro;Monad<Meta>
+ [cursor (#.Record record)]
+ (do macro.Monad<Meta>
+ [record (structureA.normalize record)
+ [members recordT] (structureA.order record)
+ _ (&.with-type-env
+ (tc.check inputT recordT))]
+ (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next))
+
+ [cursor (#.Tag tag)]
+ (&.with-cursor cursor
+ (analyse-pattern #.None inputT (` ((~ pattern))) next))
+
+ (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))])
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
[inputT' (simplify-case-type inputT)]
(case inputT'
- (#;Sum _)
- (let [flat-sum (type;flatten-variant inputT')
- size-sum (list;size flat-sum)
- num-cases (maybe;default size-sum num-tags)]
- (case (list;nth idx flat-sum)
- (^multi (#;Some case-type)
- (n.< num-cases idx))
- (if (and (n.> num-cases size-sum)
- (n.= (n.dec num-cases) idx))
- (do macro;Monad<Meta>
- [[testP nextA] (analyse-pattern #;None
- (type;variant (list;drop (n.dec num-cases) flat-sum))
+ (#.Sum _)
+ (let [flat-sum (type.flatten-variant inputT')
+ size-sum (list.size flat-sum)
+ num-cases (maybe.default size-sum num-tags)]
+ (case (list.nth idx flat-sum)
+ (^multi (#.Some case-type)
+ (n/< num-cases idx))
+ (if (and (n/> num-cases size-sum)
+ (n/= (n/dec num-cases) idx))
+ (do macro.Monad<Meta>
+ [[testP nextA] (analyse-pattern #.None
+ (type.variant (list.drop (n/dec num-cases) flat-sum))
(` [(~@ values)])
next)]
- (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP)))
+ (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
nextA]))
- (do macro;Monad<Meta>
- [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)]
- (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP)))
+ (do macro.Monad<Meta>
+ [[testP nextA] (analyse-pattern #.None case-type (` [(~@ values)]) next)]
+ (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
nextA])))
_
- (&;throw Sum-Type-Has-No-Case
+ (&.throw Sum-Type-Has-No-Case
(format "Case: " (%n idx) "\n"
"Type: " (%type inputT)))))
_
- (&;throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern)))))
+ (&.throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern)))))
- (^ [cursor (#;Form (list& [_ (#;Tag tag)] values))])
- (&;with-cursor cursor
- (do macro;Monad<Meta>
- [tag (macro;normalize tag)
- [idx group variantT] (macro;resolve-tag tag)
- _ (&;with-type-env
- (tc;check inputT variantT))]
- (analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next)))
+ (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [tag (macro.normalize tag)
+ [idx group variantT] (macro.resolve-tag tag)
+ _ (&.with-type-env
+ (tc.check inputT variantT))]
+ (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~@ values))) next)))
_
- (&;throw Unrecognized-Pattern-Syntax (%code pattern))
+ (&.throw Unrecognized-Pattern-Syntax (%code pattern))
))
(def: #export (analyse-case analyse inputC branches)
- (-> &;Analyser Code (List [Code Code]) (Meta la;Analysis))
+ (-> &.Analyser Code (List [Code Code]) (Meta la.Analysis))
(case branches
- #;Nil
- (&;throw Cannot-Have-Empty-Branches "")
+ #.Nil
+ (&.throw Cannot-Have-Empty-Branches "")
- (#;Cons [patternH bodyH] branchesT)
- (do macro;Monad<Meta>
- [[inputT inputA] (commonA;with-unknown-type
+ (#.Cons [patternH bodyH] branchesT)
+ (do macro.Monad<Meta>
+ [[inputT inputA] (commonA.with-unknown-type
(analyse inputC))
- outputH (analyse-pattern #;None inputT patternH (analyse bodyH))
- outputT (monad;map @
+ outputH (analyse-pattern #.None inputT patternH (analyse bodyH))
+ outputT (monad.map @
(function [[patternT bodyT]]
- (analyse-pattern #;None inputT patternT (analyse bodyT)))
+ (analyse-pattern #.None inputT patternT (analyse bodyT)))
branchesT)
- outputHC (|> outputH product;left coverageA;determine)
- outputTC (monad;map @ (|>. product;left coverageA;determine) outputT)
- _ (case (monad;fold e;Monad<Error> coverageA;merge outputHC outputTC)
- (#e;Success coverage)
- (&;assert Non-Exhaustive-Pattern-Matching ""
- (coverageA;exhaustive? coverage))
-
- (#e;Error error)
- (&;fail error))]
- (wrap (` ("lux case" (~ inputA) (~ (code;record (list& outputH outputT)))))))))
+ outputHC (|> outputH product.left coverageA.determine)
+ outputTC (monad.map @ (|>> product.left coverageA.determine) outputT)
+ _ (case (monad.fold e.Monad<Error> coverageA.merge outputHC outputTC)
+ (#e.Success coverage)
+ (&.assert Non-Exhaustive-Pattern-Matching ""
+ (coverageA.exhaustive? coverage))
+
+ (#e.Error error)
+ (&.fail error))]
+ (wrap (` ("lux case" (~ inputA) (~ (code.record (list& outputH outputT)))))))))
diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
index 283e21d02..5d34387b4 100644
--- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux
+++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
@@ -45,7 +45,7 @@
(exception: #export Unknown-Pattern)
(def: #export (determine pattern)
- (-> la;Pattern (Meta Coverage))
+ (-> la.Pattern (Meta Coverage))
(case pattern
## Binding amounts to exhaustive coverage because any value can be
## matched that way.
@@ -59,14 +59,14 @@
## Primitive patterns always have partial coverage because there
## are too many possibilities as far as values go.
- (^or [_ (#;Nat _)] [_ (#;Int _)] [_ (#;Deg _)]
- [_ (#;Frac _)] [_ (#;Text _)])
+ (^or [_ (#.Nat _)] [_ (#.Int _)] [_ (#.Deg _)]
+ [_ (#.Frac _)] [_ (#.Text _)])
(macro/wrap #Partial)
## Bools are the exception, since there is only "true" and
## "false", which means it is possible for boolean
## pattern-matching to become exhaustive if complementary parts meet.
- [_ (#;Bool value)]
+ [_ (#.Bool value)]
(macro/wrap (#Bool value))
## Tuple patterns can be exhaustive if there is exhaustiveness for all of
@@ -74,11 +74,11 @@
(^code ("lux case tuple" [(~@ subs)]))
(loop [subs subs]
(case subs
- #;Nil
+ #.Nil
(macro/wrap #Exhaustive)
- (#;Cons sub subs')
- (do macro;Monad<Meta>
+ (#.Cons sub subs')
+ (do macro.Monad<Meta>
[pre (determine sub)
post (recur subs')]
(if (exhaustive? post)
@@ -87,15 +87,15 @@
## Variant patterns can be shown to be exhaustive if all the possible
## cases are handled exhaustively.
- (^code ("lux case variant" (~ [_ (#;Nat tag-id)]) (~ [_ (#;Nat num-tags)]) (~ sub)))
- (do macro;Monad<Meta>
+ (^code ("lux case variant" (~ [_ (#.Nat tag-id)]) (~ [_ (#.Nat num-tags)]) (~ sub)))
+ (do macro.Monad<Meta>
[=sub (determine sub)]
(wrap (#Variant num-tags
- (|> (dict;new number;Hash<Nat>)
- (dict;put tag-id =sub)))))
+ (|> (dict.new number.Hash<Nat>)
+ (dict.put tag-id =sub)))))
_
- (&;throw Unknown-Pattern (%code pattern))))
+ (&.throw Unknown-Pattern (%code pattern))))
(def: (xor left right)
(-> Bool Bool Bool)
@@ -109,8 +109,8 @@
## Because of that, the presence of redundant patterns is assumed to
## be a bug, likely due to programmer carelessness.
(def: redundant-pattern
- (e;Error Coverage)
- (e;fail "Redundant pattern."))
+ (e.Error Coverage)
+ (e.fail "Redundant pattern."))
(def: (flatten-alt coverage)
(-> Coverage (List Coverage))
@@ -131,8 +131,8 @@
(bool/= sideR sideS)
[(#Variant allR casesR) (#Variant allS casesS)]
- (and (n.= allR allS)
- (:: (dict;Eq<Dict> =) = casesR casesS))
+ (and (n/= allR allS)
+ (:: (dict.Eq<Dict> =) = casesR casesS))
[(#Seq leftR rightR) (#Seq leftS rightS)]
(and (= leftR leftS)
@@ -141,10 +141,10 @@
[(#Alt _) (#Alt _)]
(let [flatR (flatten-alt reference)
flatS (flatten-alt sample)]
- (and (n.= (list;size flatR) (list;size flatS))
- (list;every? (function [[coverageR coverageS]]
+ (and (n/= (list.size flatR) (list.size flatS))
+ (list.every? (function [[coverageR coverageS]]
(= coverageR coverageS))
- (list;zip2 flatR flatS))))
+ (list.zip2 flatR flatS))))
_
false)))
@@ -156,7 +156,7 @@
## pattern-matching expression is exhaustive and whether it contains
## redundant patterns.
(def: #export (merge addition so-far)
- (-> Coverage Coverage (e;Error Coverage))
+ (-> Coverage Coverage (e.Error Coverage))
(case [addition so-far]
## The addition cannot possibly improve the coverage.
[_ #Exhaustive]
@@ -175,28 +175,28 @@
(error/wrap #Exhaustive)
[(#Variant allA casesA) (#Variant allSF casesSF)]
- (cond (not (n.= allSF allA))
- (e;fail "Variants do not match.")
+ (cond (not (n/= allSF allA))
+ (e.fail "Variants do not match.")
- (:: (dict;Eq<Dict> Eq<Coverage>) = casesSF casesA)
+ (:: (dict.Eq<Dict> Eq<Coverage>) = casesSF casesA)
redundant-pattern
## else
- (do e;Monad<Error>
- [casesM (monad;fold @
+ (do e.Monad<Error>
+ [casesM (monad.fold @
(function [[tagA coverageA] casesSF']
- (case (dict;get tagA casesSF')
- (#;Some coverageSF)
+ (case (dict.get tagA casesSF')
+ (#.Some coverageSF)
(do @
[coverageM (merge coverageA coverageSF)]
- (wrap (dict;put tagA coverageM casesSF')))
-
- #;None
- (wrap (dict;put tagA coverageA casesSF'))))
- casesSF (dict;entries casesA))]
- (wrap (if (let [case-coverages (dict;values casesM)]
- (and (n.= allSF (list;size case-coverages))
- (list;every? exhaustive? case-coverages)))
+ (wrap (dict.put tagA coverageM casesSF')))
+
+ #.None
+ (wrap (dict.put tagA coverageA casesSF'))))
+ casesSF (dict.entries casesA))]
+ (wrap (if (let [case-coverages (dict.values casesM)]
+ (and (n/= allSF (list.size case-coverages))
+ (list.every? exhaustive? case-coverages)))
#Exhaustive
(#Variant allSF casesM)))))
@@ -212,7 +212,7 @@
## Same prefix
[true false]
- (do e;Monad<Error>
+ (do e.Monad<Error>
[rightM (merge rightA rightSF)]
(if (exhaustive? rightM)
## If all that follows is exhaustive, then it can be safely dropped
@@ -223,7 +223,7 @@
## Same suffix
[false true]
- (do e;Monad<Error>
+ (do e.Monad<Error>
[leftM (merge leftA leftSF)]
(wrap (#Seq leftM rightA))))
@@ -247,48 +247,48 @@
## This process must be repeated until no further productive
## merges can be done.
[_ (#Alt leftS rightS)]
- (do e;Monad<Error>
+ (do e.Monad<Error>
[#let [fuse-once (: (-> Coverage (List Coverage)
- (e;Error [(Maybe Coverage)
+ (e.Error [(Maybe Coverage)
(List Coverage)]))
(function [coverage possibilities]
(loop [alts possibilities]
(case alts
- #;Nil
- (wrap [#;None (list coverage)])
+ #.Nil
+ (wrap [#.None (list coverage)])
- (#;Cons alt alts')
+ (#.Cons alt alts')
(case (merge coverage alt)
- (#e;Success altM)
+ (#e.Success altM)
(case altM
(#Alt _)
(do @
[[success alts+] (recur alts')]
- (wrap [success (#;Cons alt alts+)]))
+ (wrap [success (#.Cons alt alts+)]))
_
- (wrap [(#;Some altM) alts']))
+ (wrap [(#.Some altM) alts']))
- (#e;Error error)
- (e;fail error))
+ (#e.Error error)
+ (e.fail error))
))))]
[success possibilities] (fuse-once addition (flatten-alt so-far))]
(loop [success success
possibilities possibilities]
(case success
- (#;Some coverage')
+ (#.Some coverage')
(do @
[[success' possibilities'] (fuse-once coverage' possibilities)]
(recur success' possibilities'))
- #;None
- (case (list;reverse possibilities)
- (#;Cons last prevs)
+ #.None
+ (case (list.reverse possibilities)
+ (#.Cons last prevs)
(wrap (list/fold (function [left right] (#Alt left right))
last
prevs))
- #;Nil
+ #.Nil
(undefined)))))
_
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
index c1a2a4f5b..aeed656a8 100644
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/common.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad
["ex" exception #+ exception:])
@@ -12,18 +12,18 @@
(def: #export (with-unknown-type action)
(All [a] (-> (Meta a) (Meta [Type a])))
- (do macro;Monad<Meta>
- [[_ varT] (&;with-type-env tc;var)
- analysis (&;with-type varT
+ (do macro.Monad<Meta>
+ [[_ varT] (&.with-type-env tc.var)
+ analysis (&.with-type varT
action)
- knownT (&;with-type-env (tc;clean varT))]
+ knownT (&.with-type-env (tc.clean varT))]
(wrap [knownT analysis])))
(exception: #export Variant-Tag-Out-Of-Bounds)
(def: #export (variant-out-of-bounds-error type size tag)
(All [a] (-> Type Nat Nat (Meta a)))
- (&;throw Variant-Tag-Out-Of-Bounds
+ (&.throw Variant-Tag-Out-Of-Bounds
(format " Tag: " (%n tag) "\n"
"Variant Size: " (%n size) "\n"
"Variant Type: " (%type type))))
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index b16499c01..0f3cdcf6e 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -10,94 +10,94 @@
(type ["tc" check]))
[host])
(luxc ["&" lang]
- (lang ["&;" module]
- [";L" host]
- [";L" macro]
+ (lang ["&." module]
+ [".L" host]
+ [".L" macro]
["la" analysis]
- (translation [";T" common])))
- (// [";A" common]
- [";A" function]
- [";A" primitive]
- [";A" reference]
- [";A" structure]
- [";A" procedure]))
+ (translation [".T" common])))
+ (// [".A" common]
+ [".A" function]
+ [".A" primitive]
+ [".A" reference]
+ [".A" structure]
+ [".A" procedure]))
(exception: #export Macro-Expression-Must-Have-Single-Expansion)
(exception: #export Unrecognized-Syntax)
(exception: #export Macro-Expansion-Failed)
(def: #export (analyser eval)
- (-> &;Eval &;Analyser)
- (: (-> Code (Meta la;Analysis))
+ (-> &.Eval &.Analyser)
+ (: (-> Code (Meta la.Analysis))
(function analyse [code]
- (do macro;Monad<Meta>
- [expectedT macro;expected-type]
+ (do macro.Monad<Meta>
+ [expectedT macro.expected-type]
(let [[cursor code'] code]
## The cursor must be set in the compiler for the sake
## of having useful error messages.
- (&;with-cursor cursor
+ (&.with-cursor cursor
(case code'
(^template [<tag> <analyser>]
(<tag> value)
(<analyser> value))
- ([#;Bool primitiveA;analyse-bool]
- [#;Nat primitiveA;analyse-nat]
- [#;Int primitiveA;analyse-int]
- [#;Deg primitiveA;analyse-deg]
- [#;Frac primitiveA;analyse-frac]
- [#;Text primitiveA;analyse-text])
+ ([#.Bool primitiveA.analyse-bool]
+ [#.Nat primitiveA.analyse-nat]
+ [#.Int primitiveA.analyse-int]
+ [#.Deg primitiveA.analyse-deg]
+ [#.Frac primitiveA.analyse-frac]
+ [#.Text primitiveA.analyse-text])
- (^ (#;Tuple (list)))
- primitiveA;analyse-unit
+ (^ (#.Tuple (list)))
+ primitiveA.analyse-unit
## Singleton tuples are equivalent to the element they contain.
- (^ (#;Tuple (list singleton)))
+ (^ (#.Tuple (list singleton)))
(analyse singleton)
- (^ (#;Tuple elems))
- (structureA;analyse-product analyse elems)
+ (^ (#.Tuple elems))
+ (structureA.analyse-product analyse elems)
- (^ (#;Record pairs))
- (structureA;analyse-record analyse pairs)
+ (^ (#.Record pairs))
+ (structureA.analyse-record analyse pairs)
- (#;Symbol reference)
- (referenceA;analyse-reference reference)
+ (#.Symbol reference)
+ (referenceA.analyse-reference reference)
- (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
- (procedureA;analyse-procedure analyse eval proc-name proc-args)
+ (^ (#.Form (list& [_ (#.Text proc-name)] proc-args)))
+ (procedureA.analyse-procedure analyse eval proc-name proc-args)
(^template [<tag> <analyser>]
- (^ (#;Form (list& [_ (<tag> tag)]
+ (^ (#.Form (list& [_ (<tag> tag)]
values)))
(case values
- (#;Cons value #;Nil)
+ (#.Cons value #.Nil)
(<analyser> analyse tag value)
_
(<analyser> analyse tag (` [(~@ values)]))))
- ([#;Nat structureA;analyse-sum]
- [#;Tag structureA;analyse-tagged-sum])
+ ([#.Nat structureA.analyse-sum]
+ [#.Tag structureA.analyse-tagged-sum])
- (#;Tag tag)
- (structureA;analyse-tagged-sum analyse tag (' []))
+ (#.Tag tag)
+ (structureA.analyse-tagged-sum analyse tag (' []))
- (^ (#;Form (list& func args)))
- (do macro;Monad<Meta>
- [[funcT funcA] (commonA;with-unknown-type
+ (^ (#.Form (list& func args)))
+ (do macro.Monad<Meta>
+ [[funcT funcA] (commonA.with-unknown-type
(analyse func))]
(case funcA
- [_ (#;Symbol def-name)]
+ [_ (#.Symbol def-name)]
(do @
- [?macro (&;with-error-tracking
- (macro;find-macro def-name))]
+ [?macro (&.with-error-tracking
+ (macro.find-macro def-name))]
(case ?macro
- (#;Some macro)
+ (#.Some macro)
(do @
[expansion (: (Meta (List Code))
(function [compiler]
- (case (macroL;expand macro args compiler)
- (#e;Error error)
- ((&;throw Macro-Expansion-Failed error) compiler)
+ (case (macroL.expand macro args compiler)
+ (#e.Error error)
+ ((&.throw Macro-Expansion-Failed error) compiler)
output
output)))]
@@ -106,14 +106,14 @@
(analyse single)
_
- (&;throw Macro-Expression-Must-Have-Single-Expansion (%code code))))
+ (&.throw Macro-Expression-Must-Have-Single-Expansion (%code code))))
_
- (functionA;analyse-apply analyse funcT funcA args)))
+ (functionA.analyse-apply analyse funcT funcA args)))
_
- (functionA;analyse-apply analyse funcT funcA args)))
+ (functionA.analyse-apply analyse funcT funcA args)))
_
- (&;throw Unrecognized-Syntax (%code code))
+ (&.throw Unrecognized-Syntax (%code code))
)))))))
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux
index b4aa31c90..758acd681 100644
--- a/new-luxc/source/luxc/lang/analysis/function.lux
+++ b/new-luxc/source/luxc/lang/analysis/function.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad
["ex" exception #+ exception:])
@@ -11,11 +11,11 @@
(lang [type]
(type ["tc" check])))
(luxc ["&" lang]
- (lang ["&;" scope]
+ (lang ["&." scope]
["la" analysis #+ Analysis]
- (analysis ["&;" common]
- ["&;" inference])
- [";L" variable #+ Variable])))
+ (analysis ["&." common]
+ ["&." inference])
+ [".L" variable #+ Variable])))
(exception: #export Cannot-Analyse-Function)
(exception: #export Invalid-Function-Type)
@@ -23,81 +23,81 @@
## [Analysers]
(def: #export (analyse-function analyse func-name arg-name body)
- (-> &;Analyser Text Text Code (Meta Analysis))
- (do macro;Monad<Meta>
- [functionT macro;expected-type]
+ (-> &.Analyser Text Text Code (Meta Analysis))
+ (do macro.Monad<Meta>
+ [functionT macro.expected-type]
(loop [expectedT functionT]
- (&;with-stacked-errors
+ (&.with-stacked-errors
(function [_] (Cannot-Analyse-Function (format " Type: " (%type expectedT) "\n"
"Function: " func-name "\n"
"Argument: " arg-name "\n"
" Body: " (%code body))))
(case expectedT
- (#;Named name unnamedT)
+ (#.Named name unnamedT)
(recur unnamedT)
- (#;Apply argT funT)
- (case (type;apply (list argT) funT)
- (#;Some value)
+ (#.Apply argT funT)
+ (case (type.apply (list argT) funT)
+ (#.Some value)
(recur value)
- #;None
- (&;throw Invalid-Function-Type (%type expectedT)))
+ #.None
+ (&.throw Invalid-Function-Type (%type expectedT)))
(^template [<tag> <instancer>]
(<tag> _)
(do @
- [[_ instanceT] (&;with-type-env <instancer>)]
- (recur (maybe;assume (type;apply (list instanceT) expectedT)))))
- ([#;UnivQ tc;existential]
- [#;ExQ tc;var])
+ [[_ instanceT] (&.with-type-env <instancer>)]
+ (recur (maybe.assume (type.apply (list instanceT) expectedT)))))
+ ([#.UnivQ tc.existential]
+ [#.ExQ tc.var])
- (#;Var id)
+ (#.Var id)
(do @
- [?expectedT' (&;with-type-env
- (tc;read id))]
+ [?expectedT' (&.with-type-env
+ (tc.read id))]
(case ?expectedT'
- (#;Some expectedT')
+ (#.Some expectedT')
(recur expectedT')
_
## Inference
(do @
- [[input-id inputT] (&;with-type-env tc;var)
- [output-id outputT] (&;with-type-env tc;var)
- #let [funT (#;Function inputT outputT)]
+ [[input-id inputT] (&.with-type-env tc.var)
+ [output-id outputT] (&.with-type-env tc.var)
+ #let [funT (#.Function inputT outputT)]
funA (recur funT)
- _ (&;with-type-env
- (tc;check expectedT funT))]
+ _ (&.with-type-env
+ (tc.check expectedT funT))]
(wrap funA))
))
- (#;Function inputT outputT)
+ (#.Function inputT outputT)
(<| (:: @ map (function [[scope bodyA]]
- (` ("lux function" [(~@ (list/map code;int (variableL;environment scope)))]
+ (` ("lux function" [(~@ (list/map code.int (variableL.environment scope)))]
(~ bodyA)))))
- &;with-scope
+ &.with-scope
## Functions have access not only to their argument, but
## also to themselves, through a local variable.
- (&scope;with-local [func-name expectedT])
- (&scope;with-local [arg-name inputT])
- (&;with-type outputT)
+ (&scope.with-local [func-name expectedT])
+ (&scope.with-local [arg-name inputT])
+ (&.with-type outputT)
(analyse body))
_
- (&;fail "")
+ (&.fail "")
)))))
(def: #export (analyse-apply analyse funcT funcA args)
- (-> &;Analyser Type Analysis (List Code) (Meta Analysis))
- (&;with-stacked-errors
+ (-> &.Analyser Type Analysis (List Code) (Meta Analysis))
+ (&.with-stacked-errors
(function [_]
(Cannot-Apply-Function (format " Function: " (%type funcT) "\n"
"Arguments:" (|> args
- list;enumerate
+ list.enumerate
(list/map (function [[idx argC]]
(format "\n " (%n idx) " " (%code argC))))
- (text;join-with "")))))
- (do macro;Monad<Meta>
- [[applyT argsA] (&inference;general analyse funcT args)]
- (wrap (la;apply argsA funcA)))))
+ (text.join-with "")))))
+ (do macro.Monad<Meta>
+ [[applyT argsA] (&inference.general analyse funcT args)]
+ (wrap (la.apply argsA funcA)))))
diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux
index e89ab2e1e..881eee4a6 100644
--- a/new-luxc/source/luxc/lang/analysis/inference.lux
+++ b/new-luxc/source/luxc/lang/analysis/inference.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -11,7 +11,7 @@
(type ["tc" check])))
(luxc ["&" lang]
(lang ["la" analysis #+ Analysis]
- (analysis ["&;" common]))))
+ (analysis ["&." common]))))
(exception: #export Cannot-Infer)
(def: (cannot-infer type args)
@@ -19,10 +19,10 @@
(format " Type: " (%type type) "\n"
"Arguments:"
(|> args
- list;enumerate
+ list.enumerate
(list/map (function [[idx argC]]
(format "\n " (%n idx) " " (%code argC))))
- (text;join-with ""))))
+ (text.join-with ""))))
(exception: #export Cannot-Infer-Argument)
(exception: #export Smaller-Variant-Than-Expected)
@@ -33,29 +33,29 @@
(def: (replace-bound bound-idx replacementT type)
(-> Nat Type Type Type)
(case type
- (#;Primitive name params)
- (#;Primitive name (list/map (replace-bound bound-idx replacementT) params))
+ (#.Primitive name params)
+ (#.Primitive name (list/map (replace-bound bound-idx replacementT) params))
(^template [<tag>]
(<tag> left right)
(<tag> (replace-bound bound-idx replacementT left)
(replace-bound bound-idx replacementT right)))
- ([#;Sum]
- [#;Product]
- [#;Function]
- [#;Apply])
+ ([#.Sum]
+ [#.Product]
+ [#.Function]
+ [#.Apply])
- (#;Bound idx)
- (if (n.= bound-idx idx)
+ (#.Bound idx)
+ (if (n/= bound-idx idx)
replacementT
type)
(^template [<tag>]
(<tag> env quantified)
(<tag> (list/map (replace-bound bound-idx replacementT) env)
- (replace-bound (n.+ +2 bound-idx) replacementT quantified)))
- ([#;UnivQ]
- [#;ExQ])
+ (replace-bound (n/+ +2 bound-idx) replacementT quantified)))
+ ([#.UnivQ]
+ [#.ExQ])
_
type))
@@ -68,36 +68,36 @@
## But, so long as the type being used for the inference can be treated
## as a function type, this method of inference should work.
(def: #export (general analyse inferT args)
- (-> &;Analyser Type (List Code) (Meta [Type (List Analysis)]))
+ (-> &.Analyser Type (List Code) (Meta [Type (List Analysis)]))
(case args
- #;Nil
- (do macro;Monad<Meta>
- [_ (&;infer inferT)]
+ #.Nil
+ (do macro.Monad<Meta>
+ [_ (&.infer inferT)]
(wrap [inferT (list)]))
- (#;Cons argC args')
+ (#.Cons argC args')
(case inferT
- (#;Named name unnamedT)
+ (#.Named name unnamedT)
(general analyse unnamedT args)
- (#;UnivQ _)
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)]
- (general analyse (maybe;assume (type;apply (list varT) inferT)) args))
+ (#.UnivQ _)
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)]
+ (general analyse (maybe.assume (type.apply (list varT) inferT)) args))
- (#;ExQ _)
- (do macro;Monad<Meta>
- [[ex-id exT] (&;with-type-env
- tc;existential)]
- (general analyse (maybe;assume (type;apply (list exT) inferT)) args))
+ (#.ExQ _)
+ (do macro.Monad<Meta>
+ [[ex-id exT] (&.with-type-env
+ tc.existential)]
+ (general analyse (maybe.assume (type.apply (list exT) inferT)) args))
- (#;Apply inputT transT)
- (case (type;apply (list inputT) transT)
- (#;Some outputT)
+ (#.Apply inputT transT)
+ (case (type.apply (list inputT) transT)
+ (#.Some outputT)
(general analyse outputT args)
- #;None
- (&;throw Invalid-Type-Application (%type inferT)))
+ #.None
+ (&.throw Invalid-Type-Application (%type inferT)))
## Arguments are inferred back-to-front because, by convention,
## Lux functions take the most important arguments *last*, which
@@ -106,59 +106,59 @@
## By inferring back-to-front, a lot of type-annotations can be
## avoided in Lux code, since the inference algorithm can piece
## things together more easily.
- (#;Function inputT outputT)
- (do macro;Monad<Meta>
+ (#.Function inputT outputT)
+ (do macro.Monad<Meta>
[[outputT' args'A] (general analyse outputT args')
- argA (&;with-stacked-errors
+ argA (&.with-stacked-errors
(function [_] (Cannot-Infer-Argument
(format "Inferred Type: " (%type inputT) "\n"
" Argument: " (%code argC))))
- (&;with-type inputT
+ (&.with-type inputT
(analyse argC)))]
(wrap [outputT' (list& argA args'A)]))
- (#;Var infer-id)
- (do macro;Monad<Meta>
- [?inferT' (&;with-type-env (tc;read infer-id))]
+ (#.Var infer-id)
+ (do macro.Monad<Meta>
+ [?inferT' (&.with-type-env (tc.read infer-id))]
(case ?inferT'
- (#;Some inferT')
+ (#.Some inferT')
(general analyse inferT' args)
_
- (&;throw Cannot-Infer (cannot-infer inferT args))))
+ (&.throw Cannot-Infer (cannot-infer inferT args))))
_
- (&;throw Cannot-Infer (cannot-infer inferT args)))
+ (&.throw Cannot-Infer (cannot-infer inferT args)))
))
## Turns a record type into the kind of function type suitable for inference.
(def: #export (record inferT)
(-> Type (Meta Type))
(case inferT
- (#;Named name unnamedT)
+ (#.Named name unnamedT)
(record unnamedT)
(^template [<tag>]
(<tag> env bodyT)
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[bodyT+ (record bodyT)]
(wrap (<tag> env bodyT+))))
- ([#;UnivQ]
- [#;ExQ])
+ ([#.UnivQ]
+ [#.ExQ])
- (#;Apply inputT funcT)
- (case (type;apply (list inputT) funcT)
- (#;Some outputT)
+ (#.Apply inputT funcT)
+ (case (type.apply (list inputT) funcT)
+ (#.Some outputT)
(record outputT)
- #;None
- (&;throw Invalid-Type-Application (%type inferT)))
+ #.None
+ (&.throw Invalid-Type-Application (%type inferT)))
- (#;Product _)
- (macro/wrap (type;function (type;flatten-tuple inferT) inferT))
+ (#.Product _)
+ (macro/wrap (type.function (type.flatten-tuple inferT) inferT))
_
- (&;throw Not-A-Record-Type (%type inferT))))
+ (&.throw Not-A-Record-Type (%type inferT))))
## Turns a variant type into the kind of function type suitable for inference.
(def: #export (variant tag expected-size inferT)
@@ -166,60 +166,60 @@
(loop [depth +0
currentT inferT]
(case currentT
- (#;Named name unnamedT)
- (do macro;Monad<Meta>
+ (#.Named name unnamedT)
+ (do macro.Monad<Meta>
[unnamedT+ (recur depth unnamedT)]
(wrap unnamedT+))
(^template [<tag>]
(<tag> env bodyT)
- (do macro;Monad<Meta>
- [bodyT+ (recur (n.inc depth) bodyT)]
+ (do macro.Monad<Meta>
+ [bodyT+ (recur (n/inc depth) bodyT)]
(wrap (<tag> env bodyT+))))
- ([#;UnivQ]
- [#;ExQ])
-
- (#;Sum _)
- (let [cases (type;flatten-variant currentT)
- actual-size (list;size cases)
- boundary (n.dec expected-size)]
- (cond (or (n.= expected-size actual-size)
- (and (n.> expected-size actual-size)
- (n.< boundary tag)))
- (case (list;nth tag cases)
- (#;Some caseT)
- (macro/wrap (if (n.= +0 depth)
- (type;function (list caseT) currentT)
- (let [replace! (replace-bound (|> depth n.dec (n.* +2)) inferT)]
- (type;function (list (replace! caseT))
+ ([#.UnivQ]
+ [#.ExQ])
+
+ (#.Sum _)
+ (let [cases (type.flatten-variant currentT)
+ actual-size (list.size cases)
+ boundary (n/dec expected-size)]
+ (cond (or (n/= expected-size actual-size)
+ (and (n/> expected-size actual-size)
+ (n/< boundary tag)))
+ (case (list.nth tag cases)
+ (#.Some caseT)
+ (macro/wrap (if (n/= +0 depth)
+ (type.function (list caseT) currentT)
+ (let [replace! (replace-bound (|> depth n/dec (n/* +2)) inferT)]
+ (type.function (list (replace! caseT))
(replace! currentT)))))
- #;None
- (&common;variant-out-of-bounds-error inferT expected-size tag))
+ #.None
+ (&common.variant-out-of-bounds-error inferT expected-size tag))
- (n.< expected-size actual-size)
- (&;throw Smaller-Variant-Than-Expected
+ (n/< expected-size actual-size)
+ (&.throw Smaller-Variant-Than-Expected
(format "Expected: " (%i (nat-to-int expected-size)) "\n"
" Actual: " (%i (nat-to-int actual-size))))
- (n.= boundary tag)
- (let [caseT (type;variant (list;drop boundary cases))]
- (macro/wrap (if (n.= +0 depth)
- (type;function (list caseT) currentT)
- (let [replace! (replace-bound (|> depth n.dec (n.* +2)) inferT)]
- (type;function (list (replace! caseT))
+ (n/= boundary tag)
+ (let [caseT (type.variant (list.drop boundary cases))]
+ (macro/wrap (if (n/= +0 depth)
+ (type.function (list caseT) currentT)
+ (let [replace! (replace-bound (|> depth n/dec (n/* +2)) inferT)]
+ (type.function (list (replace! caseT))
(replace! currentT))))))
## else
- (&common;variant-out-of-bounds-error inferT expected-size tag)))
+ (&common.variant-out-of-bounds-error inferT expected-size tag)))
- (#;Apply inputT funcT)
- (case (type;apply (list inputT) funcT)
- (#;Some outputT)
+ (#.Apply inputT funcT)
+ (case (type.apply (list inputT) funcT)
+ (#.Some outputT)
(variant tag expected-size outputT)
- #;None
- (&;throw Invalid-Type-Application (%type inferT)))
+ #.None
+ (&.throw Invalid-Type-Application (%type inferT)))
_
- (&;throw Not-A-Variant-Type (%type inferT)))))
+ (&.throw Not-A-Variant-Type (%type inferT)))))
diff --git a/new-luxc/source/luxc/lang/analysis/primitive.lux b/new-luxc/source/luxc/lang/analysis/primitive.lux
index 9124ca271..8270e7e73 100644
--- a/new-luxc/source/luxc/lang/analysis/primitive.lux
+++ b/new-luxc/source/luxc/lang/analysis/primitive.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad)
[macro]
@@ -11,20 +11,20 @@
(do-template [<name> <type> <tag>]
[(def: #export (<name> value)
(-> <type> (Meta Analysis))
- (do macro;Monad<Meta>
- [_ (&;infer <type>)]
+ (do macro.Monad<Meta>
+ [_ (&.infer <type>)]
(wrap (<tag> value))))]
- [analyse-bool Bool code;bool]
- [analyse-nat Nat code;nat]
- [analyse-int Int code;int]
- [analyse-deg Deg code;deg]
- [analyse-frac Frac code;frac]
- [analyse-text Text code;text]
+ [analyse-bool Bool code.bool]
+ [analyse-nat Nat code.nat]
+ [analyse-int Int code.int]
+ [analyse-deg Deg code.deg]
+ [analyse-frac Frac code.frac]
+ [analyse-text Text code.text]
)
(def: #export analyse-unit
(Meta Analysis)
- (do macro;Monad<Meta>
- [_ (&;infer Unit)]
+ (do macro.Monad<Meta>
+ [_ (&.infer Unit)]
(wrap (` []))))
diff --git a/new-luxc/source/luxc/lang/analysis/procedure.lux b/new-luxc/source/luxc/lang/analysis/procedure.lux
index 4e9843ddd..25e1be335 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -8,19 +8,19 @@
(coll [dict])))
(luxc ["&" lang]
(lang ["la" analysis]))
- (/ ["/;" common]
- ["/;" host]))
+ (/ ["/." common]
+ ["/." host]))
(exception: #export Unknown-Procedure)
(def: procedures
- /common;Bundle
- (|> /common;procedures
- (dict;merge /host;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)]
+ (-> &.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/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
index f5afca5bf..b003edfa7 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -14,16 +14,16 @@
[io])
(luxc ["&" lang]
(lang ["la" analysis]
- (analysis ["&;" common]
- [";A" function]
- [";A" case]
- [";A" type]))))
+ (analysis ["&." common]
+ [".A" function]
+ [".A" case]
+ [".A" type]))))
(exception: #export Incorrect-Procedure-Arity)
## [Utils]
(type: #export Proc
- (-> &;Analyser &;Eval (List Code) (Meta la;Analysis)))
+ (-> &.Analyser &.Eval (List Code) (Meta la.Analysis)))
(type: #export Bundle
(Dict Text (-> Text Proc)))
@@ -31,14 +31,14 @@
(def: #export (install name unnamed)
(-> Text (-> Text Proc)
(-> Bundle Bundle))
- (dict;put name unnamed))
+ (dict.put name unnamed))
(def: #export (prefix prefix bundle)
(-> Text Bundle Bundle)
(|> bundle
- dict;entries
+ dict.entries
(list/map (function [[key val]] [(format prefix " " key) val]))
- (dict;from-list text;Hash<Text>)))
+ (dict.from-list text.Hash<Text>)))
(def: #export (wrong-arity proc expected actual)
(-> Text Nat Nat Text)
@@ -48,19 +48,19 @@
(def: (simple proc inputsT+ outputT)
(-> Text (List Type) Type Proc)
- (let [num-expected (list;size inputsT+)]
+ (let [num-expected (list.size inputsT+)]
(function [analyse eval args]
- (let [num-actual (list;size args)]
- (if (n.= num-expected num-actual)
- (do macro;Monad<Meta>
- [_ (&;infer outputT)
- argsA (monad;map @
+ (let [num-actual (list.size args)]
+ (if (n/= num-expected num-actual)
+ (do macro.Monad<Meta>
+ [_ (&.infer outputT)
+ argsA (monad.map @
(function [[argT argC]]
- (&;with-type argT
+ (&.with-type argT
(analyse argC)))
- (list;zip2 inputsT+ args))]
- (wrap (la;procedure proc argsA)))
- (&;throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual)))))))
+ (list.zip2 inputsT+ args))]
+ (wrap (la.procedure proc argsA)))
+ (&.throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual)))))))
(def: #export (nullary valueT proc)
(-> Type Text Proc)
@@ -83,8 +83,8 @@
(def: (lux-is proc)
(-> Text Proc)
(function [analyse eval args]
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)]
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)]
((binary varT varT Bool proc)
analyse eval args))))
@@ -95,37 +95,37 @@
(function [analyse eval args]
(case args
(^ (list opC))
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)
- _ (&;infer (type (Either Text varT)))
- opA (&;with-type (type (io;IO varT))
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)
+ _ (&.infer (type (Either Text varT)))
+ opA (&.with-type (type (io.IO varT))
(analyse opC))]
- (wrap (la;procedure proc (list opA))))
+ (wrap (la.procedure proc (list opA))))
_
- (&;throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list;size args))))))
+ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
(def: (lux//function proc)
(-> Text Proc)
(function [analyse eval args]
(case args
- (^ (list [_ (#;Symbol ["" func-name])]
- [_ (#;Symbol ["" arg-name])]
+ (^ (list [_ (#.Symbol ["" func-name])]
+ [_ (#.Symbol ["" arg-name])]
body))
- (functionA;analyse-function analyse func-name arg-name body)
+ (functionA.analyse-function analyse func-name arg-name body)
_
- (&;throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list;size args))))))
+ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list.size args))))))
(def: (lux//case proc)
(-> Text Proc)
(function [analyse eval args]
(case args
- (^ (list input [_ (#;Record branches)]))
- (caseA;analyse-case analyse input branches)
+ (^ (list input [_ (#.Record branches)]))
+ (caseA.analyse-case analyse input branches)
_
- (&;throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list;size args))))))
+ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))
(do-template [<name> <analyser>]
[(def: (<name> proc)
@@ -136,28 +136,28 @@
(<analyser> analyse eval typeC valueC)
_
- (&;throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list;size args))))))]
+ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))]
- [lux//check typeA;analyse-check]
- [lux//coerce typeA;analyse-coerce])
+ [lux//check typeA.analyse-check]
+ [lux//coerce typeA.analyse-coerce])
(def: (lux//check//type proc)
(-> Text Proc)
(function [analyse eval args]
(case args
(^ (list valueC))
- (do macro;Monad<Meta>
- [_ (&;infer (type Type))
- valueA (&;with-type Type
+ (do macro.Monad<Meta>
+ [_ (&.infer (type Type))
+ valueA (&.with-type Type
(analyse valueC))]
(wrap valueA))
_
- (&;throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list;size args))))))
+ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
(def: lux-procs
Bundle
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "is" lux-is)
(install "try" lux-try)
(install "function" lux//function)
@@ -169,7 +169,7 @@
(def: io-procs
Bundle
(<| (prefix "io")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "log" (unary Text Unit))
(install "error" (unary Text Bottom))
(install "exit" (unary Int Bottom))
@@ -178,7 +178,7 @@
(def: bit-procs
Bundle
(<| (prefix "bit")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "count" (unary Nat Nat))
(install "and" (binary Nat Nat Nat))
(install "or" (binary Nat Nat Nat))
@@ -191,7 +191,7 @@
(def: nat-procs
Bundle
(<| (prefix "nat")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary Nat Nat Nat))
(install "-" (binary Nat Nat Nat))
(install "*" (binary Nat Nat Nat))
@@ -207,7 +207,7 @@
(def: int-procs
Bundle
(<| (prefix "int")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary Int Int Int))
(install "-" (binary Int Int Int))
(install "*" (binary Int Int Int))
@@ -223,7 +223,7 @@
(def: deg-procs
Bundle
(<| (prefix "deg")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary Deg Deg Deg))
(install "-" (binary Deg Deg Deg))
(install "*" (binary Deg Deg Deg))
@@ -240,7 +240,7 @@
(def: frac-procs
Bundle
(<| (prefix "frac")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary Frac Frac Frac))
(install "-" (binary Frac Frac Frac))
(install "*" (binary Frac Frac Frac))
@@ -262,7 +262,7 @@
(def: text-procs
Bundle
(<| (prefix "text")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "=" (binary Text Text Bool))
(install "<" (binary Text Text Bool))
(install "concat" (binary Text Text Text))
@@ -280,31 +280,31 @@
(def: (array//get proc)
(-> Text Proc)
(function [analyse eval args]
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)]
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)]
((binary (type (Array varT)) Nat (type (Maybe varT)) proc)
analyse eval args))))
(def: (array//put proc)
(-> Text Proc)
(function [analyse eval args]
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)]
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)]
((trinary (type (Array varT)) Nat varT (type (Array varT)) proc)
analyse eval args))))
(def: (array//remove proc)
(-> Text Proc)
(function [analyse eval args]
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)]
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)]
((binary (type (Array varT)) Nat (type (Array varT)) proc)
analyse eval args))))
(def: array-procs
Bundle
(<| (prefix "array")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "new" (unary Nat Array))
(install "get" array//get)
(install "put" array//put)
@@ -315,7 +315,7 @@
(def: math-procs
Bundle
(<| (prefix "math")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "cos" (unary Frac Frac))
(install "sin" (unary Frac Frac))
(install "tan" (unary Frac Frac))
@@ -341,36 +341,36 @@
(function [analyse eval args]
(case args
(^ (list initC))
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)
- _ (&;infer (type (Atom varT)))
- initA (&;with-type varT
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)
+ _ (&.infer (type (Atom varT)))
+ initA (&.with-type varT
(analyse initC))]
- (wrap (la;procedure proc (list initA))))
+ (wrap (la.procedure proc (list initA))))
_
- (&;throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list;size args))))))
+ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
(def: (atom-read proc)
(-> Text Proc)
(function [analyse eval args]
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)]
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)]
((unary (type (Atom varT)) varT proc)
analyse eval args))))
(def: (atom//compare-and-swap proc)
(-> Text Proc)
(function [analyse eval args]
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)]
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)]
((trinary (type (Atom varT)) varT varT Bool proc)
analyse eval args))))
(def: atom-procs
Bundle
(<| (prefix "atom")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "new" atom-new)
(install "read" atom-read)
(install "compare-and-swap" atom//compare-and-swap)
@@ -379,25 +379,25 @@
(def: process-procs
Bundle
(<| (prefix "process")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "concurrency-level" (nullary Nat))
- (install "future" (unary (type (io;IO Top)) Unit))
- (install "schedule" (binary Nat (type (io;IO Top)) Unit))
+ (install "future" (unary (type (io.IO Top)) Unit))
+ (install "schedule" (binary Nat (type (io.IO Top)) Unit))
)))
(def: #export procedures
Bundle
(<| (prefix "lux")
- (|> (dict;new text;Hash<Text>)
- (dict;merge lux-procs)
- (dict;merge bit-procs)
- (dict;merge nat-procs)
- (dict;merge int-procs)
- (dict;merge deg-procs)
- (dict;merge frac-procs)
- (dict;merge text-procs)
- (dict;merge array-procs)
- (dict;merge math-procs)
- (dict;merge atom-procs)
- (dict;merge process-procs)
- (dict;merge io-procs))))
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge lux-procs)
+ (dict.merge bit-procs)
+ (dict.merge nat-procs)
+ (dict.merge int-procs)
+ (dict.merge deg-procs)
+ (dict.merge frac-procs)
+ (dict.merge text-procs)
+ (dict.merge array-procs)
+ (dict.merge math-procs)
+ (dict.merge atom-procs)
+ (dict.merge process-procs)
+ (dict.merge io-procs))))
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
index bb388434f..3c29410d0 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
[lux #- char]
(lux (control [monad #+ do]
["p" parser]
@@ -21,10 +21,10 @@
(type ["tc" check]))
[host])
(luxc ["&" lang]
- (lang ["&;" host]
+ (lang ["&." host]
["la" analysis]
- (analysis ["&;" common]
- [";A" inference])))
+ (analysis ["&." common]
+ [".A" inference])))
["@" //common]
)
@@ -32,7 +32,7 @@
(def: (wrong-syntax procedure args)
(-> Text (List Code) Text)
(format "Procedure: " procedure "\n"
- "Arguments: " (%code (code;tuple args))))
+ "Arguments: " (%code (code.tuple args))))
(exception: #export JVM-Type-Is-Not-Class)
@@ -74,7 +74,7 @@
(def: #export null-class Text "#Null")
(do-template [<name> <class>]
- [(def: #export <name> Type (#;Primitive <class> (list)))]
+ [(def: #export <name> Type (#.Primitive <class> (list)))]
## Boxes
[Boolean "java.lang.Boolean"]
@@ -99,52 +99,52 @@
)
(def: conversion-procs
- @;Bundle
- (<| (@;prefix "convert")
- (|> (dict;new text;Hash<Text>)
- (@;install "double-to-float" (@;unary Double Float))
- (@;install "double-to-int" (@;unary Double Integer))
- (@;install "double-to-long" (@;unary Double Long))
- (@;install "float-to-double" (@;unary Float Double))
- (@;install "float-to-int" (@;unary Float Integer))
- (@;install "float-to-long" (@;unary Float Long))
- (@;install "int-to-byte" (@;unary Integer Byte))
- (@;install "int-to-char" (@;unary Integer Character))
- (@;install "int-to-double" (@;unary Integer Double))
- (@;install "int-to-float" (@;unary Integer Float))
- (@;install "int-to-long" (@;unary Integer Long))
- (@;install "int-to-short" (@;unary Integer Short))
- (@;install "long-to-double" (@;unary Long Double))
- (@;install "long-to-float" (@;unary Long Float))
- (@;install "long-to-int" (@;unary Long Integer))
- (@;install "long-to-short" (@;unary Long Short))
- (@;install "long-to-byte" (@;unary Long Byte))
- (@;install "char-to-byte" (@;unary Character Byte))
- (@;install "char-to-short" (@;unary Character Short))
- (@;install "char-to-int" (@;unary Character Integer))
- (@;install "char-to-long" (@;unary Character Long))
- (@;install "byte-to-long" (@;unary Byte Long))
- (@;install "short-to-long" (@;unary Short Long))
+ @.Bundle
+ (<| (@.prefix "convert")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "double-to-float" (@.unary Double Float))
+ (@.install "double-to-int" (@.unary Double Integer))
+ (@.install "double-to-long" (@.unary Double Long))
+ (@.install "float-to-double" (@.unary Float Double))
+ (@.install "float-to-int" (@.unary Float Integer))
+ (@.install "float-to-long" (@.unary Float Long))
+ (@.install "int-to-byte" (@.unary Integer Byte))
+ (@.install "int-to-char" (@.unary Integer Character))
+ (@.install "int-to-double" (@.unary Integer Double))
+ (@.install "int-to-float" (@.unary Integer Float))
+ (@.install "int-to-long" (@.unary Integer Long))
+ (@.install "int-to-short" (@.unary Integer Short))
+ (@.install "long-to-double" (@.unary Long Double))
+ (@.install "long-to-float" (@.unary Long Float))
+ (@.install "long-to-int" (@.unary Long Integer))
+ (@.install "long-to-short" (@.unary Long Short))
+ (@.install "long-to-byte" (@.unary Long Byte))
+ (@.install "char-to-byte" (@.unary Character Byte))
+ (@.install "char-to-short" (@.unary Character Short))
+ (@.install "char-to-int" (@.unary Character Integer))
+ (@.install "char-to-long" (@.unary Character Long))
+ (@.install "byte-to-long" (@.unary Byte Long))
+ (@.install "short-to-long" (@.unary Short Long))
)))
(do-template [<name> <prefix> <type>]
[(def: <name>
- @;Bundle
- (<| (@;prefix <prefix>)
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary <type> <type> <type>))
- (@;install "-" (@;binary <type> <type> <type>))
- (@;install "*" (@;binary <type> <type> <type>))
- (@;install "/" (@;binary <type> <type> <type>))
- (@;install "%" (@;binary <type> <type> <type>))
- (@;install "=" (@;binary <type> <type> Boolean))
- (@;install "<" (@;binary <type> <type> Boolean))
- (@;install "and" (@;binary <type> <type> <type>))
- (@;install "or" (@;binary <type> <type> <type>))
- (@;install "xor" (@;binary <type> <type> <type>))
- (@;install "shl" (@;binary <type> Integer <type>))
- (@;install "shr" (@;binary <type> Integer <type>))
- (@;install "ushr" (@;binary <type> Integer <type>))
+ @.Bundle
+ (<| (@.prefix <prefix>)
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary <type> <type> <type>))
+ (@.install "-" (@.binary <type> <type> <type>))
+ (@.install "*" (@.binary <type> <type> <type>))
+ (@.install "/" (@.binary <type> <type> <type>))
+ (@.install "%" (@.binary <type> <type> <type>))
+ (@.install "=" (@.binary <type> <type> Boolean))
+ (@.install "<" (@.binary <type> <type> Boolean))
+ (@.install "and" (@.binary <type> <type> <type>))
+ (@.install "or" (@.binary <type> <type> <type>))
+ (@.install "xor" (@.binary <type> <type> <type>))
+ (@.install "shl" (@.binary <type> Integer <type>))
+ (@.install "shr" (@.binary <type> Integer <type>))
+ (@.install "ushr" (@.binary <type> Integer <type>))
)))]
[int-procs "int" Integer]
@@ -153,16 +153,16 @@
(do-template [<name> <prefix> <type>]
[(def: <name>
- @;Bundle
- (<| (@;prefix <prefix>)
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary <type> <type> <type>))
- (@;install "-" (@;binary <type> <type> <type>))
- (@;install "*" (@;binary <type> <type> <type>))
- (@;install "/" (@;binary <type> <type> <type>))
- (@;install "%" (@;binary <type> <type> <type>))
- (@;install "=" (@;binary <type> <type> Boolean))
- (@;install "<" (@;binary <type> <type> Boolean))
+ @.Bundle
+ (<| (@.prefix <prefix>)
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary <type> <type> <type>))
+ (@.install "-" (@.binary <type> <type> <type>))
+ (@.install "*" (@.binary <type> <type> <type>))
+ (@.install "/" (@.binary <type> <type> <type>))
+ (@.install "%" (@.binary <type> <type> <type>))
+ (@.install "=" (@.binary <type> <type> Boolean))
+ (@.install "<" (@.binary <type> <type> Boolean))
)))]
[float-procs "float" Float]
@@ -170,11 +170,11 @@
)
(def: char-procs
- @;Bundle
- (<| (@;prefix "char")
- (|> (dict;new text;Hash<Text>)
- (@;install "=" (@;binary Character Character Boolean))
- (@;install "<" (@;binary Character Character Boolean))
+ @.Bundle
+ (<| (@.prefix "char")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "=" (@.binary Character Character Boolean))
+ (@.install "<" (@.binary Character Character Boolean))
)))
(def: #export boxes
@@ -187,439 +187,439 @@
["float" "java.lang.Float"]
["double" "java.lang.Double"]
["char" "java.lang.Character"])
- (dict;from-list text;Hash<Text>)))
+ (dict.from-list text.Hash<Text>)))
(def: (array-length proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list arrayC))
- (do macro;Monad<Meta>
- [_ (&;infer Nat)
- [var-id varT] (&;with-type-env tc;var)
- arrayA (&;with-type (type (Array varT))
+ (do macro.Monad<Meta>
+ [_ (&.infer Nat)
+ [var-id varT] (&.with-type-env tc.var)
+ arrayA (&.with-type (type (Array varT))
(analyse arrayC))]
- (wrap (la;procedure proc (list arrayA))))
+ (wrap (la.procedure proc (list arrayA))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +1 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
(def: (array-new proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list lengthC))
- (do macro;Monad<Meta>
- [lengthA (&;with-type Nat
+ (do macro.Monad<Meta>
+ [lengthA (&.with-type Nat
(analyse lengthC))
- expectedT macro;expected-type
+ expectedT macro.expected-type
[level elem-class] (: (Meta [Nat Text])
(loop [analysisT expectedT
level +0]
(case analysisT
- (#;Apply inputT funcT)
- (case (type;apply (list inputT) funcT)
- (#;Some outputT)
+ (#.Apply inputT funcT)
+ (case (type.apply (list inputT) funcT)
+ (#.Some outputT)
(recur outputT level)
- #;None
- (&;throw Non-Array (%type expectedT)))
+ #.None
+ (&.throw Non-Array (%type expectedT)))
- (^ (#;Primitive "#Array" (list elemT)))
- (recur elemT (n.inc level))
+ (^ (#.Primitive "#Array" (list elemT)))
+ (recur elemT (n/inc level))
- (#;Primitive class _)
+ (#.Primitive class _)
(wrap [level class])
_
- (&;throw Non-Array (%type expectedT)))))
- _ (if (n.> +0 level)
+ (&.throw Non-Array (%type expectedT)))))
+ _ (if (n/> +0 level)
(wrap [])
- (&;throw Non-Array (%type expectedT)))]
- (wrap (la;procedure proc (list (code;nat (n.dec level)) (code;text elem-class) lengthA))))
+ (&.throw Non-Array (%type expectedT)))]
+ (wrap (la.procedure proc (list (code.nat (n/dec level)) (code.text elem-class) lengthA))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +1 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
(def: (check-jvm objectT)
(-> Type (Meta Text))
(case objectT
- (#;Primitive name _)
+ (#.Primitive name _)
(macro/wrap name)
- (#;Named name unnamed)
+ (#.Named name unnamed)
(check-jvm unnamed)
- (#;Var id)
+ (#.Var id)
(macro/wrap "java.lang.Object")
(^template [<tag>]
(<tag> env unquantified)
(check-jvm unquantified))
- ([#;UnivQ]
- [#;ExQ])
+ ([#.UnivQ]
+ [#.ExQ])
- (#;Apply inputT funcT)
- (case (type;apply (list inputT) funcT)
- (#;Some outputT)
+ (#.Apply inputT funcT)
+ (case (type.apply (list inputT) funcT)
+ (#.Some outputT)
(check-jvm outputT)
- #;None
- (&;throw Non-Object (%type objectT)))
+ #.None
+ (&.throw Non-Object (%type objectT)))
_
- (&;throw Non-Object (%type objectT))))
+ (&.throw Non-Object (%type objectT))))
(def: (check-object objectT)
(-> Type (Meta Text))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[name (check-jvm objectT)]
- (if (dict;contains? name boxes)
- (&;throw Primitives-Are-Not-Objects name)
+ (if (dict.contains? name boxes)
+ (&.throw Primitives-Are-Not-Objects name)
(macro/wrap name))))
(def: (box-array-element-type elemT)
(-> Type (Meta [Type Text]))
(case elemT
- (#;Primitive name #;Nil)
- (let [boxed-name (|> (dict;get name boxes)
- (maybe;default name))]
- (macro/wrap [(#;Primitive boxed-name #;Nil)
+ (#.Primitive name #.Nil)
+ (let [boxed-name (|> (dict.get name boxes)
+ (maybe.default name))]
+ (macro/wrap [(#.Primitive boxed-name #.Nil)
boxed-name]))
- (#;Primitive name _)
- (if (dict;contains? name boxes)
- (&;throw Primitives-Cannot-Have-Type-Parameters name)
+ (#.Primitive name _)
+ (if (dict.contains? name boxes)
+ (&.throw Primitives-Cannot-Have-Type-Parameters name)
(macro/wrap [elemT name]))
_
- (&;throw Invalid-Type-For-Array-Element (%type elemT))))
+ (&.throw Invalid-Type-For-Array-Element (%type elemT))))
(def: (array-read proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list arrayC idxC))
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)
- _ (&;infer varT)
- arrayA (&;with-type (type (Array varT))
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)
+ _ (&.infer varT)
+ arrayA (&.with-type (type (Array varT))
(analyse arrayC))
- ?elemT (&;with-type-env
- (tc;read var-id))
- [elemT elem-class] (box-array-element-type (maybe;default varT ?elemT))
- idxA (&;with-type Nat
+ ?elemT (&.with-type-env
+ (tc.read var-id))
+ [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+ idxA (&.with-type Nat
(analyse idxC))]
- (wrap (la;procedure proc (list (code;text elem-class) idxA arrayA))))
+ (wrap (la.procedure proc (list (code.text elem-class) idxA arrayA))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +2 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
(def: (array-write proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list arrayC idxC valueC))
- (do macro;Monad<Meta>
- [[var-id varT] (&;with-type-env tc;var)
- _ (&;infer (type (Array varT)))
- arrayA (&;with-type (type (Array varT))
+ (do macro.Monad<Meta>
+ [[var-id varT] (&.with-type-env tc.var)
+ _ (&.infer (type (Array varT)))
+ arrayA (&.with-type (type (Array varT))
(analyse arrayC))
- ?elemT (&;with-type-env
- (tc;read var-id))
- [valueT elem-class] (box-array-element-type (maybe;default varT ?elemT))
- idxA (&;with-type Nat
+ ?elemT (&.with-type-env
+ (tc.read var-id))
+ [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+ idxA (&.with-type Nat
(analyse idxC))
- valueA (&;with-type valueT
+ valueA (&.with-type valueT
(analyse valueC))]
- (wrap (la;procedure proc (list (code;text elem-class) idxA valueA arrayA))))
+ (wrap (la.procedure proc (list (code.text elem-class) idxA valueA arrayA))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +3 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
(def: array-procs
- @;Bundle
- (<| (@;prefix "array")
- (|> (dict;new text;Hash<Text>)
- (@;install "length" array-length)
- (@;install "new" array-new)
- (@;install "read" array-read)
- (@;install "write" array-write)
+ @.Bundle
+ (<| (@.prefix "array")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "length" array-length)
+ (@.install "new" array-new)
+ (@.install "read" array-read)
+ (@.install "write" array-write)
)))
(def: (object-null proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list))
- (do macro;Monad<Meta>
- [expectedT macro;expected-type
+ (do macro.Monad<Meta>
+ [expectedT macro.expected-type
_ (check-object expectedT)]
- (wrap (la;procedure proc (list))))
+ (wrap (la.procedure proc (list))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +0 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +0 (list.size args))))))
(def: (object-null? proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list objectC))
- (do macro;Monad<Meta>
- [_ (&;infer Bool)
- [objectT objectA] (&common;with-unknown-type
+ (do macro.Monad<Meta>
+ [_ (&.infer Bool)
+ [objectT objectA] (&common.with-unknown-type
(analyse objectC))
_ (check-object objectT)]
- (wrap (la;procedure proc (list objectA))))
+ (wrap (la.procedure proc (list objectA))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +1 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
(def: (object-synchronized proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list monitorC exprC))
- (do macro;Monad<Meta>
- [[monitorT monitorA] (&common;with-unknown-type
+ (do macro.Monad<Meta>
+ [[monitorT monitorA] (&common.with-unknown-type
(analyse monitorC))
_ (check-object monitorT)
exprA (analyse exprC)]
- (wrap (la;procedure proc (list monitorA exprA))))
+ (wrap (la.procedure proc (list monitorA exprA))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +2 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
-(host;import java.lang.Object
+(host.import java/lang/Object
(equals [Object] boolean))
-(host;import java.lang.ClassLoader)
+(host.import java/lang/ClassLoader)
-(host;import #long java.lang.reflect.Type
+(host.import #long java/lang/reflect/Type
(getTypeName [] String))
-(host;import java.lang.reflect.GenericArrayType
- (getGenericComponentType [] java.lang.reflect.Type))
+(host.import java/lang/reflect/GenericArrayType
+ (getGenericComponentType [] java/lang/reflect/Type))
-(host;import java.lang.reflect.ParameterizedType
- (getRawType [] java.lang.reflect.Type)
- (getActualTypeArguments [] (Array java.lang.reflect.Type)))
+(host.import java/lang/reflect/ParameterizedType
+ (getRawType [] java/lang/reflect/Type)
+ (getActualTypeArguments [] (Array java/lang/reflect/Type)))
-(host;import (java.lang.reflect.TypeVariable d)
+(host.import (java/lang/reflect/TypeVariable d)
(getName [] String)
- (getBounds [] (Array java.lang.reflect.Type)))
+ (getBounds [] (Array java/lang/reflect/Type)))
-(host;import (java.lang.reflect.WildcardType d)
- (getLowerBounds [] (Array java.lang.reflect.Type))
- (getUpperBounds [] (Array java.lang.reflect.Type)))
+(host.import (java/lang/reflect/WildcardType d)
+ (getLowerBounds [] (Array java/lang/reflect/Type))
+ (getUpperBounds [] (Array java/lang/reflect/Type)))
-(host;import java.lang.reflect.Modifier
+(host.import java/lang/reflect/Modifier
(#static isStatic [int] boolean)
(#static isFinal [int] boolean)
(#static isInterface [int] boolean)
(#static isAbstract [int] boolean))
-(host;import java.lang.reflect.Field
- (getDeclaringClass [] (java.lang.Class Object))
+(host.import java/lang/reflect/Field
+ (getDeclaringClass [] (java/lang/Class Object))
(getModifiers [] int)
- (getGenericType [] java.lang.reflect.Type))
+ (getGenericType [] java/lang/reflect/Type))
-(host;import java.lang.reflect.Method
+(host.import java/lang/reflect/Method
(getName [] String)
(getModifiers [] int)
(getDeclaringClass [] (Class Object))
(getTypeParameters [] (Array (TypeVariable Method)))
- (getGenericParameterTypes [] (Array java.lang.reflect.Type))
- (getGenericReturnType [] java.lang.reflect.Type)
- (getGenericExceptionTypes [] (Array java.lang.reflect.Type)))
+ (getGenericParameterTypes [] (Array java/lang/reflect/Type))
+ (getGenericReturnType [] java/lang/reflect/Type)
+ (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-(host;import (java.lang.reflect.Constructor c)
+(host.import (java/lang/reflect/Constructor c)
(getModifiers [] int)
(getDeclaringClass [] (Class c))
(getTypeParameters [] (Array (TypeVariable (Constructor c))))
- (getGenericParameterTypes [] (Array java.lang.reflect.Type))
- (getGenericExceptionTypes [] (Array java.lang.reflect.Type)))
+ (getGenericParameterTypes [] (Array java/lang/reflect/Type))
+ (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-(host;import (java.lang.Class c)
+(host.import (java/lang/Class c)
(getName [] String)
(getModifiers [] int)
(#static forName [String boolean ClassLoader] #try (Class Object))
(isAssignableFrom [(Class Object)] boolean)
(getTypeParameters [] (Array (TypeVariable (Class c))))
- (getGenericInterfaces [] (Array java.lang.reflect.Type))
- (getGenericSuperclass [] java.lang.reflect.Type)
+ (getGenericInterfaces [] (Array java/lang/reflect/Type))
+ (getGenericSuperclass [] java/lang/reflect/Type)
(getDeclaredField [String] #try Field)
(getConstructors [] (Array (Constructor Object)))
(getDeclaredMethods [] (Array Method)))
(def: (load-class name)
(-> Text (Meta (Class Object)))
- (do macro;Monad<Meta>
- [class-loader &host;class-loader]
- (case (Class.forName [name false class-loader])
- (#e;Success [class])
+ (do macro.Monad<Meta>
+ [class-loader &host.class-loader]
+ (case (Class::forName [name false class-loader])
+ (#e.Success [class])
(wrap class)
- (#e;Error error)
- (&;throw Unknown-Class name))))
+ (#e.Error error)
+ (&.throw Unknown-Class name))))
(def: (sub-class? super sub)
(-> Text Text (Meta Bool))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[super (load-class super)
sub (load-class sub)]
- (wrap (Class.isAssignableFrom [sub] super))))
+ (wrap (Class::isAssignableFrom [sub] super))))
(def: (object-throw proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list exceptionC))
- (do macro;Monad<Meta>
- [_ (&;infer Bottom)
- [exceptionT exceptionA] (&common;with-unknown-type
+ (do macro.Monad<Meta>
+ [_ (&.infer Bottom)
+ [exceptionT exceptionA] (&common.with-unknown-type
(analyse exceptionC))
exception-class (check-object exceptionT)
? (sub-class? "java.lang.Throwable" exception-class)
_ (: (Meta Unit)
(if ?
(wrap [])
- (&;throw Non-Throwable exception-class)))]
- (wrap (la;procedure proc (list exceptionA))))
+ (&.throw Non-Throwable exception-class)))]
+ (wrap (la.procedure proc (list exceptionA))))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +1 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
(def: (object-class proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list classC))
(case classC
- [_ (#;Text class)]
- (do macro;Monad<Meta>
- [_ (&;infer (#;Primitive "java.lang.Class" (list (#;Primitive class (list)))))
+ [_ (#.Text class)]
+ (do macro.Monad<Meta>
+ [_ (&.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
_ (load-class class)]
- (wrap (la;procedure proc (list (code;text class)))))
+ (wrap (la.procedure proc (list (code.text class)))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +1 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
(def: (object-instance? proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list classC objectC))
(case classC
- [_ (#;Text class)]
- (do macro;Monad<Meta>
- [_ (&;infer Bool)
- [objectT objectA] (&common;with-unknown-type
+ [_ (#.Text class)]
+ (do macro.Monad<Meta>
+ [_ (&.infer Bool)
+ [objectT objectA] (&common.with-unknown-type
(analyse objectC))
object-class (check-object objectT)
? (sub-class? class object-class)]
(if ?
- (wrap (la;procedure proc (list (code;text class))))
- (&;throw Cannot-Possibly-Be-Instance (format object-class " !<= " class))))
+ (wrap (la.procedure proc (list (code.text class))))
+ (&.throw Cannot-Possibly-Be-Instance (format object-class " !<= " class))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +2 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
(def: object-procs
- @;Bundle
- (<| (@;prefix "object")
- (|> (dict;new text;Hash<Text>)
- (@;install "null" object-null)
- (@;install "null?" object-null?)
- (@;install "synchronized" object-synchronized)
- (@;install "throw" object-throw)
- (@;install "class" object-class)
- (@;install "instance?" object-instance?)
+ @.Bundle
+ (<| (@.prefix "object")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "null" object-null)
+ (@.install "null?" object-null?)
+ (@.install "synchronized" object-synchronized)
+ (@.install "throw" object-throw)
+ (@.install "class" object-class)
+ (@.install "instance?" object-instance?)
)))
(def: type-descriptor
- (-> java.lang.reflect.Type Text)
- (java.lang.reflect.Type.getTypeName []))
+ (-> java/lang/reflect/Type Text)
+ (java/lang/reflect/Type::getTypeName []))
(def: (java-type-to-class type)
- (-> java.lang.reflect.Type (Meta Text))
- (cond (host;instance? Class type)
- (macro/wrap (Class.getName [] (:! Class type)))
+ (-> java/lang/reflect/Type (Meta Text))
+ (cond (host.instance? Class type)
+ (macro/wrap (Class::getName [] (:! Class type)))
- (host;instance? ParameterizedType type)
- (java-type-to-class (ParameterizedType.getRawType [] (:! ParameterizedType type)))
+ (host.instance? ParameterizedType type)
+ (java-type-to-class (ParameterizedType::getRawType [] (:! ParameterizedType type)))
## else
- (&;throw Cannot-Convert-To-Class (type-descriptor type))))
+ (&.throw Cannot-Convert-To-Class (type-descriptor type))))
(type: Mappings
(Dict Text Type))
-(def: fresh-mappings Mappings (dict;new text;Hash<Text>))
+(def: fresh-mappings Mappings (dict.new text.Hash<Text>))
(def: (java-type-to-lux-type mappings java-type)
- (-> Mappings java.lang.reflect.Type (Meta Type))
- (cond (host;instance? TypeVariable java-type)
- (let [var-name (TypeVariable.getName [] (:! TypeVariable java-type))]
- (case (dict;get var-name mappings)
- (#;Some var-type)
+ (-> Mappings java/lang/reflect/Type (Meta Type))
+ (cond (host.instance? TypeVariable java-type)
+ (let [var-name (TypeVariable::getName [] (:! TypeVariable java-type))]
+ (case (dict.get var-name mappings)
+ (#.Some var-type)
(macro/wrap var-type)
- #;None
- (&;throw Unknown-Type-Var var-name)))
+ #.None
+ (&.throw Unknown-Type-Var var-name)))
- (host;instance? WildcardType java-type)
+ (host.instance? WildcardType java-type)
(let [java-type (:! WildcardType java-type)]
- (case [(array;read +0 (WildcardType.getUpperBounds [] java-type))
- (array;read +0 (WildcardType.getLowerBounds [] java-type))]
- (^or [(#;Some bound) _] [_ (#;Some bound)])
+ (case [(array.read +0 (WildcardType::getUpperBounds [] java-type))
+ (array.read +0 (WildcardType::getLowerBounds [] java-type))]
+ (^or [(#.Some bound) _] [_ (#.Some bound)])
(java-type-to-lux-type mappings bound)
_
(macro/wrap Top)))
- (host;instance? Class java-type)
+ (host.instance? Class java-type)
(let [java-type (:! (Class Object) java-type)
- class-name (Class.getName [] java-type)]
- (macro/wrap (case (array;size (Class.getTypeParameters [] java-type))
+ class-name (Class::getName [] java-type)]
+ (macro/wrap (case (array.size (Class::getTypeParameters [] java-type))
+0
- (#;Primitive class-name (list))
+ (#.Primitive class-name (list))
arity
- (|> (list;n.range +0 (n.dec arity))
- list;reverse
- (list/map (|>. (n.* +2) n.inc #;Bound))
- (#;Primitive class-name)
- (type;univ-q arity)))))
+ (|> (list.n/range +0 (n/dec arity))
+ list.reverse
+ (list/map (|>> (n/* +2) n/inc #.Bound))
+ (#.Primitive class-name)
+ (type.univ-q arity)))))
- (host;instance? ParameterizedType java-type)
+ (host.instance? ParameterizedType java-type)
(let [java-type (:! ParameterizedType java-type)
- raw (ParameterizedType.getRawType [] java-type)]
- (if (host;instance? Class raw)
- (do macro;Monad<Meta>
+ raw (ParameterizedType::getRawType [] java-type)]
+ (if (host.instance? Class raw)
+ (do macro.Monad<Meta>
[paramsT (|> java-type
- (ParameterizedType.getActualTypeArguments [])
- array;to-list
- (monad;map @ (java-type-to-lux-type mappings)))]
- (macro/wrap (#;Primitive (Class.getName [] (:! (Class Object) raw))
+ (ParameterizedType::getActualTypeArguments [])
+ array.to-list
+ (monad.map @ (java-type-to-lux-type mappings)))]
+ (macro/wrap (#.Primitive (Class::getName [] (:! (Class Object) raw))
paramsT)))
- (&;throw JVM-Type-Is-Not-Class (type-descriptor raw))))
+ (&.throw JVM-Type-Is-Not-Class (type-descriptor raw))))
- (host;instance? GenericArrayType java-type)
- (do macro;Monad<Meta>
+ (host.instance? GenericArrayType java-type)
+ (do macro.Monad<Meta>
[innerT (|> (:! GenericArrayType java-type)
- (GenericArrayType.getGenericComponentType [])
+ (GenericArrayType::getGenericComponentType [])
(java-type-to-lux-type mappings))]
- (wrap (#;Primitive "#Array" (list innerT))))
+ (wrap (#.Primitive "#Array" (list innerT))))
## else
- (&;throw Cannot-Convert-To-Lux-Type (type-descriptor java-type))))
+ (&.throw Cannot-Convert-To-Lux-Type (type-descriptor java-type))))
(type: Direction
#In
@@ -634,18 +634,18 @@
(def: (correspond-type-params class type)
(-> (Class Object) Type (Meta Mappings))
(case type
- (#;Primitive name params)
- (let [class-name (Class.getName [] class)
- class-params (array;to-list (Class.getTypeParameters [] class))
- num-class-params (list;size class-params)
- num-type-params (list;size params)]
+ (#.Primitive name params)
+ (let [class-name (Class::getName [] class)
+ class-params (array.to-list (Class::getTypeParameters [] class))
+ num-class-params (list.size class-params)
+ num-type-params (list.size params)]
(cond (not (text/= class-name name))
- (&;throw Cannot-Correspond-Type-With-Class
+ (&.throw Cannot-Correspond-Type-With-Class
(format "Class = " class-name "\n"
"Type = " (%type type)))
- (not (n.= num-class-params num-type-params))
- (&;throw Type-Parameter-Mismatch
+ (not (n/= num-class-params num-type-params))
+ (&.throw Type-Parameter-Mismatch
(format "Expected: " (%i (nat-to-int num-class-params)) "\n"
" Actual: " (%i (nat-to-int num-type-params)) "\n"
" Class: " class-name "\n"
@@ -653,28 +653,28 @@
## else
(macro/wrap (|> params
- (list;zip2 (list/map (TypeVariable.getName []) class-params))
- (dict;from-list text;Hash<Text>)))
+ (list.zip2 (list/map (TypeVariable::getName []) class-params))
+ (dict.from-list text.Hash<Text>)))
))
_
- (&;throw Non-JVM-Type (%type type))))
+ (&.throw Non-JVM-Type (%type type))))
(def: (cast direction to from)
(-> Direction Type Type (Meta [Text Type]))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[to-name (check-jvm to)
from-name (check-jvm from)]
- (cond (dict;contains? to-name boxes)
- (let [box (maybe;assume (dict;get to-name boxes))]
+ (cond (dict.contains? to-name boxes)
+ (let [box (maybe.assume (dict.get to-name boxes))]
(if (text/= box from-name)
- (wrap [(choose direction to-name from-name) (#;Primitive to-name (list))])
- (&;throw Cannot-Cast (cannot-cast to from))))
+ (wrap [(choose direction to-name from-name) (#.Primitive to-name (list))])
+ (&.throw Cannot-Cast (cannot-cast to from))))
- (dict;contains? from-name boxes)
- (let [box (maybe;assume (dict;get from-name boxes))]
+ (dict.contains? from-name boxes)
+ (let [box (maybe.assume (dict.get from-name boxes))]
(do @
- [[_ castT] (cast direction to (#;Primitive box (list)))]
+ [[_ castT] (cast direction to (#.Primitive box (list)))]
(wrap [(choose direction to-name from-name) castT])))
(text/= to-name from-name)
@@ -687,226 +687,226 @@
(do @
[to-class (load-class to-name)
from-class (load-class from-name)
- _ (&;assert Cannot-Cast (cannot-cast to from)
- (Class.isAssignableFrom [from-class] to-class))
- candiate-parents (monad;map @
+ _ (&.assert Cannot-Cast (cannot-cast to from)
+ (Class::isAssignableFrom [from-class] to-class))
+ candiate-parents (monad.map @
(function [java-type]
(do @
[class-name (java-type-to-class java-type)
class (load-class class-name)]
- (wrap [java-type (Class.isAssignableFrom [class] to-class)])))
- (list& (Class.getGenericSuperclass [] from-class)
- (array;to-list (Class.getGenericInterfaces [] from-class))))]
+ (wrap [java-type (Class::isAssignableFrom [class] to-class)])))
+ (list& (Class::getGenericSuperclass [] from-class)
+ (array.to-list (Class::getGenericInterfaces [] from-class))))]
(case (|> candiate-parents
- (list;filter product;right)
- (list/map product;left))
- (#;Cons parent _)
+ (list.filter product.right)
+ (list/map product.left))
+ (#.Cons parent _)
(do @
[mapping (correspond-type-params from-class from)
parentT (java-type-to-lux-type mapping parent)
[_ castT] (cast direction to parentT)]
(wrap [(choose direction to-name from-name) castT]))
- #;Nil
- (&;throw Cannot-Cast (cannot-cast to from)))))))
+ #.Nil
+ (&.throw Cannot-Cast (cannot-cast to from)))))))
(def: (infer-out outputT)
(-> Type (Meta [Text Type]))
- (do macro;Monad<Meta>
- [expectedT macro;expected-type
+ (do macro.Monad<Meta>
+ [expectedT macro.expected-type
[unboxed castT] (cast #Out expectedT outputT)
- _ (&;with-type-env
- (tc;check expectedT castT))]
+ _ (&.with-type-env
+ (tc.check expectedT castT))]
(wrap [unboxed castT])))
(def: (find-field class-name field-name)
(-> Text Text (Meta [(Class Object) Field]))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[class (load-class class-name)]
- (case (Class.getDeclaredField [field-name] class)
- (#e;Success field)
- (let [owner (Field.getDeclaringClass [] field)]
+ (case (Class::getDeclaredField [field-name] class)
+ (#e.Success field)
+ (let [owner (Field::getDeclaringClass [] field)]
(if (is owner class)
(wrap [class field])
- (&;throw Mistaken-Field-Owner
+ (&.throw Mistaken-Field-Owner
(format " Field: " field-name "\n"
- " Owner Class: " (Class.getName [] owner) "\n"
+ " Owner Class: " (Class::getName [] owner) "\n"
"Target Class: " class-name "\n"))))
- (#e;Error _)
- (&;throw Unknown-Field (format class-name "#" field-name)))))
+ (#e.Error _)
+ (&.throw Unknown-Field (format class-name "#" field-name)))))
(def: (static-field class-name field-name)
(-> Text Text (Meta [Type Bool]))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[[class fieldJ] (find-field class-name field-name)
- #let [modifiers (Field.getModifiers [] fieldJ)]]
- (if (Modifier.isStatic [modifiers])
- (let [fieldJT (Field.getGenericType [] fieldJ)]
+ #let [modifiers (Field::getModifiers [] fieldJ)]]
+ (if (Modifier::isStatic [modifiers])
+ (let [fieldJT (Field::getGenericType [] fieldJ)]
(do @
[fieldT (java-type-to-lux-type fresh-mappings fieldJT)]
- (wrap [fieldT (Modifier.isFinal [modifiers])])))
- (&;throw Not-Static-Field (format class-name "#" field-name)))))
+ (wrap [fieldT (Modifier::isFinal [modifiers])])))
+ (&.throw Not-Static-Field (format class-name "#" field-name)))))
(def: (virtual-field class-name field-name objectT)
(-> Text Text Type (Meta [Type Bool]))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[[class fieldJ] (find-field class-name field-name)
- #let [modifiers (Field.getModifiers [] fieldJ)]]
- (if (not (Modifier.isStatic [modifiers]))
+ #let [modifiers (Field::getModifiers [] fieldJ)]]
+ (if (not (Modifier::isStatic [modifiers]))
(do @
- [#let [fieldJT (Field.getGenericType [] fieldJ)
+ [#let [fieldJT (Field::getGenericType [] fieldJ)
var-names (|> class
- (Class.getTypeParameters [])
- array;to-list
- (list/map (TypeVariable.getName [])))]
+ (Class::getTypeParameters [])
+ array.to-list
+ (list/map (TypeVariable::getName [])))]
mappings (: (Meta Mappings)
(case objectT
- (#;Primitive _class-name _class-params)
+ (#.Primitive _class-name _class-params)
(do @
- [#let [num-params (list;size _class-params)
- num-vars (list;size var-names)]
- _ (&;assert Type-Parameter-Mismatch
+ [#let [num-params (list.size _class-params)
+ num-vars (list.size var-names)]
+ _ (&.assert Type-Parameter-Mismatch
(format "Expected: " (%i (nat-to-int num-params)) "\n"
" Actual: " (%i (nat-to-int num-vars)) "\n"
" Class: " _class-name "\n"
" Type: " (%type objectT))
- (n.= num-params num-vars))]
- (wrap (|> (list;zip2 var-names _class-params)
- (dict;from-list text;Hash<Text>))))
+ (n/= num-params num-vars))]
+ (wrap (|> (list.zip2 var-names _class-params)
+ (dict.from-list text.Hash<Text>))))
_
- (&;throw Non-Object (%type objectT))))
+ (&.throw Non-Object (%type objectT))))
fieldT (java-type-to-lux-type mappings fieldJT)]
- (wrap [fieldT (Modifier.isFinal [modifiers])]))
- (&;throw Not-Virtual-Field (format class-name "#" field-name)))))
+ (wrap [fieldT (Modifier::isFinal [modifiers])]))
+ (&.throw Not-Virtual-Field (format class-name "#" field-name)))))
(def: (analyse-object class analyse sourceC)
- (-> Text &;Analyser Code (Meta [Type la;Analysis]))
- (do macro;Monad<Meta>
+ (-> Text &.Analyser Code (Meta [Type la.Analysis]))
+ (do macro.Monad<Meta>
[target-class (load-class class)
targetT (java-type-to-lux-type fresh-mappings
- (:! java.lang.reflect.Type
+ (:! java/lang/reflect/Type
target-class))
- [sourceT sourceA] (&common;with-unknown-type
+ [sourceT sourceA] (&common.with-unknown-type
(analyse sourceC))
[unboxed castT] (cast #Out targetT sourceT)
- _ (&;assert Cannot-Cast (cannot-cast targetT sourceT)
- (not (dict;contains? unboxed boxes)))]
+ _ (&.assert Cannot-Cast (cannot-cast targetT sourceT)
+ (not (dict.contains? unboxed boxes)))]
(wrap [castT sourceA])))
(def: (analyse-input analyse targetT sourceC)
- (-> &;Analyser Type Code (Meta [Type Text la;Analysis]))
- (do macro;Monad<Meta>
- [[sourceT sourceA] (&common;with-unknown-type
+ (-> &.Analyser Type Code (Meta [Type Text la.Analysis]))
+ (do macro.Monad<Meta>
+ [[sourceT sourceA] (&common.with-unknown-type
(analyse sourceC))
[unboxed castT] (cast #In targetT sourceT)]
(wrap [castT unboxed sourceA])))
(def: (static-get proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list classC fieldC))
(case [classC fieldC]
- [[_ (#;Text class)] [_ (#;Text field)]]
- (do macro;Monad<Meta>
+ [[_ (#.Text class)] [_ (#.Text field)]]
+ (do macro.Monad<Meta>
[[fieldT final?] (static-field class field)
[unboxed castT] (infer-out fieldT)]
- (wrap (la;procedure proc (list (code;text class) (code;text field)
- (code;text unboxed)))))
+ (wrap (la.procedure proc (list (code.text class) (code.text field)
+ (code.text unboxed)))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +2 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
(def: (static-put proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list classC fieldC valueC))
(case [classC fieldC]
- [[_ (#;Text class)] [_ (#;Text field)]]
- (do macro;Monad<Meta>
- [_ (&;infer Unit)
+ [[_ (#.Text class)] [_ (#.Text field)]]
+ (do macro.Monad<Meta>
+ [_ (&.infer Unit)
[fieldT final?] (static-field class field)
- _ (&;assert Cannot-Set-Final-Field (format class "#" field)
+ _ (&.assert Cannot-Set-Final-Field (format class "#" field)
(not final?))
[valueT unboxed valueA] (analyse-input analyse fieldT valueC)
- _ (&;with-type-env
- (tc;check fieldT valueT))]
- (wrap (la;procedure proc (list (code;text class) (code;text field)
- (code;text unboxed) valueA))))
+ _ (&.with-type-env
+ (tc.check fieldT valueT))]
+ (wrap (la.procedure proc (list (code.text class) (code.text field)
+ (code.text unboxed) valueA))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +3 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
(def: (virtual-get proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list classC fieldC objectC))
(case [classC fieldC]
- [[_ (#;Text class)] [_ (#;Text field)]]
- (do macro;Monad<Meta>
+ [[_ (#.Text class)] [_ (#.Text field)]]
+ (do macro.Monad<Meta>
[[objectT objectA] (analyse-object class analyse objectC)
[fieldT final?] (virtual-field class field objectT)
[unboxed castT] (infer-out fieldT)]
- (wrap (la;procedure proc (list (code;text class) (code;text field)
- (code;text unboxed) objectA))))
+ (wrap (la.procedure proc (list (code.text class) (code.text field)
+ (code.text unboxed) objectA))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +3 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
(def: (virtual-put proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(function [analyse eval args]
(case args
(^ (list classC fieldC valueC objectC))
(case [classC fieldC]
- [[_ (#;Text class)] [_ (#;Text field)]]
- (do macro;Monad<Meta>
+ [[_ (#.Text class)] [_ (#.Text field)]]
+ (do macro.Monad<Meta>
[[objectT objectA] (analyse-object class analyse objectC)
- _ (&;infer objectT)
+ _ (&.infer objectT)
[fieldT final?] (virtual-field class field objectT)
- _ (&;assert Cannot-Set-Final-Field (format class "#" field)
+ _ (&.assert Cannot-Set-Final-Field (format class "#" field)
(not final?))
[valueT unboxed valueA] (analyse-input analyse fieldT valueC)]
- (wrap (la;procedure proc (list (code;text class) (code;text field) (code;text unboxed) valueA objectA))))
+ (wrap (la.procedure proc (list (code.text class) (code.text field) (code.text unboxed) valueA objectA))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))
_
- (&;throw @;Incorrect-Procedure-Arity (@;wrong-arity proc +4 (list;size args))))))
+ (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +4 (list.size args))))))
(def: (java-type-to-parameter type)
- (-> java.lang.reflect.Type (Meta Text))
- (cond (host;instance? Class type)
- (macro/wrap (Class.getName [] (:! Class type)))
+ (-> java/lang/reflect/Type (Meta Text))
+ (cond (host.instance? Class type)
+ (macro/wrap (Class::getName [] (:! Class type)))
- (host;instance? ParameterizedType type)
- (java-type-to-parameter (ParameterizedType.getRawType [] (:! ParameterizedType type)))
+ (host.instance? ParameterizedType type)
+ (java-type-to-parameter (ParameterizedType::getRawType [] (:! ParameterizedType type)))
- (or (host;instance? TypeVariable type)
- (host;instance? WildcardType type))
+ (or (host.instance? TypeVariable type)
+ (host.instance? WildcardType type))
(macro/wrap "java.lang.Object")
- (host;instance? GenericArrayType type)
- (do macro;Monad<Meta>
- [componentP (java-type-to-parameter (GenericArrayType.getGenericComponentType [] (:! GenericArrayType type)))]
+ (host.instance? GenericArrayType type)
+ (do macro.Monad<Meta>
+ [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:! GenericArrayType type)))]
(wrap (format componentP "[]")))
## else
- (&;throw Cannot-Convert-To-Parameter (type-descriptor type))))
+ (&.throw Cannot-Convert-To-Parameter (type-descriptor type))))
(type: Method-Type
#Static
@@ -917,326 +917,326 @@
(def: (check-method class method-name method-type arg-classes method)
(-> (Class Object) Text Method-Type (List Text) Method (Meta Bool))
- (do macro;Monad<Meta>
- [parameters (|> (Method.getGenericParameterTypes [] method)
- array;to-list
- (monad;map @ java-type-to-parameter))
- #let [modifiers (Method.getModifiers [] method)]]
- (wrap (and (Object.equals [class] (Method.getDeclaringClass [] method))
- (text/= method-name (Method.getName [] method))
+ (do macro.Monad<Meta>
+ [parameters (|> (Method::getGenericParameterTypes [] method)
+ array.to-list
+ (monad.map @ java-type-to-parameter))
+ #let [modifiers (Method::getModifiers [] method)]]
+ (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method))
+ (text/= method-name (Method::getName [] method))
(case #Static
#Special
- (Modifier.isStatic [modifiers])
+ (Modifier::isStatic [modifiers])
_
true)
(case method-type
#Special
- (not (or (Modifier.isInterface [(Class.getModifiers [] class)])
- (Modifier.isAbstract [modifiers])))
+ (not (or (Modifier::isInterface [(Class::getModifiers [] class)])
+ (Modifier::isAbstract [modifiers])))
_
true)
- (n.= (list;size arg-classes) (list;size parameters))
+ (n/= (list.size arg-classes) (list.size parameters))
(list/fold (function [[expectedJC actualJC] prev]
(and prev
(text/= expectedJC actualJC)))
true
- (list;zip2 arg-classes parameters))))))
+ (list.zip2 arg-classes parameters))))))
(def: (check-constructor class arg-classes constructor)
(-> (Class Object) (List Text) (Constructor Object) (Meta Bool))
- (do macro;Monad<Meta>
- [parameters (|> (Constructor.getGenericParameterTypes [] constructor)
- array;to-list
- (monad;map @ java-type-to-parameter))]
- (wrap (and (Object.equals [class] (Constructor.getDeclaringClass [] constructor))
- (n.= (list;size arg-classes) (list;size parameters))
+ (do macro.Monad<Meta>
+ [parameters (|> (Constructor::getGenericParameterTypes [] constructor)
+ array.to-list
+ (monad.map @ java-type-to-parameter))]
+ (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor))
+ (n/= (list.size arg-classes) (list.size parameters))
(list/fold (function [[expectedJC actualJC] prev]
(and prev
(text/= expectedJC actualJC)))
true
- (list;zip2 arg-classes parameters))))))
+ (list.zip2 arg-classes parameters))))))
(def: idx-to-bound
(-> Nat Type)
- (|>. (n.* +2) n.inc #;Bound))
+ (|>> (n/* +2) n/inc #.Bound))
(def: (type-vars amount offset)
(-> Nat Nat (List Type))
- (if (n.= +0 amount)
+ (if (n/= +0 amount)
(list)
- (|> (list;n.range offset (|> amount n.dec (n.+ offset)))
+ (|> (list.n/range offset (|> amount n/dec (n/+ offset)))
(list/map idx-to-bound))))
(def: (method-to-type method-type method)
(-> Method-Type Method (Meta [Type (List Type)]))
- (let [owner (Method.getDeclaringClass [] method)
- owner-name (Class.getName [] owner)
+ (let [owner (Method::getDeclaringClass [] method)
+ owner-name (Class::getName [] owner)
owner-tvars (case method-type
#Static
(list)
_
- (|> (Class.getTypeParameters [] owner)
- array;to-list
- (list/map (TypeVariable.getName []))))
- method-tvars (|> (Method.getTypeParameters [] method)
- array;to-list
- (list/map (TypeVariable.getName [])))
- num-owner-tvars (list;size owner-tvars)
- num-method-tvars (list;size method-tvars)
+ (|> (Class::getTypeParameters [] owner)
+ array.to-list
+ (list/map (TypeVariable::getName []))))
+ method-tvars (|> (Method::getTypeParameters [] method)
+ array.to-list
+ (list/map (TypeVariable::getName [])))
+ num-owner-tvars (list.size owner-tvars)
+ num-method-tvars (list.size method-tvars)
all-tvars (list/compose owner-tvars method-tvars)
- num-all-tvars (list;size all-tvars)
+ num-all-tvars (list.size all-tvars)
owner-tvarsT (type-vars num-owner-tvars +0)
method-tvarsT (type-vars num-method-tvars num-owner-tvars)
mappings (: Mappings
- (if (list;empty? all-tvars)
+ (if (list.empty? all-tvars)
fresh-mappings
(|> (list/compose owner-tvarsT method-tvarsT)
- list;reverse
- (list;zip2 all-tvars)
- (dict;from-list text;Hash<Text>))))]
- (do macro;Monad<Meta>
- [inputsT (|> (Method.getGenericParameterTypes [] method)
- array;to-list
- (monad;map @ (java-type-to-lux-type mappings)))
- outputT (java-type-to-lux-type mappings (Method.getGenericReturnType [] method))
- exceptionsT (|> (Method.getGenericExceptionTypes [] method)
- array;to-list
- (monad;map @ (java-type-to-lux-type mappings)))
- #let [methodT (<| (type;univ-q num-all-tvars)
- (type;function (case method-type
+ list.reverse
+ (list.zip2 all-tvars)
+ (dict.from-list text.Hash<Text>))))]
+ (do macro.Monad<Meta>
+ [inputsT (|> (Method::getGenericParameterTypes [] method)
+ array.to-list
+ (monad.map @ (java-type-to-lux-type mappings)))
+ outputT (java-type-to-lux-type mappings (Method::getGenericReturnType [] method))
+ exceptionsT (|> (Method::getGenericExceptionTypes [] method)
+ array.to-list
+ (monad.map @ (java-type-to-lux-type mappings)))
+ #let [methodT (<| (type.univ-q num-all-tvars)
+ (type.function (case method-type
#Static
inputsT
_
- (list& (#;Primitive owner-name (list;reverse owner-tvarsT))
+ (list& (#.Primitive owner-name (list.reverse owner-tvarsT))
inputsT)))
outputT)]]
(wrap [methodT exceptionsT]))))
(def: (methods class-name method-name method-type arg-classes)
(-> Text Text Method-Type (List Text) (Meta [Type (List Type)]))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[class (load-class class-name)
candidates (|> class
- (Class.getDeclaredMethods [])
- array;to-list
- (monad;map @ (function [method]
+ (Class::getDeclaredMethods [])
+ array.to-list
+ (monad.map @ (function [method]
(do @
[passes? (check-method class method-name method-type arg-classes method)]
(wrap [passes? method])))))]
- (case (list;filter product;left candidates)
- #;Nil
- (&;throw No-Candidates (format class-name "#" method-name))
+ (case (list.filter product.left candidates)
+ #.Nil
+ (&.throw No-Candidates (format class-name "#" method-name))
- (#;Cons candidate #;Nil)
- (|> candidate product;right (method-to-type method-type))
+ (#.Cons candidate #.Nil)
+ (|> candidate product.right (method-to-type method-type))
_
- (&;throw Too-Many-Candidates (format class-name "#" method-name)))))
+ (&.throw Too-Many-Candidates (format class-name "#" method-name)))))
(def: (constructor-to-type constructor)
(-> (Constructor Object) (Meta [Type (List Type)]))
- (let [owner (Constructor.getDeclaringClass [] constructor)
- owner-name (Class.getName [] owner)
- owner-tvars (|> (Class.getTypeParameters [] owner)
- array;to-list
- (list/map (TypeVariable.getName [])))
- constructor-tvars (|> (Constructor.getTypeParameters [] constructor)
- array;to-list
- (list/map (TypeVariable.getName [])))
- num-owner-tvars (list;size owner-tvars)
+ (let [owner (Constructor::getDeclaringClass [] constructor)
+ owner-name (Class::getName [] owner)
+ owner-tvars (|> (Class::getTypeParameters [] owner)
+ array.to-list
+ (list/map (TypeVariable::getName [])))
+ constructor-tvars (|> (Constructor::getTypeParameters [] constructor)
+ array.to-list
+ (list/map (TypeVariable::getName [])))
+ num-owner-tvars (list.size owner-tvars)
all-tvars (list/compose owner-tvars constructor-tvars)
- num-all-tvars (list;size all-tvars)
+ num-all-tvars (list.size all-tvars)
owner-tvarsT (type-vars num-owner-tvars +0)
constructor-tvarsT (type-vars num-all-tvars num-owner-tvars)
mappings (: Mappings
- (if (list;empty? all-tvars)
+ (if (list.empty? all-tvars)
fresh-mappings
(|> (list/compose owner-tvarsT constructor-tvarsT)
- list;reverse
- (list;zip2 all-tvars)
- (dict;from-list text;Hash<Text>))))]
- (do macro;Monad<Meta>
- [inputsT (|> (Constructor.getGenericParameterTypes [] constructor)
- array;to-list
- (monad;map @ (java-type-to-lux-type mappings)))
- exceptionsT (|> (Constructor.getGenericExceptionTypes [] constructor)
- array;to-list
- (monad;map @ (java-type-to-lux-type mappings)))
- #let [objectT (#;Primitive owner-name (list;reverse owner-tvarsT))
- constructorT (<| (type;univ-q num-all-tvars)
- (type;function inputsT)
+ list.reverse
+ (list.zip2 all-tvars)
+ (dict.from-list text.Hash<Text>))))]
+ (do macro.Monad<Meta>
+ [inputsT (|> (Constructor::getGenericParameterTypes [] constructor)
+ array.to-list
+ (monad.map @ (java-type-to-lux-type mappings)))
+ exceptionsT (|> (Constructor::getGenericExceptionTypes [] constructor)
+ array.to-list
+ (monad.map @ (java-type-to-lux-type mappings)))
+ #let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT))
+ constructorT (<| (type.univ-q num-all-tvars)
+ (type.function inputsT)
objectT)]]
(wrap [constructorT exceptionsT]))))
(def: (constructor-methods class-name arg-classes)
(-> Text (List Text) (Meta [Type (List Type)]))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[class (load-class class-name)
candidates (|> class
- (Class.getConstructors [])
- array;to-list
- (monad;map @ (function [constructor]
+ (Class::getConstructors [])
+ array.to-list
+ (monad.map @ (function [constructor]
(do @
[passes? (check-constructor class arg-classes constructor)]
(wrap [passes? constructor])))))]
- (case (list;filter product;left candidates)
- #;Nil
- (&;throw No-Candidates (format class-name "(" (text;join-with ", " arg-classes) ")"))
+ (case (list.filter product.left candidates)
+ #.Nil
+ (&.throw No-Candidates (format class-name "(" (text.join-with ", " arg-classes) ")"))
- (#;Cons candidate #;Nil)
- (|> candidate product;right constructor-to-type)
+ (#.Cons candidate #.Nil)
+ (|> candidate product.right constructor-to-type)
_
- (&;throw Too-Many-Candidates class-name))))
+ (&.throw Too-Many-Candidates class-name))))
(def: (decorate-inputs typesT inputsA)
- (-> (List Text) (List la;Analysis) (List la;Analysis))
+ (-> (List Text) (List la.Analysis) (List la.Analysis))
(|> inputsA
- (list;zip2 (list/map code;text typesT))
+ (list.zip2 (list/map code.text typesT))
(list/map (function [[type value]]
- (la;product (list type value))))))
+ (la.product (list type value))))))
(def: (sub-type-analyser analyse)
- (-> &;Analyser &;Analyser)
+ (-> &.Analyser &.Analyser)
(function [argC]
- (do macro;Monad<Meta>
- [[argT argA] (&common;with-unknown-type
+ (do macro.Monad<Meta>
+ [[argT argA] (&common.with-unknown-type
(analyse argC))
- expectedT macro;expected-type
+ expectedT macro.expected-type
[unboxed castT] (cast #In expectedT argT)]
(wrap argA))))
(def: (invoke//static proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(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))))))
- (#e;Success [class method argsTC])
- (do macro;Monad<Meta>
- [#let [argsT (list/map product;left argsTC)]
+ (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))))))
+ (#e.Success [class method argsTC])
+ (do macro.Monad<Meta>
+ [#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (methods class method #Static argsT)
- [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC))
+ [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list/map product.right argsTC))
[unboxed castT] (infer-out outputT)]
- (wrap (la;procedure proc (list& (code;text class) (code;text method)
- (code;text unboxed) (decorate-inputs argsT argsA)))))
+ (wrap (la.procedure proc (list& (code.text class) (code.text method)
+ (code.text unboxed) (decorate-inputs argsT argsA)))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))))
(def: (invoke//virtual proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(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))))))
- (#e;Success [class method objectC argsTC])
- (do macro;Monad<Meta>
- [#let [argsT (list/map product;left argsTC)]
+ (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))))))
+ (#e.Success [class method objectC argsTC])
+ (do macro.Monad<Meta>
+ [#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (methods class method #Virtual argsT)
- [outputT allA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC)))
+ [outputT allA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
#let [[objectA argsA] (case allA
- (#;Cons objectA argsA)
+ (#.Cons objectA argsA)
[objectA argsA]
_
(undefined))]
[unboxed castT] (infer-out outputT)]
- (wrap (la;procedure proc (list& (code;text class) (code;text method)
- (code;text unboxed) objectA (decorate-inputs argsT argsA)))))
+ (wrap (la.procedure proc (list& (code.text class) (code.text method)
+ (code.text unboxed) objectA (decorate-inputs argsT argsA)))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))))
(def: (invoke//special proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(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!)))
- (#e;Success [_ [class method objectC argsTC _]])
- (do macro;Monad<Meta>
- [#let [argsT (list/map product;left argsTC)]
+ (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!)))
+ (#e.Success [_ [class method objectC argsTC _]])
+ (do macro.Monad<Meta>
+ [#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (methods class method #Special argsT)
- [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC)))
+ [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
[unboxed castT] (infer-out outputT)]
- (wrap (la;procedure proc (list& (code;text class) (code;text method)
- (code;text unboxed) (decorate-inputs argsT argsA)))))
+ (wrap (la.procedure proc (list& (code.text class) (code.text method)
+ (code.text unboxed) (decorate-inputs argsT argsA)))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))))
(def: (invoke//interface proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(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))))))
- (#e;Success [class-name method objectC argsTC])
- (do macro;Monad<Meta>
- [#let [argsT (list/map product;left argsTC)]
+ (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))))))
+ (#e.Success [class-name method objectC argsTC])
+ (do macro.Monad<Meta>
+ [#let [argsT (list/map product.left argsTC)]
class (load-class class-name)
- _ (&;assert Non-Interface class-name
- (Modifier.isInterface [(Class.getModifiers [] class)]))
+ _ (&.assert Non-Interface class-name
+ (Modifier::isInterface [(Class::getModifiers [] class)]))
[methodT exceptionsT] (methods class-name method #Interface argsT)
- [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC)))
+ [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
[unboxed castT] (infer-out outputT)]
- (wrap (la;procedure proc
- (list& (code;text class-name) (code;text method) (code;text unboxed)
+ (wrap (la.procedure proc
+ (list& (code.text class-name) (code.text method) (code.text unboxed)
(decorate-inputs argsT argsA)))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))))
(def: (invoke//constructor proc)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(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))))))
- (#e;Success [class argsTC])
- (do macro;Monad<Meta>
- [#let [argsT (list/map product;left argsTC)]
+ (case (: (e.Error [Text (List [Text Code])])
+ (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any))))))
+ (#e.Success [class argsTC])
+ (do macro.Monad<Meta>
+ [#let [argsT (list/map product.left argsTC)]
[methodT exceptionsT] (constructor-methods class argsT)
- [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC))
+ [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list/map product.right argsTC))
[unboxed castT] (infer-out outputT)]
- (wrap (la;procedure proc (list& (code;text class) (decorate-inputs argsT argsA)))))
+ (wrap (la.procedure proc (list& (code.text class) (decorate-inputs argsT argsA)))))
_
- (&;throw Wrong-Syntax (wrong-syntax proc args)))))
+ (&.throw Wrong-Syntax (wrong-syntax proc args)))))
(def: member-procs
- @;Bundle
- (<| (@;prefix "member")
- (|> (dict;new text;Hash<Text>)
- (dict;merge (<| (@;prefix "static")
- (|> (dict;new text;Hash<Text>)
- (@;install "get" static-get)
- (@;install "put" static-put))))
- (dict;merge (<| (@;prefix "virtual")
- (|> (dict;new text;Hash<Text>)
- (@;install "get" virtual-get)
- (@;install "put" virtual-put))))
- (dict;merge (<| (@;prefix "invoke")
- (|> (dict;new text;Hash<Text>)
- (@;install "static" invoke//static)
- (@;install "virtual" invoke//virtual)
- (@;install "special" invoke//special)
- (@;install "interface" invoke//interface)
- (@;install "constructor" invoke//constructor)
+ @.Bundle
+ (<| (@.prefix "member")
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge (<| (@.prefix "static")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "get" static-get)
+ (@.install "put" static-put))))
+ (dict.merge (<| (@.prefix "virtual")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "get" virtual-get)
+ (@.install "put" virtual-put))))
+ (dict.merge (<| (@.prefix "invoke")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "static" invoke//static)
+ (@.install "virtual" invoke//virtual)
+ (@.install "special" invoke//special)
+ (@.install "interface" invoke//interface)
+ (@.install "constructor" invoke//constructor)
)))
)))
(def: #export procedures
- @;Bundle
- (<| (@;prefix "jvm")
- (|> (dict;new text;Hash<Text>)
- (dict;merge conversion-procs)
- (dict;merge int-procs)
- (dict;merge long-procs)
- (dict;merge float-procs)
- (dict;merge double-procs)
- (dict;merge char-procs)
- (dict;merge array-procs)
- (dict;merge object-procs)
- (dict;merge member-procs)
+ @.Bundle
+ (<| (@.prefix "jvm")
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge conversion-procs)
+ (dict.merge int-procs)
+ (dict.merge long-procs)
+ (dict.merge float-procs)
+ (dict.merge double-procs)
+ (dict.merge char-procs)
+ (dict.merge array-procs)
+ (dict.merge object-procs)
+ (dict.merge member-procs)
)))
diff --git a/new-luxc/source/luxc/lang/analysis/reference.lux b/new-luxc/source/luxc/lang/analysis/reference.lux
index c660408de..56aba35de 100644
--- a/new-luxc/source/luxc/lang/analysis/reference.lux
+++ b/new-luxc/source/luxc/lang/analysis/reference.lux
@@ -1,56 +1,56 @@
-(;module:
+(.module:
lux
(lux (control monad)
[macro]
(macro [code])
(lang (type ["tc" check])))
(luxc ["&" lang]
- (lang ["&;" scope]
+ (lang ["&." scope]
["la" analysis #+ Analysis]
- [";L" variable #+ Variable])))
+ [".L" variable #+ Variable])))
## [Analysers]
(def: (analyse-definition def-name)
(-> Ident (Meta Analysis))
- (do macro;Monad<Meta>
- [[actualT def-anns _] (&;with-error-tracking
- (macro;find-def def-name))]
- (case (macro;get-symbol-ann (ident-for #;alias) def-anns)
- (#;Some real-def-name)
+ (do macro.Monad<Meta>
+ [[actualT def-anns _] (&.with-error-tracking
+ (macro.find-def def-name))]
+ (case (macro.get-symbol-ann (ident-for #.alias) def-anns)
+ (#.Some real-def-name)
(analyse-definition real-def-name)
_
(do @
- [_ (&;infer actualT)
- def-name (macro;normalize def-name)]
- (wrap (code;symbol def-name))))))
+ [_ (&.infer actualT)
+ def-name (macro.normalize def-name)]
+ (wrap (code.symbol def-name))))))
(def: (analyse-variable var-name)
(-> Text (Meta (Maybe Analysis)))
- (do macro;Monad<Meta>
- [?var (&scope;find var-name)]
+ (do macro.Monad<Meta>
+ [?var (&scope.find var-name)]
(case ?var
- (#;Some [actualT ref])
+ (#.Some [actualT ref])
(do @
- [_ (&;infer actualT)]
- (wrap (#;Some (` ((~ (code;int (variableL;from-ref ref))))))))
+ [_ (&.infer actualT)]
+ (wrap (#.Some (` ((~ (code.int (variableL.from-ref ref))))))))
- #;None
- (wrap #;None))))
+ #.None
+ (wrap #.None))))
(def: #export (analyse-reference reference)
(-> Ident (Meta Analysis))
(case reference
["" simple-name]
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[?var (analyse-variable simple-name)]
(case ?var
- (#;Some varA)
+ (#.Some varA)
(wrap varA)
- #;None
+ #.None
(do @
- [this-module macro;current-module-name]
+ [this-module macro.current-module-name]
(analyse-definition [this-module simple-name]))))
_
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index e6cd2dbad..fb521d02e 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -14,11 +14,11 @@
(lang [type]
(type ["tc" check])))
(luxc ["&" lang]
- (lang ["&;" scope]
- ["&;" module]
+ (lang ["&." scope]
+ ["&." module]
["la" analysis]
- (analysis ["&;" common]
- ["&;" inference]))))
+ (analysis ["&." common]
+ ["&." inference]))))
(exception: #export Invalid-Variant-Type)
(exception: #export Invalid-Tuple-Type)
@@ -34,46 +34,46 @@
(exception: #export Record-Size-Mismatch)
(def: #export (analyse-sum analyse tag valueC)
- (-> &;Analyser Nat Code (Meta la;Analysis))
- (do macro;Monad<Meta>
- [expectedT macro;expected-type]
- (&;with-stacked-errors
+ (-> &.Analyser Nat Code (Meta la.Analysis))
+ (do macro.Monad<Meta>
+ [expectedT macro.expected-type]
+ (&.with-stacked-errors
(function [_] (Cannot-Analyse-Variant (format " Type: " (%type expectedT) "\n"
" Tag: " (%n tag) "\n"
"Expression: " (%code valueC))))
(case expectedT
- (#;Sum _)
- (let [flat (type;flatten-variant expectedT)
- type-size (list;size flat)]
- (case (list;nth tag flat)
- (#;Some variant-type)
+ (#.Sum _)
+ (let [flat (type.flatten-variant expectedT)
+ type-size (list.size flat)]
+ (case (list.nth tag flat)
+ (#.Some variant-type)
(do @
- [valueA (&;with-type variant-type
+ [valueA (&.with-type variant-type
(analyse valueC))
- temp &scope;next-local]
- (wrap (la;sum tag type-size temp valueA)))
+ temp &scope.next-local]
+ (wrap (la.sum tag type-size temp valueA)))
- #;None
- (&common;variant-out-of-bounds-error expectedT type-size tag)))
+ #.None
+ (&common.variant-out-of-bounds-error expectedT type-size tag)))
- (#;Named name unnamedT)
- (&;with-type unnamedT
+ (#.Named name unnamedT)
+ (&.with-type unnamedT
(analyse-sum analyse tag valueC))
- (#;Var id)
+ (#.Var id)
(do @
- [?expectedT' (&;with-type-env
- (tc;read id))]
+ [?expectedT' (&.with-type-env
+ (tc.read id))]
(case ?expectedT'
- (#;Some expectedT')
- (&;with-type expectedT'
+ (#.Some expectedT')
+ (&.with-type expectedT'
(analyse-sum analyse tag valueC))
_
## Cannot do inference when the tag is numeric.
## This is because there is no way of knowing how many
## cases the inferred sum type would have.
- (&;throw Cannot-Infer-Numeric-Tag (format " Type: " (%type expectedT) "\n"
+ (&.throw Cannot-Infer-Numeric-Tag (format " Type: " (%type expectedT) "\n"
" Tag: " (%n tag) "\n"
"Expression: " (%code valueC)))
))
@@ -81,59 +81,59 @@
(^template [<tag> <instancer>]
(<tag> _)
(do @
- [[instance-id instanceT] (&;with-type-env <instancer>)]
- (&;with-type (maybe;assume (type;apply (list instanceT) expectedT))
+ [[instance-id instanceT] (&.with-type-env <instancer>)]
+ (&.with-type (maybe.assume (type.apply (list instanceT) expectedT))
(analyse-sum analyse tag valueC))))
- ([#;UnivQ tc;existential]
- [#;ExQ tc;var])
+ ([#.UnivQ tc.existential]
+ [#.ExQ tc.var])
- (#;Apply inputT funT)
+ (#.Apply inputT funT)
(case funT
- (#;Var funT-id)
+ (#.Var funT-id)
(do @
- [?funT' (&;with-type-env (tc;read funT-id))]
+ [?funT' (&.with-type-env (tc.read funT-id))]
(case ?funT'
- (#;Some funT')
- (&;with-type (#;Apply inputT funT')
+ (#.Some funT')
+ (&.with-type (#.Apply inputT funT')
(analyse-sum analyse tag valueC))
_
- (&;throw Invalid-Variant-Type (format " Type: " (%type expectedT) "\n"
+ (&.throw Invalid-Variant-Type (format " Type: " (%type expectedT) "\n"
" Tag: " (%n tag) "\n"
"Expression: " (%code valueC)))))
_
- (case (type;apply (list inputT) funT)
- #;None
- (&;throw Not-Quantified-Type (%type funT))
+ (case (type.apply (list inputT) funT)
+ #.None
+ (&.throw Not-Quantified-Type (%type funT))
- (#;Some outputT)
- (&;with-type outputT
+ (#.Some outputT)
+ (&.with-type outputT
(analyse-sum analyse tag valueC))))
_
- (&;throw Invalid-Variant-Type (format " Type: " (%type expectedT) "\n"
+ (&.throw Invalid-Variant-Type (format " Type: " (%type expectedT) "\n"
" Tag: " (%n tag) "\n"
"Expression: " (%code valueC)))))))
(def: (analyse-typed-product analyse membersC+)
- (-> &;Analyser (List Code) (Meta la;Analysis))
- (do macro;Monad<Meta>
- [expectedT macro;expected-type]
+ (-> &.Analyser (List Code) (Meta la.Analysis))
+ (do macro.Monad<Meta>
+ [expectedT macro.expected-type]
(loop [expectedT expectedT
membersC+ membersC+]
(case [expectedT membersC+]
## If the tuple runs out, whatever expression is the last gets
## matched to the remaining type.
- [tailT (#;Cons tailC #;Nil)]
- (&;with-type tailT
+ [tailT (#.Cons tailC #.Nil)]
+ (&.with-type tailT
(analyse tailC))
## If the type and the code are still ongoing, match each
## sub-expression to its corresponding type.
- [(#;Product leftT rightT) (#;Cons leftC rightC)]
+ [(#.Product leftT rightT) (#.Cons leftC rightC)]
(do @
- [leftA (&;with-type leftT
+ [leftA (&.with-type leftT
(analyse leftC))
rightA (recur rightT rightC)]
(wrap (` [(~ leftA) (~ rightA)])))
@@ -157,98 +157,98 @@
## and what was analysed.
[tailT tailC]
(do @
- [g!tail (macro;gensym "tail")]
- (&;with-type tailT
+ [g!tail (macro.gensym "tail")]
+ (&.with-type tailT
(analyse (` ("lux case" [(~@ tailC)]
(~ g!tail)
(~ g!tail))))))
))))
(def: #export (analyse-product analyse membersC)
- (-> &;Analyser (List Code) (Meta la;Analysis))
- (do macro;Monad<Meta>
- [expectedT macro;expected-type]
- (&;with-stacked-errors
+ (-> &.Analyser (List Code) (Meta la.Analysis))
+ (do macro.Monad<Meta>
+ [expectedT macro.expected-type]
+ (&.with-stacked-errors
(function [_] (Cannot-Analyse-Tuple (format " Type: " (%type expectedT) "\n"
"Expression: " (%code (` [(~@ membersC)])))))
(case expectedT
- (#;Product _)
+ (#.Product _)
(analyse-typed-product analyse membersC)
- (#;Named name unnamedT)
- (&;with-type unnamedT
+ (#.Named name unnamedT)
+ (&.with-type unnamedT
(analyse-product analyse membersC))
- (#;Var id)
+ (#.Var id)
(do @
- [?expectedT' (&;with-type-env
- (tc;read id))]
+ [?expectedT' (&.with-type-env
+ (tc.read id))]
(case ?expectedT'
- (#;Some expectedT')
- (&;with-type expectedT'
+ (#.Some expectedT')
+ (&.with-type expectedT'
(analyse-product analyse membersC))
_
## Must do inference...
(do @
- [membersTA (monad;map @ (|>. analyse &common;with-unknown-type)
+ [membersTA (monad.map @ (|>> analyse &common.with-unknown-type)
membersC)
- _ (&;with-type-env
- (tc;check expectedT
- (type;tuple (list/map product;left membersTA))))]
- (wrap (la;product (list/map product;right membersTA))))))
+ _ (&.with-type-env
+ (tc.check expectedT
+ (type.tuple (list/map product.left membersTA))))]
+ (wrap (la.product (list/map product.right membersTA))))))
(^template [<tag> <instancer>]
(<tag> _)
(do @
- [[instance-id instanceT] (&;with-type-env <instancer>)]
- (&;with-type (maybe;assume (type;apply (list instanceT) expectedT))
+ [[instance-id instanceT] (&.with-type-env <instancer>)]
+ (&.with-type (maybe.assume (type.apply (list instanceT) expectedT))
(analyse-product analyse membersC))))
- ([#;UnivQ tc;existential]
- [#;ExQ tc;var])
+ ([#.UnivQ tc.existential]
+ [#.ExQ tc.var])
- (#;Apply inputT funT)
+ (#.Apply inputT funT)
(case funT
- (#;Var funT-id)
+ (#.Var funT-id)
(do @
- [?funT' (&;with-type-env (tc;read funT-id))]
+ [?funT' (&.with-type-env (tc.read funT-id))]
(case ?funT'
- (#;Some funT')
- (&;with-type (#;Apply inputT funT')
+ (#.Some funT')
+ (&.with-type (#.Apply inputT funT')
(analyse-product analyse membersC))
_
- (&;throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n"
+ (&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n"
"Expression: " (%code (` [(~@ membersC)]))))))
_
- (case (type;apply (list inputT) funT)
- #;None
- (&;throw Not-Quantified-Type (%type funT))
+ (case (type.apply (list inputT) funT)
+ #.None
+ (&.throw Not-Quantified-Type (%type funT))
- (#;Some outputT)
- (&;with-type outputT
+ (#.Some outputT)
+ (&.with-type outputT
(analyse-product analyse membersC))))
_
- (&;throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n"
+ (&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n"
"Expression: " (%code (` [(~@ membersC)]))))
))))
(def: #export (analyse-tagged-sum analyse tag valueC)
- (-> &;Analyser Ident Code (Meta la;Analysis))
- (do macro;Monad<Meta>
- [tag (macro;normalize tag)
- [idx group variantT] (macro;resolve-tag tag)
- expectedT macro;expected-type]
+ (-> &.Analyser Ident Code (Meta la.Analysis))
+ (do macro.Monad<Meta>
+ [tag (macro.normalize tag)
+ [idx group variantT] (macro.resolve-tag tag)
+ expectedT macro.expected-type]
(case expectedT
- (#;Var _)
+ (#.Var _)
(do @
- [#let [case-size (list;size group)]
- inferenceT (&inference;variant idx case-size variantT)
- [inferredT valueA+] (&inference;general analyse inferenceT (list valueC))
- temp &scope;next-local]
- (wrap (la;sum idx case-size temp (|> valueA+ list;head maybe;assume))))
+ [#let [case-size (list.size group)]
+ inferenceT (&inference.variant idx case-size variantT)
+ [inferredT valueA+] (&inference.general analyse inferenceT (list valueC))
+ temp &scope.next-local]
+ (wrap (la.sum idx case-size temp (|> valueA+ list.head maybe.assume))))
_
(analyse-sum analyse idx valueC))))
@@ -259,17 +259,17 @@
## canonical form (with their corresponding module identified).
(def: #export (normalize record)
(-> (List [Code Code]) (Meta (List [Ident Code])))
- (monad;map macro;Monad<Meta>
+ (monad.map macro.Monad<Meta>
(function [[key val]]
(case key
- [_ (#;Tag key)]
- (do macro;Monad<Meta>
- [key (macro;normalize key)]
+ [_ (#.Tag key)]
+ (do macro.Monad<Meta>
+ [key (macro.normalize key)]
(wrap [key val]))
_
- (&;throw Record-Keys-Must-Be-Tags (format " Key: " (%code key) "\n"
- "Record: " (%code (code;record record))))))
+ (&.throw Record-Keys-Must-Be-Tags (format " Key: " (%code key) "\n"
+ "Record: " (%code (code.record record))))))
record))
## Lux already possesses the means to analyse tuples, so
@@ -279,56 +279,56 @@
(-> (List [Ident Code]) (Meta [(List Code) Type]))
(case record
## empty-record = empty-tuple = unit = []
- #;Nil
- (:: macro;Monad<Meta> wrap [(list) Unit])
-
- (#;Cons [head-k head-v] _)
- (do macro;Monad<Meta>
- [head-k (macro;normalize head-k)
- [_ tag-set recordT] (macro;resolve-tag head-k)
- #let [size-record (list;size record)
- size-ts (list;size tag-set)]
- _ (if (n.= size-ts size-record)
+ #.Nil
+ (:: macro.Monad<Meta> wrap [(list) Unit])
+
+ (#.Cons [head-k head-v] _)
+ (do macro.Monad<Meta>
+ [head-k (macro.normalize head-k)
+ [_ tag-set recordT] (macro.resolve-tag head-k)
+ #let [size-record (list.size record)
+ size-ts (list.size tag-set)]
+ _ (if (n/= size-ts size-record)
(wrap [])
- (&;throw Record-Size-Mismatch
+ (&.throw Record-Size-Mismatch
(format " Expected: " (|> size-ts nat-to-int %i) "\n"
" Actual: " (|> size-record nat-to-int %i) "\n"
" Type: " (%type recordT) "\n"
"Expression: " (%code (|> record
(list/map (function [[keyI valueC]]
- [(code;tag keyI) valueC]))
- code;record)))))
- #let [tuple-range (list;n.range +0 (n.dec size-ts))
- tag->idx (dict;from-list ident;Hash<Ident> (list;zip2 tag-set tuple-range))]
- idx->val (monad;fold @
+ [(code.tag keyI) valueC]))
+ code.record)))))
+ #let [tuple-range (list.n/range +0 (n/dec size-ts))
+ tag->idx (dict.from-list ident.Hash<Ident> (list.zip2 tag-set tuple-range))]
+ idx->val (monad.fold @
(function [[key val] idx->val]
(do @
- [key (macro;normalize key)]
- (case (dict;get key tag->idx)
- #;None
- (&;throw Tag-Does-Not-Belong-To-Record
- (format " Tag: " (%code (code;tag key)) "\n"
+ [key (macro.normalize key)]
+ (case (dict.get key tag->idx)
+ #.None
+ (&.throw Tag-Does-Not-Belong-To-Record
+ (format " Tag: " (%code (code.tag key)) "\n"
"Type: " (%type recordT)))
- (#;Some idx)
- (if (dict;contains? idx idx->val)
- (&;throw Cannot-Repeat-Tag
- (format " Tag: " (%code (code;tag key)) "\n"
- "Record: " (%code (code;record (list/map (function [[keyI valC]]
- [(code;tag keyI) valC])
+ (#.Some idx)
+ (if (dict.contains? idx idx->val)
+ (&.throw Cannot-Repeat-Tag
+ (format " Tag: " (%code (code.tag key)) "\n"
+ "Record: " (%code (code.record (list/map (function [[keyI valC]]
+ [(code.tag keyI) valC])
record)))))
- (wrap (dict;put idx val idx->val))))))
+ (wrap (dict.put idx val idx->val))))))
(: (Dict Nat Code)
- (dict;new number;Hash<Nat>))
+ (dict.new number.Hash<Nat>))
record)
- #let [ordered-tuple (list/map (function [idx] (maybe;assume (dict;get idx idx->val)))
+ #let [ordered-tuple (list/map (function [idx] (maybe.assume (dict.get idx idx->val)))
tuple-range)]]
(wrap [ordered-tuple recordT]))
))
(def: #export (analyse-record analyse members)
- (-> &;Analyser (List [Code Code]) (Meta la;Analysis))
- (do macro;Monad<Meta>
+ (-> &.Analyser (List [Code Code]) (Meta la.Analysis))
+ (do macro.Monad<Meta>
[members (normalize members)
[membersC recordT] (order members)]
(case membersC
@@ -337,13 +337,13 @@
_
(do @
- [expectedT macro;expected-type]
+ [expectedT macro.expected-type]
(case expectedT
- (#;Var _)
+ (#.Var _)
(do @
- [inferenceT (&inference;record recordT)
- [inferredT membersA] (&inference;general analyse inferenceT membersC)]
- (wrap (la;product membersA)))
+ [inferenceT (&inference.record recordT)
+ [inferredT membersA] (&inference.general analyse inferenceT membersC)]
+ (wrap (la.product membersA)))
_
(analyse-product analyse membersC))))))
diff --git a/new-luxc/source/luxc/lang/analysis/type.lux b/new-luxc/source/luxc/lang/analysis/type.lux
index f85608e19..c3296fd21 100644
--- a/new-luxc/source/luxc/lang/analysis/type.lux
+++ b/new-luxc/source/luxc/lang/analysis/type.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad)
[macro]
@@ -10,18 +10,18 @@
## means of evaluating Lux expressions at compile-time for the sake of
## computing Lux type values.
(def: #export (analyse-check analyse eval type value)
- (-> &;Analyser &;Eval Code Code (Meta Analysis))
- (do macro;Monad<Meta>
+ (-> &.Analyser &.Eval Code Code (Meta Analysis))
+ (do macro.Monad<Meta>
[actualT (eval Type type)
#let [actualT (:! Type actualT)]
- _ (&;infer actualT)]
- (&;with-type actualT
+ _ (&.infer actualT)]
+ (&.with-type actualT
(analyse value))))
(def: #export (analyse-coerce analyse eval type value)
- (-> &;Analyser &;Eval Code Code (Meta Analysis))
- (do macro;Monad<Meta>
+ (-> &.Analyser &.Eval Code Code (Meta Analysis))
+ (do macro.Monad<Meta>
[actualT (eval Type type)
- _ (&;infer (:! Type actualT))]
- (&;with-type Top
+ _ (&.infer (:! Type actualT))]
+ (&.with-type Top
(analyse value))))
diff --git a/new-luxc/source/luxc/lang/eval.lux b/new-luxc/source/luxc/lang/eval.lux
index e691ec7a1..62d6a438b 100644
--- a/new-luxc/source/luxc/lang/eval.lux
+++ b/new-luxc/source/luxc/lang/eval.lux
@@ -1,18 +1,18 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do])
[macro])
(luxc ["&" lang]
- (lang (analysis [";A" expression])
- (synthesis [";S" expression])
- (translation [";T" expression]
- [";T" eval]))))
+ (lang (analysis [".A" expression])
+ (synthesis [".S" expression])
+ (translation [".T" expression]
+ [".T" eval]))))
(def: #export (eval type exprC)
- &;Eval
- (do macro;Monad<Meta>
- [exprA (&;with-type type
- (expressionA;analyser eval exprC))
- #let [exprS (expressionS;synthesize exprA)]
- exprI (expressionT;translate exprS)]
- (evalT;eval exprI)))
+ &.Eval
+ (do macro.Monad<Meta>
+ [exprA (&.with-type type
+ (expressionA.analyser eval exprC))
+ #let [exprS (expressionS.synthesize exprA)]
+ exprI (expressionT.translate exprS)]
+ (evalT.eval exprI)))
diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux
index 9f8fcd069..c980eab9d 100644
--- a/new-luxc/source/luxc/lang/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/host.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
@@ -13,172 +13,172 @@
[host #+ do-to object]
[io])
(luxc ["&" lang]
- (lang [";L" variable #+ Register]
- (translation [";T" common]))))
+ (lang [".L" variable #+ Register]
+ (translation [".T" common]))))
-(host;import org.objectweb.asm.Label)
+(host.import org/objectweb/asm/Label)
-(host;import java.lang.reflect.AccessibleObject
+(host.import java/lang/reflect/AccessibleObject
(setAccessible [boolean] void))
-(host;import java.lang.reflect.Method
+(host.import java/lang/reflect/Method
(invoke [Object (Array Object)] #try Object))
-(host;import (java.lang.Class a)
+(host.import (java/lang/Class a)
(getDeclaredMethod [String (Array (Class Object))] #try Method))
-(host;import java.lang.Object
+(host.import java/lang/Object
(getClass [] (Class Object)))
-(host;import java.lang.Integer
+(host.import java/lang/Integer
(#static TYPE (Class Integer)))
-(host;import java.lang.ClassLoader)
+(host.import java/lang/ClassLoader)
(def: ClassLoader::defineClass
Method
- (case (Class.getDeclaredMethod ["defineClass"
- (|> (host;array (Class Object) +4)
- (host;array-write +0 (:! (Class Object) (host;class-for String)))
- (host;array-write +1 (Object.getClass [] (host;array byte +0)))
- (host;array-write +2 (:! (Class Object) Integer.TYPE))
- (host;array-write +3 (:! (Class Object) Integer.TYPE)))]
- (host;class-for java.lang.ClassLoader))
- (#e;Success method)
+ (case (Class::getDeclaredMethod ["defineClass"
+ (|> (host.array (Class Object) +4)
+ (host.array-write +0 (:! (Class Object) (host.class-for String)))
+ (host.array-write +1 (Object::getClass [] (host.array byte +0)))
+ (host.array-write +2 (:! (Class Object) Integer::TYPE))
+ (host.array-write +3 (:! (Class Object) Integer::TYPE)))]
+ (host.class-for java/lang/ClassLoader))
+ (#e.Success method)
(do-to method
- (AccessibleObject.setAccessible [true]))
+ (AccessibleObject::setAccessible [true]))
- (#e;Error error)
+ (#e.Error error)
(error! error)))
(def: (define-class class-name byte-code loader)
- (-> Text commonT;Bytecode ClassLoader (e;Error Object))
- (Method.invoke [loader
- (array;from-list (list (:! Object class-name)
- (:! Object byte-code)
- (:! Object (host;l2i 0))
- (:! Object (host;l2i (nat-to-int (host;array-length byte-code))))))]
- ClassLoader::defineClass))
+ (-> Text commonT.Bytecode ClassLoader (e.Error Object))
+ (Method::invoke [loader
+ (array.from-list (list (:! Object class-name)
+ (:! Object byte-code)
+ (:! Object (host.l2i 0))
+ (:! Object (host.l2i (nat-to-int (host.array-length byte-code))))))]
+ ClassLoader::defineClass))
(def: (fetch-byte-code class-name store)
- (-> Text commonT;Class-Store (Maybe commonT;Bytecode))
- (|> store atom;read io;run (dict;get class-name)))
+ (-> Text commonT.Class-Store (Maybe commonT.Bytecode))
+ (|> store atom.read io.run (dict.get class-name)))
(def: (memory-class-loader store)
- (-> commonT;Class-Store ClassLoader)
+ (-> commonT.Class-Store ClassLoader)
(object [] ClassLoader []
[]
(ClassLoader (findClass [class-name String]) Class
(case (fetch-byte-code class-name store)
- (#;Some bytecode)
+ (#.Some bytecode)
(case (define-class class-name bytecode (:! ClassLoader _jvm_this))
- (#e;Success class)
+ (#e.Success class)
(:!! class)
- (#e;Error error)
+ (#e.Error error)
(error! (format "Class definition error: " class-name "\n"
error)))
- #;None
+ #.None
(error! (format "Class not found: " class-name))))))
(def: #export init-host
- (io;IO commonT;Host)
- (io;io (let [store (: commonT;Class-Store
- (atom (dict;new text;Hash<Text>)))]
- {#commonT;loader (memory-class-loader store)
- #commonT;store store
- #commonT;artifacts (dict;new text;Hash<Text>)
- #commonT;context ["" +0]
- #commonT;anchor #;None})))
+ (io.IO commonT.Host)
+ (io.io (let [store (: commonT.Class-Store
+ (atom (dict.new text.Hash<Text>)))]
+ {#commonT.loader (memory-class-loader store)
+ #commonT.store store
+ #commonT.artifacts (dict.new text.Hash<Text>)
+ #commonT.context ["" +0]
+ #commonT.anchor #.None})))
(def: #export (with-anchor anchor expr)
(All [a] (-> [Label Register] (Meta a) (Meta a)))
- (;function [compiler]
- (let [old (:! commonT;Host (get@ #;host compiler))]
- (case (expr (set@ #;host
- (:! Void (set@ #commonT;anchor (#;Some anchor) old))
+ (.function [compiler]
+ (let [old (:! commonT.Host (get@ #.host compiler))]
+ (case (expr (set@ #.host
+ (:! Void (set@ #commonT.anchor (#.Some anchor) old))
compiler))
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;host
- (|>. (:! commonT;Host)
- (set@ #commonT;anchor (get@ #commonT;anchor old))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! commonT.Host)
+ (set@ #commonT.anchor (get@ #commonT.anchor old))
(:! Void))
compiler')
output])
- (#e;Error error)
- (#e;Error error)))))
+ (#e.Error error)
+ (#e.Error error)))))
(exception: #export No-Anchor)
(def: #export anchor
(Meta [Label Register])
- (;function [compiler]
- (case (|> compiler (get@ #;host) (:! commonT;Host) (get@ #commonT;anchor))
- (#;Some anchor)
- (#e;Success [compiler
+ (.function [compiler]
+ (case (|> compiler (get@ #.host) (:! commonT.Host) (get@ #commonT.anchor))
+ (#.Some anchor)
+ (#e.Success [compiler
anchor])
- #;None
- ((&;throw No-Anchor "") compiler))))
+ #.None
+ ((&.throw No-Anchor "") compiler))))
(def: #export (with-context name expr)
(All [a] (-> Text (Meta a) (Meta a)))
- (;function [compiler]
- (let [old (:! commonT;Host (get@ #;host compiler))]
- (case (expr (set@ #;host
- (:! Void (set@ #commonT;context [(&;normalize-name name) +0] old))
+ (.function [compiler]
+ (let [old (:! commonT.Host (get@ #.host compiler))]
+ (case (expr (set@ #.host
+ (:! Void (set@ #commonT.context [(&.normalize-name name) +0] old))
compiler))
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;host
- (|>. (:! commonT;Host)
- (set@ #commonT;context (get@ #commonT;context old))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! commonT.Host)
+ (set@ #commonT.context (get@ #commonT.context old))
(:! Void))
compiler')
output])
- (#e;Error error)
- (#e;Error error)))))
+ (#e.Error error)
+ (#e.Error error)))))
(def: #export (with-sub-context expr)
(All [a] (-> (Meta a) (Meta [Text a])))
- (;function [compiler]
- (let [old (:! commonT;Host (get@ #;host compiler))
- [old-name old-sub] (get@ #commonT;context old)
+ (.function [compiler]
+ (let [old (:! commonT.Host (get@ #.host compiler))
+ [old-name old-sub] (get@ #commonT.context old)
new-name (format old-name "$" (%i (nat-to-int old-sub)))]
- (case (expr (set@ #;host
- (:! Void (set@ #commonT;context [new-name +0] old))
+ (case (expr (set@ #.host
+ (:! Void (set@ #commonT.context [new-name +0] old))
compiler))
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;host
- (|>. (:! commonT;Host)
- (set@ #commonT;context [old-name (n.inc old-sub)])
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! commonT.Host)
+ (set@ #commonT.context [old-name (n/inc old-sub)])
(:! Void))
compiler')
[new-name output]])
- (#e;Error error)
- (#e;Error error)))))
+ (#e.Error error)
+ (#e.Error error)))))
(def: #export context
(Meta Text)
- (;function [compiler]
- (#e;Success [compiler
- (|> (get@ #;host compiler)
- (:! commonT;Host)
- (get@ #commonT;context)
+ (.function [compiler]
+ (#e.Success [compiler
+ (|> (get@ #.host compiler)
+ (:! commonT.Host)
+ (get@ #commonT.context)
(let> [name sub]
name))])))
(def: #export class-loader
(Meta ClassLoader)
(function [compiler]
- (#e;Success [compiler
+ (#e.Success [compiler
(|> compiler
- (get@ #;host)
- (:! commonT;Host)
- (get@ #commonT;loader))])))
+ (get@ #.host)
+ (:! commonT.Host)
+ (get@ #commonT.loader))])))
(def: #export runtime-class Text "LuxRuntime")
(def: #export function-class Text "LuxFunction")
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
index f96b3e646..cfe71656c 100644
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
[lux #- Type Def]
(lux (control monad
["p" parser])
@@ -9,11 +9,11 @@
[host]))
## [Host]
-(host;import org.objectweb.asm.MethodVisitor)
+(host.import org/objectweb/asm/MethodVisitor)
-(host;import org.objectweb.asm.ClassWriter)
+(host.import org/objectweb/asm/ClassWriter)
-(host;import #long org.objectweb.asm.Label
+(host.import #long org/objectweb/asm/Label
(new []))
## [Type]
@@ -59,7 +59,7 @@
(-> MethodVisitor MethodVisitor))
(type: #export Label
- org.objectweb.asm.Label)
+ org/objectweb/asm/Label)
(type: #export Register Nat)
@@ -70,45 +70,45 @@
#Default)
(type: #export Version
- #V1.1
- #V1.2
- #V1.3
- #V1.4
- #V1.5
- #V1.6
- #V1.7
- #V1.8)
+ #V1_1
+ #V1_2
+ #V1_3
+ #V1_4
+ #V1_5
+ #V1_6
+ #V1_7
+ #V1_8)
## [Values]
-(syntax: (config: [type s;local-symbol]
- [none s;local-symbol]
- [++ s;local-symbol]
- [options (s;tuple (p;many s;local-symbol))])
- (let [g!type (code;local-symbol type)
- g!none (code;local-symbol none)
- g!tags+ (list/map code;local-tag options)
- g!_left (code;local-symbol "_left")
- g!_right (code;local-symbol "_right")
+(syntax: (config: [type s.local-symbol]
+ [none s.local-symbol]
+ [++ s.local-symbol]
+ [options (s.tuple (p.many s.local-symbol))])
+ (let [g!type (code.local-symbol type)
+ g!none (code.local-symbol none)
+ g!tags+ (list/map code.local-tag options)
+ g!_left (code.local-symbol "_left")
+ g!_right (code.local-symbol "_right")
g!options+ (list/map (function [option]
- (` (def: (~' #export) (~ (code;local-symbol option))
+ (` (def: (~' #export) (~ (code.local-symbol option))
(~ g!type)
(|> (~ g!none)
- (set@ (~ (code;local-tag option)) true)))))
+ (set@ (~ (code.local-tag option)) true)))))
options)]
(wrap (list& (` (type: (~' #export) (~ g!type)
- (~ (code;record (list/map (function [tag]
- [tag (` ;Bool)])
+ (~ (code.record (list/map (function [tag]
+ [tag (` .Bool)])
g!tags+)))))
(` (def: (~' #export) (~ g!none)
(~ g!type)
- (~ (code;record (list/map (function [tag]
+ (~ (code.record (list/map (function [tag]
[tag (` false)])
g!tags+)))))
- (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ g!_left) (~ g!_right))
+ (` (def: (~' #export) ((~ (code.local-symbol ++)) (~ g!_left) (~ g!_right))
(-> (~ g!type) (~ g!type) (~ g!type))
- (~ (code;record (list/map (function [tag]
+ (~ (code.record (list/map (function [tag]
[tag (` (or (get@ (~ tag) (~ g!_left))
(get@ (~ tag) (~ g!_right))))])
g!tags+)))))
@@ -123,7 +123,7 @@
## Labels
(def: #export new-label
(-> Unit Label)
- org.objectweb.asm.Label.new)
+ org/objectweb/asm/Label::new)
(def: #export (simple-class name)
(-> Text Class)
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index ec1de6b43..8e90172d5 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -1,19 +1,20 @@
-(;module:
+(.module:
lux
(lux (data [text]
text/format
[product]
(coll ["a" array]
[list "list/" Functor<List>]))
- [host #+ do-to])
+ [host #+ do-to]
+ [function])
["$" //]
(// ["$t" type]))
## [Host]
-(host;import #long java.lang.Object)
-(host;import #long java.lang.String)
+(host.import #long java/lang/Object)
+(host.import #long java/lang/String)
-(host;import org.objectweb.asm.Opcodes
+(host.import org/objectweb/asm/Opcodes
(#static ACC_PUBLIC int)
(#static ACC_PROTECTED int)
(#static ACC_PRIVATE int)
@@ -40,15 +41,15 @@
(#static V1_8 int)
)
-(host;import org.objectweb.asm.FieldVisitor
+(host.import org/objectweb/asm/FieldVisitor
(visitEnd [] void))
-(host;import org.objectweb.asm.MethodVisitor
+(host.import org/objectweb/asm/MethodVisitor
(visitCode [] void)
(visitMaxs [int int] void)
(visitEnd [] void))
-(host;import org.objectweb.asm.ClassWriter
+(host.import org/objectweb/asm/ClassWriter
(#static COMPUTE_MAXS int)
(#static COMPUTE_FRAMES int)
(new [int])
@@ -61,228 +62,228 @@
## [Defs]
(def: (string-array values)
(-> (List Text) (Array Text))
- (let [output (host;array String (list;size values))]
+ (let [output (host.array String (list.size values))]
(exec (list/map (function [[idx value]]
- (host;array-write idx value output))
- (list;enumerate values))
+ (host.array-write idx value output))
+ (list.enumerate values))
output)))
(def: exceptions-array
- (-> $;Method (Array Text))
- (|>. (get@ #$;exceptions)
- (list/map (|>. #$;Generic $t;descriptor))
+ (-> $.Method (Array Text))
+ (|>> (get@ #$.exceptions)
+ (list/map (|>> #$.Generic $t.descriptor))
string-array))
(def: (version-flag version)
- (-> $;Version Int)
+ (-> $.Version Int)
(case version
- #$;V1.1 Opcodes.V1_1
- #$;V1.2 Opcodes.V1_2
- #$;V1.3 Opcodes.V1_3
- #$;V1.4 Opcodes.V1_4
- #$;V1.5 Opcodes.V1_5
- #$;V1.6 Opcodes.V1_6
- #$;V1.7 Opcodes.V1_7
- #$;V1.8 Opcodes.V1_8))
+ #$.V1_1 Opcodes::V1_1
+ #$.V1_2 Opcodes::V1_2
+ #$.V1_3 Opcodes::V1_3
+ #$.V1_4 Opcodes::V1_4
+ #$.V1_5 Opcodes::V1_5
+ #$.V1_6 Opcodes::V1_6
+ #$.V1_7 Opcodes::V1_7
+ #$.V1_8 Opcodes::V1_8))
(def: (visibility-flag visibility)
- (-> $;Visibility Int)
+ (-> $.Visibility Int)
(case visibility
- #$;Public Opcodes.ACC_PUBLIC
- #$;Protected Opcodes.ACC_PROTECTED
- #$;Private Opcodes.ACC_PRIVATE
- #$;Default 0))
+ #$.Public Opcodes::ACC_PUBLIC
+ #$.Protected Opcodes::ACC_PROTECTED
+ #$.Private Opcodes::ACC_PRIVATE
+ #$.Default 0))
(def: (class-flags config)
- (-> $;Class-Config Int)
- ($_ i.+
- (if (get@ #$;finalC config) Opcodes.ACC_FINAL 0)))
+ (-> $.Class-Config Int)
+ ($_ i/+
+ (if (get@ #$.finalC config) Opcodes::ACC_FINAL 0)))
(def: (method-flags config)
- (-> $;Method-Config Int)
- ($_ i.+
- (if (get@ #$;staticM config) Opcodes.ACC_STATIC 0)
- (if (get@ #$;finalM config) Opcodes.ACC_FINAL 0)
- (if (get@ #$;synchronizedM config) Opcodes.ACC_SYNCHRONIZED 0)
- (if (get@ #$;strictM config) Opcodes.ACC_STRICT 0)))
+ (-> $.Method-Config Int)
+ ($_ i/+
+ (if (get@ #$.staticM config) Opcodes::ACC_STATIC 0)
+ (if (get@ #$.finalM config) Opcodes::ACC_FINAL 0)
+ (if (get@ #$.synchronizedM config) Opcodes::ACC_SYNCHRONIZED 0)
+ (if (get@ #$.strictM config) Opcodes::ACC_STRICT 0)))
(def: (field-flags config)
- (-> $;Field-Config Int)
- ($_ i.+
- (if (get@ #$;staticF config) Opcodes.ACC_STATIC 0)
- (if (get@ #$;finalF config) Opcodes.ACC_FINAL 0)
- (if (get@ #$;transientF config) Opcodes.ACC_TRANSIENT 0)
- (if (get@ #$;volatileF config) Opcodes.ACC_VOLATILE 0)))
+ (-> $.Field-Config Int)
+ ($_ i/+
+ (if (get@ #$.staticF config) Opcodes::ACC_STATIC 0)
+ (if (get@ #$.finalF config) Opcodes::ACC_FINAL 0)
+ (if (get@ #$.transientF config) Opcodes::ACC_TRANSIENT 0)
+ (if (get@ #$.volatileF config) Opcodes::ACC_VOLATILE 0)))
(def: class-to-type
- (-> $;Class $;Type)
- (|>. #$;Class #$;Generic))
+ (-> $.Class $.Type)
+ (|>> #$.Class #$.Generic))
(def: param-signature
- (-> $;Class Text)
- (|>. class-to-type $t;signature (format ":")))
+ (-> $.Class Text)
+ (|>> class-to-type $t.signature (format ":")))
(def: (formal-param [name super interfaces])
- (-> $;Parameter Text)
+ (-> $.Parameter Text)
(format name
(param-signature super)
(|> interfaces
(list/map param-signature)
- (text;join-with ""))))
+ (text.join-with ""))))
(def: (parameters-signature parameters super interfaces)
- (-> (List $;Parameter) $;Class (List $;Class)
+ (-> (List $.Parameter) $.Class (List $.Class)
Text)
- (let [formal-params (if (list;empty? parameters)
+ (let [formal-params (if (list.empty? parameters)
""
(format "<"
(|> parameters
(list/map formal-param)
- (text;join-with ""))
+ (text.join-with ""))
">"))]
(format formal-params
- (|> super class-to-type $t;signature)
+ (|> super class-to-type $t.signature)
(|> interfaces
- (list/map (|>. class-to-type $t;signature))
- (text;join-with "")))))
+ (list/map (|>> class-to-type $t.signature))
+ (text.join-with "")))))
(def: class-computes
Int
- ($_ i.+
- ClassWriter.COMPUTE_MAXS
- ## ClassWriter.COMPUTE_FRAMES
+ ($_ i/+
+ ClassWriter::COMPUTE_MAXS
+ ## ClassWriter::COMPUTE_FRAMES
))
(do-template [<name> <flag>]
[(def: #export (<name> version visibility config name parameters super interfaces
definitions)
- (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def
- (host;type (Array byte)))
- (let [writer (|> (do-to (ClassWriter.new class-computes)
- (ClassWriter.visit [(version-flag version)
- ($_ i.+
- Opcodes.ACC_SUPER
- <flag>
- (visibility-flag visibility)
- (class-flags config))
- ($t;binary-name name)
- (parameters-signature parameters super interfaces)
- (|> super product;left $t;binary-name)
- (|> interfaces
- (list/map (|>. product;left $t;binary-name))
- string-array)]))
+ (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) $.Class (List $.Class) $.Def
+ (host.type (Array byte)))
+ (let [writer (|> (do-to (ClassWriter::new class-computes)
+ (ClassWriter::visit [(version-flag version)
+ ($_ i/+
+ Opcodes::ACC_SUPER
+ <flag>
+ (visibility-flag visibility)
+ (class-flags config))
+ ($t.binary-name name)
+ (parameters-signature parameters super interfaces)
+ (|> super product.left $t.binary-name)
+ (|> interfaces
+ (list/map (|>> product.left $t.binary-name))
+ string-array)]))
definitions)
- _ (ClassWriter.visitEnd [] writer)]
- (ClassWriter.toByteArray [] writer)))]
+ _ (ClassWriter::visitEnd [] writer)]
+ (ClassWriter::toByteArray [] writer)))]
[class 0]
- [abstract Opcodes.ACC_ABSTRACT]
+ [abstract Opcodes::ACC_ABSTRACT]
)
-(def: $Object $;Class ["java.lang.Object" (list)])
+(def: $Object $.Class ["java.lang.Object" (list)])
(def: #export (interface version visibility config name parameters interfaces
definitions)
- (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def
- (host;type (Array byte)))
- (let [writer (|> (do-to (ClassWriter.new class-computes)
- (ClassWriter.visit [(version-flag version)
- ($_ i.+
- Opcodes.ACC_SUPER
- Opcodes.ACC_INTERFACE
- (visibility-flag visibility)
- (class-flags config))
- ($t;binary-name name)
- (parameters-signature parameters $Object interfaces)
- (|> $Object product;left $t;binary-name)
- (|> interfaces
- (list/map (|>. product;left $t;binary-name))
- string-array)]))
+ (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) (List $.Class) $.Def
+ (host.type (Array byte)))
+ (let [writer (|> (do-to (ClassWriter::new class-computes)
+ (ClassWriter::visit [(version-flag version)
+ ($_ i/+
+ Opcodes::ACC_SUPER
+ Opcodes::ACC_INTERFACE
+ (visibility-flag visibility)
+ (class-flags config))
+ ($t.binary-name name)
+ (parameters-signature parameters $Object interfaces)
+ (|> $Object product.left $t.binary-name)
+ (|> interfaces
+ (list/map (|>> product.left $t.binary-name))
+ string-array)]))
definitions)
- _ (ClassWriter.visitEnd [] writer)]
- (ClassWriter.toByteArray [] writer)))
+ _ (ClassWriter::visitEnd [] writer)]
+ (ClassWriter::toByteArray [] writer)))
(def: #export (method visibility config name type then)
- (-> $;Visibility $;Method-Config Text $;Method $;Inst
- $;Def)
+ (-> $.Visibility $.Method-Config Text $.Method $.Inst
+ $.Def)
(function [writer]
- (let [=method (ClassWriter.visitMethod [($_ i.+
- (visibility-flag visibility)
- (method-flags config))
- ($t;binary-name name)
- ($t;method-descriptor type)
- ($t;method-signature type)
- (exceptions-array type)]
- writer)
- _ (MethodVisitor.visitCode [] =method)
+ (let [=method (ClassWriter::visitMethod [($_ i/+
+ (visibility-flag visibility)
+ (method-flags config))
+ ($t.binary-name name)
+ ($t.method-descriptor type)
+ ($t.method-signature type)
+ (exceptions-array type)]
+ writer)
+ _ (MethodVisitor::visitCode [] =method)
_ (then =method)
- _ (MethodVisitor.visitMaxs [0 0] =method)
- _ (MethodVisitor.visitEnd [] =method)]
+ _ (MethodVisitor::visitMaxs [0 0] =method)
+ _ (MethodVisitor::visitEnd [] =method)]
writer)))
(def: #export (abstract-method visibility config name type)
- (-> $;Visibility $;Method-Config Text $;Method
- $;Def)
+ (-> $.Visibility $.Method-Config Text $.Method
+ $.Def)
(function [writer]
- (let [=method (ClassWriter.visitMethod [($_ i.+
- (visibility-flag visibility)
- (method-flags config)
- Opcodes.ACC_ABSTRACT)
- ($t;binary-name name)
- ($t;method-descriptor type)
- ($t;method-signature type)
- (exceptions-array type)]
- writer)
- _ (MethodVisitor.visitEnd [] =method)]
+ (let [=method (ClassWriter::visitMethod [($_ i/+
+ (visibility-flag visibility)
+ (method-flags config)
+ Opcodes::ACC_ABSTRACT)
+ ($t.binary-name name)
+ ($t.method-descriptor type)
+ ($t.method-signature type)
+ (exceptions-array type)]
+ writer)
+ _ (MethodVisitor::visitEnd [] =method)]
writer)))
(def: #export (field visibility config name type)
- (-> $;Visibility $;Field-Config Text $;Type $;Def)
+ (-> $.Visibility $.Field-Config Text $.Type $.Def)
(function [writer]
- (let [=field (do-to (ClassWriter.visitField [($_ i.+
- (visibility-flag visibility)
- (field-flags config))
- ($t;binary-name name)
- ($t;descriptor type)
- ($t;signature type)
- (host;null)] writer)
- (FieldVisitor.visitEnd []))]
+ (let [=field (do-to (ClassWriter::visitField [($_ i/+
+ (visibility-flag visibility)
+ (field-flags config))
+ ($t.binary-name name)
+ ($t.descriptor type)
+ ($t.signature type)
+ (host.null)] writer)
+ (FieldVisitor::visitEnd []))]
writer)))
(do-template [<name> <lux-type> <jvm-type> <prepare>]
[(def: #export (<name> visibility config name value)
- (-> $;Visibility $;Field-Config Text <lux-type> $;Def)
+ (-> $.Visibility $.Field-Config Text <lux-type> $.Def)
(function [writer]
- (let [=field (do-to (ClassWriter.visitField [($_ i.+
- (visibility-flag visibility)
- (field-flags config))
- ($t;binary-name name)
- ($t;descriptor <jvm-type>)
- ($t;signature <jvm-type>)
- (<prepare> value)]
- writer)
- (FieldVisitor.visitEnd []))]
+ (let [=field (do-to (ClassWriter::visitField [($_ i/+
+ (visibility-flag visibility)
+ (field-flags config))
+ ($t.binary-name name)
+ ($t.descriptor <jvm-type>)
+ ($t.signature <jvm-type>)
+ (<prepare> value)]
+ writer)
+ (FieldVisitor::visitEnd []))]
writer)))]
- [boolean-field Bool $t;boolean id]
- [byte-field Int $t;byte host;l2b]
- [short-field Int $t;short host;l2s]
- [int-field Int $t;int host;l2i]
- [long-field Int $t;long id]
- [float-field Frac $t;float host;d2f]
- [double-field Frac $t;double id]
- [char-field Nat $t;char (|>. nat-to-int host;l2i host;i2c)]
- [string-field Text ($t;class "java.lang.String" (list)) id]
+ [boolean-field Bool $t.boolean id]
+ [byte-field Int $t.byte host.l2b]
+ [short-field Int $t.short host.l2s]
+ [int-field Int $t.int host.l2i]
+ [long-field Int $t.long id]
+ [float-field Frac $t.float host.d2f]
+ [double-field Frac $t.double id]
+ [char-field Nat $t.char (|>> nat-to-int host.l2i host.i2c)]
+ [string-field Text ($t.class "java.lang.String" (list)) id]
)
(def: #export (fuse defs)
- (-> (List $;Def) $;Def)
+ (-> (List $.Def) $.Def)
(case defs
- #;Nil
+ #.Nil
id
- (#;Cons singleton #;Nil)
+ (#.Cons singleton #.Nil)
singleton
- (#;Cons head tail)
- (. (fuse tail) head)))
+ (#.Cons head tail)
+ (function.compose (fuse tail) head)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index e0c10feca..5f3711bbd 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -1,28 +1,29 @@
-(;module:
+(.module:
[lux #- char]
(lux (control monad
["p" parser])
(data [maybe]
["e" error]
text/format
- (coll [list "L/" Functor<List>]))
+ (coll [list "list/" Functor<List>]))
[host #+ do-to]
[macro]
(macro [code]
- ["s" syntax #+ syntax:]))
+ ["s" syntax #+ syntax:])
+ [function])
["$" //]
(// ["$t" type]))
## [Host]
-(host;import #long java.lang.Object)
-(host;import #long java.lang.String)
+(host.import #long java/lang/Object)
+(host.import #long java/lang/String)
-(syntax: (declare [codes (p;many s;local-symbol)])
+(syntax: (declare [codes (p.many s.local-symbol)])
(|> codes
- (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
+ (list/map (function [code] (` ((~' #static) (~ (code.local-symbol code)) (~' int)))))
wrap))
-(`` (host;import org.objectweb.asm.Opcodes
+(`` (host.import org/objectweb/asm/Opcodes
(#static NOP int)
## Conversion
@@ -89,13 +90,10 @@
(~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN))
))
-(host;import org.objectweb.asm.FieldVisitor
- (visitEnd [] void))
-
-(host;import org.objectweb.asm.Label
+(host.import org/objectweb/asm/Label
(new []))
-(host;import org.objectweb.asm.MethodVisitor
+(host.import org/objectweb/asm/MethodVisitor
(visitCode [] void)
(visitMaxs [int int] void)
(visitEnd [] void)
@@ -116,42 +114,42 @@
(def: #export make-label
(Meta Label)
(function [compiler]
- (#e;Success [compiler (Label.new [])])))
+ (#e.Success [compiler (Label::new [])])))
(def: #export (with-label action)
- (-> (-> Label $;Inst) $;Inst)
- (action (Label.new [])))
+ (-> (-> Label $.Inst) $.Inst)
+ (action (Label::new [])))
(do-template [<name> <type> <prepare>]
[(def: #export (<name> value)
- (-> <type> $;Inst)
+ (-> <type> $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitLdcInsn [(<prepare> value)]))))]
+ (MethodVisitor::visitLdcInsn [(<prepare> value)]))))]
[boolean Bool id]
- [int Int host;l2i]
+ [int Int host.l2i]
[long Int id]
[double Frac id]
- [char Nat (|>. nat-to-int host;l2i host;i2c)]
+ [char Nat (|>> nat-to-int host.l2i host.i2c)]
[string Text id]
)
-(syntax: (prefix [base s;local-symbol])
- (wrap (list (code;local-symbol (format "Opcodes." base)))))
+(syntax: (prefix [base s.local-symbol])
+ (wrap (list (code.local-symbol (format "Opcodes::" base)))))
(def: #export NULL
- $;Inst
+ $.Inst
(function [visitor]
(do-to visitor
- (MethodVisitor.visitInsn [(prefix ACONST_NULL)]))))
+ (MethodVisitor::visitInsn [(prefix ACONST_NULL)]))))
(do-template [<name>]
[(def: #export <name>
- $;Inst
+ $.Inst
(function [visitor]
(do-to visitor
- (MethodVisitor.visitInsn [(prefix <name>)]))))]
+ (MethodVisitor::visitInsn [(prefix <name>)]))))]
[NOP]
@@ -209,10 +207,10 @@
(do-template [<name>]
[(def: #export (<name> register)
- (-> Nat $;Inst)
+ (-> Nat $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
+ (MethodVisitor::visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
[ILOAD] [LLOAD] [DLOAD] [ALOAD]
[ISTORE] [LSTORE] [ASTORE]
@@ -220,64 +218,64 @@
(do-template [<name> <inst>]
[(def: #export (<name> class field type)
- (-> Text Text $;Type $;Inst)
+ (-> Text Text $.Type $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitFieldInsn [<inst> ($t;binary-name class) field ($t;descriptor type)]))))]
+ (MethodVisitor::visitFieldInsn [<inst> ($t.binary-name class) field ($t.descriptor type)]))))]
- [GETSTATIC Opcodes.GETSTATIC]
- [PUTSTATIC Opcodes.PUTSTATIC]
+ [GETSTATIC Opcodes::GETSTATIC]
+ [PUTSTATIC Opcodes::PUTSTATIC]
- [PUTFIELD Opcodes.PUTFIELD]
- [GETFIELD Opcodes.GETFIELD]
+ [PUTFIELD Opcodes::PUTFIELD]
+ [GETFIELD Opcodes::GETFIELD]
)
(do-template [<name> <inst>]
[(def: #export (<name> class)
- (-> Text $;Inst)
+ (-> Text $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitTypeInsn [<inst> ($t;binary-name class)]))))]
+ (MethodVisitor::visitTypeInsn [<inst> ($t.binary-name class)]))))]
- [CHECKCAST Opcodes.CHECKCAST]
- [NEW Opcodes.NEW]
- [INSTANCEOF Opcodes.INSTANCEOF]
- [ANEWARRAY Opcodes.ANEWARRAY]
+ [CHECKCAST Opcodes::CHECKCAST]
+ [NEW Opcodes::NEW]
+ [INSTANCEOF Opcodes::INSTANCEOF]
+ [ANEWARRAY Opcodes::ANEWARRAY]
)
(def: #export (NEWARRAY type)
- (-> $;Primitive $;Inst)
+ (-> $.Primitive $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitIntInsn [Opcodes.NEWARRAY (case type
- #$;Boolean Opcodes.T_BOOLEAN
- #$;Byte Opcodes.T_BYTE
- #$;Short Opcodes.T_SHORT
- #$;Int Opcodes.T_INT
- #$;Long Opcodes.T_LONG
- #$;Float Opcodes.T_FLOAT
- #$;Double Opcodes.T_DOUBLE
- #$;Char Opcodes.T_CHAR)]))))
+ (MethodVisitor::visitIntInsn [Opcodes::NEWARRAY (case type
+ #$.Boolean Opcodes::T_BOOLEAN
+ #$.Byte Opcodes::T_BYTE
+ #$.Short Opcodes::T_SHORT
+ #$.Int Opcodes::T_INT
+ #$.Long Opcodes::T_LONG
+ #$.Float Opcodes::T_FLOAT
+ #$.Double Opcodes::T_DOUBLE
+ #$.Char Opcodes::T_CHAR)]))))
(do-template [<name> <inst>]
[(def: #export (<name> class method-name method-signature interface?)
- (-> Text Text $;Method Bool $;Inst)
+ (-> Text Text $.Method Bool $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitMethodInsn [<inst> ($t;binary-name class) method-name ($t;method-descriptor method-signature) interface?]))))]
+ (MethodVisitor::visitMethodInsn [<inst> ($t.binary-name class) method-name ($t.method-descriptor method-signature) interface?]))))]
- [INVOKESTATIC Opcodes.INVOKESTATIC]
- [INVOKEVIRTUAL Opcodes.INVOKEVIRTUAL]
- [INVOKESPECIAL Opcodes.INVOKESPECIAL]
- [INVOKEINTERFACE Opcodes.INVOKEINTERFACE]
+ [INVOKESTATIC Opcodes::INVOKESTATIC]
+ [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL]
+ [INVOKESPECIAL Opcodes::INVOKESPECIAL]
+ [INVOKEINTERFACE Opcodes::INVOKEINTERFACE]
)
(do-template [<name>]
[(def: #export (<name> @where)
- (-> $;Label $;Inst)
+ (-> $.Label $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
+ (MethodVisitor::visitJumpInsn [(prefix <name>) @where]))))]
[IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL]
[IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
@@ -285,99 +283,99 @@
)
(def: #export (TABLESWITCH min max default labels)
- (-> Int Int $;Label (List $;Label) $;Inst)
+ (-> Int Int $.Label (List $.Label) $.Inst)
(function [visitor]
- (let [num-labels (list;size labels)
- labels-array (host;array Label num-labels)
+ (let [num-labels (list.size labels)
+ labels-array (host.array Label num-labels)
_ (loop [idx +0]
- (if (n.< num-labels idx)
- (exec (host;array-write idx
- (maybe;assume (list;nth idx labels))
+ (if (n/< num-labels idx)
+ (exec (host.array-write idx
+ (maybe.assume (list.nth idx labels))
labels-array)
- (recur (n.inc idx)))
+ (recur (n/inc idx)))
[]))]
(do-to visitor
- (MethodVisitor.visitTableSwitchInsn [min max default labels-array])))))
+ (MethodVisitor::visitTableSwitchInsn [min max default labels-array])))))
(def: #export (try @from @to @handler exception)
- (-> $;Label $;Label $;Label Text $;Inst)
+ (-> $.Label $.Label $.Label Text $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitTryCatchBlock [@from @to @handler ($t;binary-name exception)]))))
+ (MethodVisitor::visitTryCatchBlock [@from @to @handler ($t.binary-name exception)]))))
(def: #export (label @label)
- (-> $;Label $;Inst)
+ (-> $.Label $.Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitLabel [@label]))))
+ (MethodVisitor::visitLabel [@label]))))
(def: #export (array type)
- (-> $;Type $;Inst)
+ (-> $.Type $.Inst)
(case type
- (#$;Primitive prim)
+ (#$.Primitive prim)
(NEWARRAY prim)
- (#$;Generic generic)
+ (#$.Generic generic)
(let [elem-class (case generic
- (#$;Class class params)
- ($t;binary-name class)
+ (#$.Class class params)
+ ($t.binary-name class)
_
- ($t;binary-name "java.lang.Object"))]
+ ($t.binary-name "java.lang.Object"))]
(ANEWARRAY elem-class))
_
- (ANEWARRAY ($t;descriptor type))))
+ (ANEWARRAY ($t.descriptor type))))
(def: (primitive-wrapper type)
- (-> $;Primitive Text)
+ (-> $.Primitive Text)
(case type
- #$;Boolean "java.lang.Boolean"
- #$;Byte "java.lang.Byte"
- #$;Short "java.lang.Short"
- #$;Int "java.lang.Integer"
- #$;Long "java.lang.Long"
- #$;Float "java.lang.Float"
- #$;Double "java.lang.Double"
- #$;Char "java.lang.Character"))
+ #$.Boolean "java.lang.Boolean"
+ #$.Byte "java.lang.Byte"
+ #$.Short "java.lang.Short"
+ #$.Int "java.lang.Integer"
+ #$.Long "java.lang.Long"
+ #$.Float "java.lang.Float"
+ #$.Double "java.lang.Double"
+ #$.Char "java.lang.Character"))
(def: (primitive-unwrap type)
- (-> $;Primitive Text)
+ (-> $.Primitive Text)
(case type
- #$;Boolean "booleanValue"
- #$;Byte "byteValue"
- #$;Short "shortValue"
- #$;Int "intValue"
- #$;Long "longValue"
- #$;Float "floatValue"
- #$;Double "doubleValue"
- #$;Char "charValue"))
+ #$.Boolean "booleanValue"
+ #$.Byte "byteValue"
+ #$.Short "shortValue"
+ #$.Int "intValue"
+ #$.Long "longValue"
+ #$.Float "floatValue"
+ #$.Double "doubleValue"
+ #$.Char "charValue"))
(def: #export (wrap type)
- (-> $;Primitive $;Inst)
+ (-> $.Primitive $.Inst)
(let [class (primitive-wrapper type)]
- (|>. (INVOKESTATIC class "valueOf"
- ($t;method (list (#$;Primitive type))
- (#;Some ($t;class class (list)))
+ (|>> (INVOKESTATIC class "valueOf"
+ ($t.method (list (#$.Primitive type))
+ (#.Some ($t.class class (list)))
(list))
false))))
(def: #export (unwrap type)
- (-> $;Primitive $;Inst)
+ (-> $.Primitive $.Inst)
(let [class (primitive-wrapper type)]
- (|>. (CHECKCAST class)
+ (|>> (CHECKCAST class)
(INVOKEVIRTUAL class (primitive-unwrap type)
- ($t;method (list) (#;Some (#$;Primitive type)) (list))
+ ($t.method (list) (#.Some (#$.Primitive type)) (list))
false))))
(def: #export (fuse insts)
- (-> (List $;Inst) $;Inst)
+ (-> (List $.Inst) $.Inst)
(case insts
- #;Nil
+ #.Nil
id
- (#;Cons singleton #;Nil)
+ (#.Cons singleton #.Nil)
singleton
- (#;Cons head tail)
- (. (fuse tail) head)))
+ (#.Cons head tail)
+ (function.compose (fuse tail) head)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
index 03246540c..b29ffc4a0 100644
--- a/new-luxc/source/luxc/lang/host/jvm/type.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/type.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
[lux #- char]
(lux (data [text]
text/format
@@ -7,132 +7,132 @@
## Types
(do-template [<name> <primitive>]
- [(def: #export <name> $;Type (#$;Primitive <primitive>))]
-
- [boolean #$;Boolean]
- [byte #$;Byte]
- [short #$;Short]
- [int #$;Int]
- [long #$;Long]
- [float #$;Float]
- [double #$;Double]
- [char #$;Char]
+ [(def: #export <name> $.Type (#$.Primitive <primitive>))]
+
+ [boolean #$.Boolean]
+ [byte #$.Byte]
+ [short #$.Short]
+ [int #$.Int]
+ [long #$.Long]
+ [float #$.Float]
+ [double #$.Double]
+ [char #$.Char]
)
(def: #export (class name params)
- (-> Text (List $;Generic) $;Type)
- (#$;Generic (#$;Class name params)))
+ (-> Text (List $.Generic) $.Type)
+ (#$.Generic (#$.Class name params)))
(def: #export (var name)
- (-> Text $;Type)
- (#$;Generic (#$;Var name)))
+ (-> Text $.Type)
+ (#$.Generic (#$.Var name)))
(def: #export (wildcard bound)
- (-> (Maybe [$;Bound $;Generic]) $;Type)
- (#$;Generic (#$;Wildcard bound)))
+ (-> (Maybe [$.Bound $.Generic]) $.Type)
+ (#$.Generic (#$.Wildcard bound)))
(def: #export (array depth elemT)
- (-> Nat $;Type $;Type)
+ (-> Nat $.Type $.Type)
(case depth
+0 elemT
- _ (#$;Array (array (n.dec depth) elemT))))
+ _ (#$.Array (array (n/dec depth) elemT))))
(def: #export (binary-name class)
(-> Text Text)
- (text;replace-all "." "/" class))
+ (text.replace-all "." "/" class))
(def: #export (descriptor type)
- (-> $;Type Text)
+ (-> $.Type Text)
(case type
- (#$;Primitive prim)
+ (#$.Primitive prim)
(case prim
- #$;Boolean "Z"
- #$;Byte "B"
- #$;Short "S"
- #$;Int "I"
- #$;Long "J"
- #$;Float "F"
- #$;Double "D"
- #$;Char "C")
-
- (#$;Array sub)
+ #$.Boolean "Z"
+ #$.Byte "B"
+ #$.Short "S"
+ #$.Int "I"
+ #$.Long "J"
+ #$.Float "F"
+ #$.Double "D"
+ #$.Char "C")
+
+ (#$.Array sub)
(format "[" (descriptor sub))
- (#$;Generic generic)
+ (#$.Generic generic)
(case generic
- (#$;Class class params)
+ (#$.Class class params)
(format "L" (binary-name class) ";")
- (^or (#$;Var name) (#$;Wildcard ?bound))
- (descriptor (#$;Generic (#$;Class "java.lang.Object" (list)))))
+ (^or (#$.Var name) (#$.Wildcard ?bound))
+ (descriptor (#$.Generic (#$.Class "java.lang.Object" (list)))))
))
(def: #export (signature type)
- (-> $;Type Text)
+ (-> $.Type Text)
(case type
- (#$;Primitive prim)
+ (#$.Primitive prim)
(case prim
- #$;Boolean "Z"
- #$;Byte "B"
- #$;Short "S"
- #$;Int "I"
- #$;Long "J"
- #$;Float "F"
- #$;Double "D"
- #$;Char "C")
-
- (#$;Array sub)
+ #$.Boolean "Z"
+ #$.Byte "B"
+ #$.Short "S"
+ #$.Int "I"
+ #$.Long "J"
+ #$.Float "F"
+ #$.Double "D"
+ #$.Char "C")
+
+ (#$.Array sub)
(format "[" (signature sub))
- (#$;Generic generic)
+ (#$.Generic generic)
(case generic
- (#$;Class class params)
- (let [=params (if (list;empty? params)
+ (#$.Class class params)
+ (let [=params (if (list.empty? params)
""
(format "<"
(|> params
- (list/map (|>. #$;Generic signature))
- (text;join-with ""))
+ (list/map (|>> #$.Generic signature))
+ (text.join-with ""))
">"))]
(format "L" (binary-name class) =params ";"))
- (#$;Var name)
+ (#$.Var name)
(format "T" name ";")
- (#$;Wildcard #;None)
+ (#$.Wildcard #.None)
"*"
(^template [<tag> <prefix>]
- (#$;Wildcard (#;Some [<tag> bound]))
- (format <prefix> (signature (#$;Generic bound))))
- ([#$;Upper "+"]
- [#$;Lower "-"]))
+ (#$.Wildcard (#.Some [<tag> bound]))
+ (format <prefix> (signature (#$.Generic bound))))
+ ([#$.Upper "+"]
+ [#$.Lower "-"]))
))
## Methods
(def: #export (method args return exceptions)
- (-> (List $;Type) (Maybe $;Type) (List $;Generic) $;Method)
- {#$;args args #$;return return #$;exceptions exceptions})
+ (-> (List $.Type) (Maybe $.Type) (List $.Generic) $.Method)
+ {#$.args args #$.return return #$.exceptions exceptions})
(def: #export (method-descriptor method)
- (-> $;Method Text)
- (format "(" (text;join-with "" (list/map descriptor (get@ #$;args method))) ")"
- (case (get@ #$;return method)
- #;None
+ (-> $.Method Text)
+ (format "(" (text.join-with "" (list/map descriptor (get@ #$.args method))) ")"
+ (case (get@ #$.return method)
+ #.None
"V"
- (#;Some return)
+ (#.Some return)
(descriptor return))))
(def: #export (method-signature method)
- (-> $;Method Text)
- (format "(" (|> (get@ #$;args method) (list/map signature) (text;join-with "")) ")"
- (case (get@ #$;return method)
- #;None
+ (-> $.Method Text)
+ (format "(" (|> (get@ #$.args method) (list/map signature) (text.join-with "")) ")"
+ (case (get@ #$.return method)
+ #.None
"V"
- (#;Some return)
+ (#.Some return)
(signature return))
- (|> (get@ #$;exceptions method)
- (list/map (|>. #$;Generic signature (format "^")))
- (text;join-with ""))))
+ (|> (get@ #$.exceptions method)
+ (list/map (|>> #$.Generic signature (format "^")))
+ (text.join-with ""))))
diff --git a/new-luxc/source/luxc/lang/macro.lux b/new-luxc/source/luxc/lang/macro.lux
index 4885e21db..71b140c6e 100644
--- a/new-luxc/source/luxc/lang/macro.lux
+++ b/new-luxc/source/luxc/lang/macro.lux
@@ -1,37 +1,35 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do])
(data ["e" error])
[macro]
[host])
- (luxc (lang [";L" host]
- (translation [";T" common]))))
+ (luxc (lang [".L" host]
+ (translation [".T" common]))))
-(for {"JVM" (as-is (host;import java.lang.reflect.Method
+(for {"JVM" (as-is (host.import java/lang/reflect/Method
(invoke [Object (Array Object)] #try Object))
- (host;import (java.lang.Class c)
+ (host.import (java/lang/Class c)
(getMethod [String (Array (Class Object))] #try Method))
- (host;import java.lang.Object
- (getClass [] (Class Object))
- (toString [] String))
- (def: _object-class (Class Object) (host;class-for Object))
+ (host.import java/lang/Object)
+ (def: _object-class (Class Object) (host.class-for Object))
(def: _apply-args
(Array (Class Object))
- (|> (host;array (Class Object) +2)
- (host;array-write +0 _object-class)
- (host;array-write +1 _object-class)))
+ (|> (host.array (Class Object) +2)
+ (host.array-write +0 _object-class)
+ (host.array-write +1 _object-class)))
(def: #export (expand macro inputs)
(-> Macro (List Code) (Meta (List Code)))
- (do macro;Monad<Meta>
- [class (commonT;load-class hostL;function-class)]
+ (do macro.Monad<Meta>
+ [class (commonT.load-class hostL.function-class)]
(function [compiler]
- (do e;Monad<Error>
- [apply-method (Class.getMethod ["apply" _apply-args] class)
- output (Method.invoke [(:! Object macro)
- (|> (host;array Object +2)
- (host;array-write +0 (:! Object inputs))
- (host;array-write +1 (:! Object compiler)))]
- apply-method)]
- (:! (e;Error [Compiler (List Code)])
+ (do e.Monad<Error>
+ [apply-method (Class::getMethod ["apply" _apply-args] class)
+ output (Method::invoke [(:! Object macro)
+ (|> (host.array Object +2)
+ (host.array-write +0 (:! Object inputs))
+ (host.array-write +1 (:! Object compiler)))]
+ apply-method)]
+ (:! (e.Error [Compiler (List Code)])
output))))))
})
diff --git a/new-luxc/source/luxc/lang/module.lux b/new-luxc/source/luxc/lang/module.lux
index f6cffa9c6..62e20fa9a 100644
--- a/new-luxc/source/luxc/lang/module.lux
+++ b/new-luxc/source/luxc/lang/module.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
@@ -10,7 +10,7 @@
[macro]
(macro [code]))
(luxc ["&" lang]
- (lang ["&;" scope])))
+ (lang ["&." scope])))
(exception: #export Unknown-Module)
(exception: #export Cannot-Declare-Tag-Twice)
@@ -22,198 +22,198 @@
(def: (new-module hash)
(-> Nat Module)
- {#;module-hash hash
- #;module-aliases (list)
- #;defs (list)
- #;imports (list)
- #;tags (list)
- #;types (list)
- #;module-annotations (' {})
- #;module-state #;Active})
+ {#.module-hash hash
+ #.module-aliases (list)
+ #.defs (list)
+ #.imports (list)
+ #.tags (list)
+ #.types (list)
+ #.module-annotations (' {})
+ #.module-state #.Active})
(def: #export (set-annotations annotations)
(-> Code (Meta Unit))
- (do macro;Monad<Meta>
- [self macro;current-module-name]
+ (do macro.Monad<Meta>
+ [self macro.current-module-name]
(function [compiler]
- (#e;Success [(update@ #;modules
- (&;pl-update self (set@ #;module-annotations annotations))
+ (#e.Success [(update@ #.modules
+ (&.pl-update self (set@ #.module-annotations annotations))
compiler)
[]]))))
(def: #export (import module)
(-> Text (Meta Unit))
- (do macro;Monad<Meta>
- [self macro;current-module-name]
+ (do macro.Monad<Meta>
+ [self macro.current-module-name]
(function [compiler]
- (#e;Success [(update@ #;modules
- (&;pl-update self (update@ #;imports (|>. (#;Cons module))))
+ (#e.Success [(update@ #.modules
+ (&.pl-update self (update@ #.imports (|>> (#.Cons module))))
compiler)
[]]))))
(def: #export (alias alias module)
(-> Text Text (Meta Unit))
- (do macro;Monad<Meta>
- [self macro;current-module-name]
+ (do macro.Monad<Meta>
+ [self macro.current-module-name]
(function [compiler]
- (#e;Success [(update@ #;modules
- (&;pl-update self (update@ #;module-aliases (: (-> (List [Text Text]) (List [Text Text]))
- (|>. (#;Cons [alias module])))))
+ (#e.Success [(update@ #.modules
+ (&.pl-update self (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text]))
+ (|>> (#.Cons [alias module])))))
compiler)
[]]))))
(def: #export (exists? module)
(-> Text (Meta Bool))
(function [compiler]
- (|> (get@ #;modules compiler)
- (&;pl-get module)
- (case> (#;Some _) true #;None false)
- [compiler] #e;Success)))
+ (|> (get@ #.modules compiler)
+ (&.pl-get module)
+ (case> (#.Some _) true #.None false)
+ [compiler] #e.Success)))
(def: #export (define (^@ full-name [module-name def-name])
definition)
(-> Ident Def (Meta Unit))
(function [compiler]
- (case (&;pl-get module-name (get@ #;modules compiler))
- (#;Some module)
- (case (&;pl-get def-name (get@ #;defs module))
- #;None
- (#e;Success [(update@ #;modules
- (&;pl-put module-name
- (update@ #;defs
+ (case (&.pl-get module-name (get@ #.modules compiler))
+ (#.Some module)
+ (case (&.pl-get def-name (get@ #.defs module))
+ #.None
+ (#e.Success [(update@ #.modules
+ (&.pl-put module-name
+ (update@ #.defs
(: (-> (List [Text Def]) (List [Text Def]))
- (|>. (#;Cons [def-name definition])))
+ (|>> (#.Cons [def-name definition])))
module))
compiler)
[]])
- (#;Some already-existing)
- ((&;throw Cannot-Define-More-Than-Once (%ident full-name)) compiler))
+ (#.Some already-existing)
+ ((&.throw Cannot-Define-More-Than-Once (%ident full-name)) compiler))
- #;None
- ((&;throw Cannot-Define-In-Unknown-Module (%ident full-name)) compiler))))
+ #.None
+ ((&.throw Cannot-Define-In-Unknown-Module (%ident full-name)) compiler))))
(def: #export (create hash name)
(-> Nat Text (Meta Module))
(function [compiler]
(let [module (new-module hash)]
- (#e;Success [(update@ #;modules
- (&;pl-put name module)
+ (#e.Success [(update@ #.modules
+ (&.pl-put name module)
compiler)
module]))))
(def: #export (with-module hash name action)
(All [a] (-> Nat Text (Meta a) (Meta [Module a])))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[_ (create hash name)
- output (&;with-current-module name
+ output (&.with-current-module name
action)
- module (macro;find-module name)]
+ module (macro.find-module name)]
(wrap [module output])))
(do-template [<flagger> <asker> <tag> <description>]
[(def: #export (<flagger> module-name)
(-> Text (Meta Unit))
(function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get module-name))
- (#;Some module)
- (let [active? (case (get@ #;module-state module)
- #;Active true
+ (case (|> compiler (get@ #.modules) (&.pl-get module-name))
+ (#.Some module)
+ (let [active? (case (get@ #.module-state module)
+ #.Active true
_ false)]
(if active?
- (#e;Success [(update@ #;modules
- (&;pl-put module-name (set@ #;module-state <tag> module))
+ (#e.Success [(update@ #.modules
+ (&.pl-put module-name (set@ #.module-state <tag> module))
compiler)
[]])
- ((&;throw Can-Only-Change-State-Of-Active-Module
+ ((&.throw Can-Only-Change-State-Of-Active-Module
(format " Module: " module-name "\n"
"Desired state: " <description>))
compiler)))
- #;None
- ((&;throw Unknown-Module module-name) compiler))))
+ #.None
+ ((&.throw Unknown-Module module-name) compiler))))
(def: #export (<asker> module-name)
(-> Text (Meta Bool))
(function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get module-name))
- (#;Some module)
- (#e;Success [compiler
- (case (get@ #;module-state module)
+ (case (|> compiler (get@ #.modules) (&.pl-get module-name))
+ (#.Some module)
+ (#e.Success [compiler
+ (case (get@ #.module-state module)
<tag> true
_ false)])
- #;None
- ((&;throw Unknown-Module module-name) compiler))
+ #.None
+ ((&.throw Unknown-Module module-name) compiler))
))]
- [flag-active! active? #;Active "Active"]
- [flag-compiled! compiled? #;Compiled "Compiled"]
- [flag-cached! cached? #;Cached "Cached"]
+ [flag-active! active? #.Active "Active"]
+ [flag-compiled! compiled? #.Compiled "Compiled"]
+ [flag-cached! cached? #.Cached "Cached"]
)
(do-template [<name> <tag> <type>]
[(def: (<name> module-name)
(-> Text (Meta <type>))
(function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get module-name))
- (#;Some module)
- (#e;Success [compiler (get@ <tag> module)])
+ (case (|> compiler (get@ #.modules) (&.pl-get module-name))
+ (#.Some module)
+ (#e.Success [compiler (get@ <tag> module)])
- #;None
- ((&;throw Unknown-Module module-name) compiler))
+ #.None
+ ((&.throw Unknown-Module module-name) compiler))
))]
- [tags-by-module #;tags (List [Text [Nat (List Ident) Bool Type]])]
- [types-by-module #;types (List [Text [(List Ident) Bool Type]])]
- [module-hash #;module-hash Nat]
+ [tags-by-module #.tags (List [Text [Nat (List Ident) Bool Type]])]
+ [types-by-module #.types (List [Text [(List Ident) Bool Type]])]
+ [module-hash #.module-hash Nat]
)
(def: (ensure-undeclared-tags module-name tags)
(-> Text (List Text) (Meta Unit))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[bindings (tags-by-module module-name)
- _ (monad;map @
+ _ (monad.map @
(function [tag]
- (case (&;pl-get tag bindings)
- #;None
+ (case (&.pl-get tag bindings)
+ #.None
(wrap [])
- (#;Some _)
- (&;throw Cannot-Declare-Tag-Twice (format "Module: " module-name "\n"
+ (#.Some _)
+ (&.throw Cannot-Declare-Tag-Twice (format "Module: " module-name "\n"
" Tag: " tag))))
tags)]
(wrap [])))
(def: #export (declare-tags tags exported? type)
(-> (List Text) Bool Type (Meta Unit))
- (do macro;Monad<Meta>
- [current-module macro;current-module-name
+ (do macro.Monad<Meta>
+ [current-module macro.current-module-name
[type-module type-name] (case type
- (#;Named type-ident _)
+ (#.Named type-ident _)
(wrap type-ident)
_
- (&;throw Cannot-Declare-Tags-For-Unnamed-Type
- (format "Tags: " (|> tags (list/map code;text) code;tuple %code) "\n"
+ (&.throw Cannot-Declare-Tags-For-Unnamed-Type
+ (format "Tags: " (|> tags (list/map code.text) code.tuple %code) "\n"
"Type: " (%type type))))
_ (ensure-undeclared-tags current-module tags)
- _ (&;assert Cannot-Declare-Tags-For-Foreign-Type
- (format "Tags: " (|> tags (list/map code;text) code;tuple %code) "\n"
+ _ (&.assert Cannot-Declare-Tags-For-Foreign-Type
+ (format "Tags: " (|> tags (list/map code.text) code.tuple %code) "\n"
"Type: " (%type type))
(text/= current-module type-module))]
(function [compiler]
- (case (|> compiler (get@ #;modules) (&;pl-get current-module))
- (#;Some module)
- (let [namespaced-tags (list/map (|>. [current-module]) tags)]
- (#e;Success [(update@ #;modules
- (&;pl-update current-module
- (|>. (update@ #;tags (function [tag-bindings]
+ (case (|> compiler (get@ #.modules) (&.pl-get current-module))
+ (#.Some module)
+ (let [namespaced-tags (list/map (|>> [current-module]) tags)]
+ (#e.Success [(update@ #.modules
+ (&.pl-update current-module
+ (|>> (update@ #.tags (function [tag-bindings]
(list/fold (function [[idx tag] table]
- (&;pl-put tag [idx namespaced-tags exported? type] table))
+ (&.pl-put tag [idx namespaced-tags exported? type] table))
tag-bindings
- (list;enumerate tags))))
- (update@ #;types (&;pl-put type-name [namespaced-tags exported? type]))))
+ (list.enumerate tags))))
+ (update@ #.types (&.pl-put type-name [namespaced-tags exported? type]))))
compiler)
[]]))
- #;None
- ((&;throw Unknown-Module current-module) compiler)))))
+ #.None
+ ((&.throw Unknown-Module current-module) compiler)))))
diff --git a/new-luxc/source/luxc/lang/scope.lux b/new-luxc/source/luxc/lang/scope.lux
index 8bc61e722..8dcdce6af 100644
--- a/new-luxc/source/luxc/lang/scope.lux
+++ b/new-luxc/source/luxc/lang/scope.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad)
(data [text "text/" Eq<Text>]
@@ -9,7 +9,7 @@
(coll [list "list/" Functor<List> Fold<List> Monoid<List>]))
[macro])
(luxc ["&" lang]
- (lang [";L" variable #+ Variable])))
+ (lang [".L" variable #+ Variable])))
(type: Locals (Bindings Text [Type Nat]))
(type: Captured (Bindings Text [Type Ref]))
@@ -17,35 +17,35 @@
(def: (is-local? name scope)
(-> Text Scope Bool)
(|> scope
- (get@ [#;locals #;mappings])
- (&;pl-contains? name)))
+ (get@ [#.locals #.mappings])
+ (&.pl-contains? name)))
(def: (get-local name scope)
(-> Text Scope (Maybe [Type Ref]))
(|> scope
- (get@ [#;locals #;mappings])
- (&;pl-get name)
+ (get@ [#.locals #.mappings])
+ (&.pl-get name)
(maybe/map (function [[type value]]
- [type (#;Local value)]))))
+ [type (#.Local value)]))))
(def: (is-captured? name scope)
(-> Text Scope Bool)
(|> scope
- (get@ [#;captured #;mappings])
- (&;pl-contains? name)))
+ (get@ [#.captured #.mappings])
+ (&.pl-contains? name)))
(def: (get-captured name scope)
(-> Text Scope (Maybe [Type Ref]))
(loop [idx +0
- mappings (get@ [#;captured #;mappings] scope)]
+ mappings (get@ [#.captured #.mappings] scope)]
(case mappings
- #;Nil
- #;None
+ #.Nil
+ #.None
- (#;Cons [_name [_source-type _source-ref]] mappings')
+ (#.Cons [_name [_source-type _source-ref]] mappings')
(if (text/= name _name)
- (#;Some [_source-type (#;Captured idx)])
- (recur (n.inc idx) mappings')))))
+ (#.Some [_source-type (#.Captured idx)])
+ (recur (n/inc idx) mappings')))))
(def: (is-ref? name scope)
(-> Text Scope Bool)
@@ -55,8 +55,8 @@
(def: (get-ref name scope)
(-> Text Scope (Maybe [Type Ref]))
(case (get-local name scope)
- (#;Some type)
- (#;Some type)
+ (#.Some type)
+ (#.Some type)
_
(get-captured name scope)))
@@ -65,68 +65,68 @@
(-> Text (Meta (Maybe [Type Ref])))
(function [compiler]
(let [[inner outer] (|> compiler
- (get@ #;scopes)
- (list;split-with (|>. (is-ref? name) not)))]
+ (get@ #.scopes)
+ (list.split-with (|>> (is-ref? name) not)))]
(case outer
- #;Nil
- (#;Right [compiler #;None])
+ #.Nil
+ (#.Right [compiler #.None])
- (#;Cons top-outer _)
- (let [[ref-type init-ref] (maybe;default (undefined)
+ (#.Cons top-outer _)
+ (let [[ref-type init-ref] (maybe.default (undefined)
(get-ref name top-outer))
[ref inner'] (list/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
(function [scope ref+inner]
- [(#;Captured (get@ [#;captured #;counter] scope))
- (#;Cons (update@ #;captured
+ [(#.Captured (get@ [#.captured #.counter] scope))
+ (#.Cons (update@ #.captured
(: (-> Captured Captured)
- (|>. (update@ #;counter n.inc)
- (update@ #;mappings (&;pl-put name [ref-type (product;left ref+inner)]))))
+ (|>> (update@ #.counter n/inc)
+ (update@ #.mappings (&.pl-put name [ref-type (product.left ref+inner)]))))
scope)
- (product;right ref+inner))]))
- [init-ref #;Nil]
- (list;reverse inner))
+ (product.right ref+inner))]))
+ [init-ref #.Nil]
+ (list.reverse inner))
scopes (list/compose inner' outer)]
- (#;Right [(set@ #;scopes scopes compiler)
- (#;Some [ref-type ref])]))
+ (#.Right [(set@ #.scopes scopes compiler)
+ (#.Some [ref-type ref])]))
))))
(def: #export (with-local [name type] action)
(All [a] (-> [Text Type] (Meta a) (Meta a)))
(function [compiler]
- (case (get@ #;scopes compiler)
- (#;Cons head tail)
- (let [old-mappings (get@ [#;locals #;mappings] head)
- new-var-id (get@ [#;locals #;counter] head)
- new-head (update@ #;locals
+ (case (get@ #.scopes compiler)
+ (#.Cons head tail)
+ (let [old-mappings (get@ [#.locals #.mappings] head)
+ new-var-id (get@ [#.locals #.counter] head)
+ new-head (update@ #.locals
(: (-> Locals Locals)
- (|>. (update@ #;counter n.inc)
- (update@ #;mappings (&;pl-put name [type new-var-id]))))
+ (|>> (update@ #.counter n/inc)
+ (update@ #.mappings (&.pl-put name [type new-var-id]))))
head)]
- (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler)
+ (case (macro.run' (set@ #.scopes (#.Cons new-head tail) compiler)
action)
- (#e;Success [compiler' output])
- (case (get@ #;scopes compiler')
- (#;Cons head' tail')
- (let [scopes' (#;Cons (set@ #;locals (get@ #;locals head) head')
+ (#e.Success [compiler' output])
+ (case (get@ #.scopes compiler')
+ (#.Cons head' tail')
+ (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head')
tail')]
- (#e;Success [(set@ #;scopes scopes' compiler')
+ (#e.Success [(set@ #.scopes scopes' compiler')
output]))
_
- (error! "Invalid scope alteration."))
+ (error! "Invalid scope alteration/"))
- (#e;Error error)
- (#e;Error error)))
+ (#e.Error error)
+ (#e.Error error)))
_
- (#e;Error "Cannot create local binding without a scope."))
+ (#e.Error "Cannot create local binding without a scope."))
))
(do-template [<name> <val-type>]
[(def: <name>
(Bindings Text [Type <val-type>])
- {#;counter +0
- #;mappings (list)})]
+ {#.counter +0
+ #.mappings (list)})]
[init-locals Nat]
[init-captured Ref]
@@ -134,29 +134,29 @@
(def: (scope parent-name child-name)
(-> (List Text) Text Scope)
- {#;name (list& child-name parent-name)
- #;inner +0
- #;locals init-locals
- #;captured init-captured})
+ {#.name (list& child-name parent-name)
+ #.inner +0
+ #.locals init-locals
+ #.captured init-captured})
(def: #export (with-scope name action)
(All [a] (-> Text (Meta a) (Meta a)))
(function [compiler]
- (let [parent-name (case (get@ #;scopes compiler)
- #;Nil
+ (let [parent-name (case (get@ #.scopes compiler)
+ #.Nil
(list)
- (#;Cons top _)
- (get@ #;name top))]
- (case (action (update@ #;scopes
- (|>. (#;Cons (scope parent-name name)))
+ (#.Cons top _)
+ (get@ #.name top))]
+ (case (action (update@ #.scopes
+ (|>> (#.Cons (scope parent-name name)))
compiler))
- (#e;Error error)
- (#e;Error error)
+ (#e.Error error)
+ (#e.Error error)
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;scopes
- (|>. list;tail (maybe;default (list)))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.scopes
+ (|>> list.tail (maybe.default (list)))
compiler')
output])
))
@@ -165,9 +165,9 @@
(def: #export next-local
(Meta Nat)
(function [compiler]
- (case (get@ #;scopes compiler)
- #;Nil
- (#e;Error "Cannot get next reference when there is no scope.")
+ (case (get@ #.scopes compiler)
+ #.Nil
+ (#e.Error "Cannot get next reference when there is no scope.")
- (#;Cons top _)
- (#e;Success [compiler (get@ [#;locals #;counter] top)]))))
+ (#.Cons top _)
+ (#e.Success [compiler (get@ [#.locals #.counter] top)]))))
diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux
index 3207c41b4..33c8aa063 100644
--- a/new-luxc/source/luxc/lang/synthesis.lux
+++ b/new-luxc/source/luxc/lang/synthesis.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux)
(def: #export Arity Nat)
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index c35483dd8..ab4820b30 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (data [bool "bool/" Eq<Bool>]
[text "text/" Eq<Text>]
@@ -6,54 +6,54 @@
[number]
(coll [list "list/" Fold<List> Monoid<List>]))
(macro [code "code/" Eq<Code>]))
- (luxc (lang [";L" variable #+ Variable]
+ (luxc (lang [".L" variable #+ Variable]
["la" analysis]
["ls" synthesis]
- (synthesis [";S" function]))))
+ (synthesis [".S" function]))))
-(def: popPS ls;Path (' ("lux case pop")))
+(def: popPS ls.Path (' ("lux case pop")))
(def: (path' arity num-locals pattern)
- (-> ls;Arity Nat la;Pattern [Nat (List ls;Path)])
+ (-> ls.Arity Nat la.Pattern [Nat (List ls.Path)])
(case pattern
(^code ("lux case tuple" [(~@ membersP)]))
(case membersP
- #;Nil
+ #.Nil
[num-locals
(list popPS)]
- (#;Cons singletonP #;Nil)
+ (#.Cons singletonP #.Nil)
(path' arity num-locals singletonP)
- (#;Cons _)
- (let [last-idx (n.dec (list;size membersP))
- [_ output] (list/fold (: (-> la;Pattern [Nat [Nat (List ls;Path)]] [Nat [Nat (List ls;Path)]])
+ (#.Cons _)
+ (let [last-idx (n/dec (list.size membersP))
+ [_ output] (list/fold (: (-> la.Pattern [Nat [Nat (List ls.Path)]] [Nat [Nat (List ls.Path)]])
(function [current-pattern [current-idx num-locals' next]]
(let [[num-locals'' current-path] (path' arity num-locals' current-pattern)]
- [(n.dec current-idx)
+ [(n/dec current-idx)
num-locals''
- (|> (list (if (n.= last-idx current-idx)
- (` ("lux case tuple right" (~ (code;nat current-idx))))
- (` ("lux case tuple left" (~ (code;nat current-idx))))))
+ (|> (list (if (n/= last-idx current-idx)
+ (` ("lux case tuple right" (~ (code.nat current-idx))))
+ (` ("lux case tuple left" (~ (code.nat current-idx))))))
(list/compose current-path)
(list/compose next))])))
[last-idx num-locals (list popPS)]
- (list;reverse membersP))]
+ (list.reverse membersP))]
output))
- (^code ("lux case variant" (~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
+ (^code ("lux case variant" (~ [_ (#.Nat tag)]) (~ [_ (#.Nat num-tags)]) (~ memberP)))
(let [[num-locals' member-path] (path' arity num-locals memberP)]
- [num-locals' (|> (list (if (n.= (n.dec num-tags) tag)
- (` ("lux case variant right" (~ (code;nat tag))))
- (` ("lux case variant left" (~ (code;nat tag))))))
+ [num-locals' (|> (list (if (n/= (n/dec num-tags) tag)
+ (` ("lux case variant right" (~ (code.nat tag))))
+ (` ("lux case variant left" (~ (code.nat tag))))))
(list/compose member-path)
(list& popPS))])
- (^code ("lux case bind" (~ [_ (#;Nat register)])))
- [(n.inc num-locals)
+ (^code ("lux case bind" (~ [_ (#.Nat register)])))
+ [(n/inc num-locals)
(list popPS
- (` ("lux case bind" (~ (code;nat (if (functionS;nested? arity)
- (n.+ (n.dec arity) register)
+ (` ("lux case bind" (~ (code.nat (if (functionS.nested? arity)
+ (n/+ (n/dec arity) register)
register))))))]
_
@@ -61,18 +61,18 @@
(list popPS pattern)]))
(def: (clean-unnecessary-pops paths)
- (-> (List ls;Path) (List ls;Path))
+ (-> (List ls.Path) (List ls.Path))
(case paths
- (#;Cons path paths')
+ (#.Cons path paths')
(if (is popPS path)
(clean-unnecessary-pops paths')
paths)
- #;Nil
+ #.Nil
paths))
(def: #export (path arity num-locals synthesize pattern bodyA)
- (-> ls;Arity Nat (-> Nat la;Analysis ls;Synthesis) la;Pattern la;Analysis ls;Path)
+ (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis) la.Pattern la.Analysis ls.Path)
(let [[num-locals' pieces] (path' arity num-locals pattern)]
(|> pieces
clean-unnecessary-pops
@@ -81,7 +81,7 @@
(` ("lux case exec" (~ (synthesize num-locals' bodyA))))))))
(def: #export (weave leftP rightP)
- (-> ls;Path ls;Path ls;Path)
+ (-> ls.Path ls.Path ls.Path)
(with-expansions [<default> (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
(case [leftP rightP]
(^ [(^code ("lux case seq" (~ preL) (~ postL)))
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index aaa2cf2c7..d3fbfcb58 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control ["p" parser])
(data [maybe]
@@ -12,82 +12,82 @@
["s" syntax]))
(luxc (lang ["la" analysis]
["ls" synthesis]
- (synthesis [";S" case]
- [";S" function]
- [";S" loop])
- [";L" variable #+ Variable])
+ (synthesis [".S" case]
+ [".S" function]
+ [".S" loop])
+ [".L" variable #+ Variable])
))
(def: init-env (List Variable) (list))
-(def: init-resolver (Dict Int Int) (dict;new number;Hash<Int>))
+(def: init-resolver (Dict Int Int) (dict.new number.Hash<Int>))
(def: (prepare-body inner-arity arity body)
- (-> ls;Arity ls;Arity ls;Synthesis ls;Synthesis)
- (if (functionS;nested? inner-arity)
+ (-> ls.Arity ls.Arity ls.Synthesis ls.Synthesis)
+ (if (functionS.nested? inner-arity)
body
- (loopS;reify-recursion arity body)))
+ (loopS.reify-recursion arity body)))
(def: (let$ register inputS bodyS)
- (-> Nat ls;Synthesis ls;Synthesis ls;Synthesis)
- (` ("lux let" (~ (code;nat register)) (~ inputS) (~ bodyS))))
+ (-> Nat ls.Synthesis ls.Synthesis ls.Synthesis)
+ (` ("lux let" (~ (code.nat register)) (~ inputS) (~ bodyS))))
(def: (if$ testS thenS elseS)
- (-> ls;Synthesis ls;Synthesis ls;Synthesis ls;Synthesis)
+ (-> ls.Synthesis ls.Synthesis ls.Synthesis ls.Synthesis)
(` ("lux if" (~ testS)
(~ thenS)
(~ elseS))))
(def: (function$ arity environment body)
- (-> ls;Arity (List Variable) ls;Synthesis ls;Synthesis)
- (` ("lux function" (~ (code;nat arity))
- [(~@ (list/map code;int environment))]
+ (-> ls.Arity (List Variable) ls.Synthesis ls.Synthesis)
+ (` ("lux function" (~ (code.nat arity))
+ [(~@ (list/map code.int environment))]
(~ body))))
(def: (variant$ tag last? valueS)
- (-> Nat Bool ls;Synthesis ls;Synthesis)
- (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ valueS))))
+ (-> Nat Bool ls.Synthesis ls.Synthesis)
+ (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ valueS))))
(def: (var$ var)
- (-> Variable ls;Synthesis)
- (` ((~ (code;int var)))))
+ (-> Variable ls.Synthesis)
+ (` ((~ (code.int var)))))
(def: (procedure$ name argsS)
- (-> Text (List ls;Synthesis) ls;Synthesis)
- (` ((~ (code;text name)) (~@ argsS))))
+ (-> Text (List ls.Synthesis) ls.Synthesis)
+ (` ((~ (code.text name)) (~@ argsS))))
(def: (call$ funcS argsS)
- (-> ls;Synthesis (List ls;Synthesis) ls;Synthesis)
+ (-> ls.Synthesis (List ls.Synthesis) ls.Synthesis)
(` ("lux call" (~ funcS) (~@ argsS))))
(def: (synthesize-case arity num-locals synthesize inputA branchesA)
- (-> ls;Arity Nat (-> Nat la;Analysis ls;Synthesis)
- la;Analysis (List [la;Pattern la;Analysis])
- ls;Synthesis)
+ (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis)
+ la.Analysis (List [la.Pattern la.Analysis])
+ ls.Synthesis)
(let [inputS (synthesize num-locals inputA)]
- (case (list;reverse branchesA)
- (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)])))
- (^code ((~ [_ (#;Int var)])))]))
- (not (variableL;captured? var))
- (n.= input-register (variableL;local-register var)))
+ (case (list.reverse branchesA)
+ (^multi (^ (list [(^code ("lux case bind" (~ [_ (#.Nat input-register)])))
+ (^code ((~ [_ (#.Int var)])))]))
+ (not (variableL.captured? var))
+ (n/= input-register (variableL.local-register var)))
inputS
- (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
- (let$ (if (functionS;nested? arity)
- (n.+ (n.dec arity) register)
+ (^ (list [(^code ("lux case bind" (~ [_ (#.Nat register)]))) bodyA]))
+ (let$ (if (functionS.nested? arity)
+ (n/+ (n/dec arity) register)
register)
inputS
- (synthesize (n.inc num-locals) bodyA))
+ (synthesize (n/inc num-locals) bodyA))
(^or (^ (list [(^code true) thenA] [(^code false) elseA]))
(^ (list [(^code false) elseA] [(^code true) thenA])))
(if$ inputS (synthesize num-locals thenA) (synthesize num-locals elseA))
- (#;Cons [lastP lastA] prevsPA)
- (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
- (caseS;path arity num-locals synthesize))
- pathS (list/fold caseS;weave
+ (#.Cons [lastP lastA] prevsPA)
+ (let [transform-branch (: (-> la.Pattern la.Analysis ls.Path)
+ (caseS.path arity num-locals synthesize))
+ pathS (list/fold caseS.weave
(transform-branch lastP lastA)
- (list/map (product;uncurry transform-branch) prevsPA))]
+ (list/map (product.uncurry transform-branch) prevsPA))]
(` ("lux case" (~ inputS) (~ pathS))))
_
@@ -95,17 +95,17 @@
)))
(def: (synthesize-apply synthesize num-locals exprA)
- (-> (-> la;Analysis ls;Synthesis) Nat la;Analysis ls;Synthesis)
- (let [[funcA argsA] (functionS;unfold-apply exprA)
+ (-> (-> la.Analysis ls.Synthesis) Nat la.Analysis ls.Synthesis)
+ (let [[funcA argsA] (functionS.unfold-apply exprA)
funcS (synthesize funcA)
argsS (list/map synthesize argsA)]
(case funcS
- (^multi (^code ("lux function" (~ [_ (#;Nat _arity)]) [(~@ _env)] (~ _bodyS)))
- (and (n.= _arity (list;size argsS))
- (not (loopS;contains-self-reference? _bodyS)))
- [(s;run _env (p;some s;int)) (#e;Success _env)])
- (` ("lux loop" (~ (code;nat (n.inc num-locals))) [(~@ argsS)]
- (~ (loopS;adjust _env num-locals _bodyS))))
+ (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~@ _env)] (~ _bodyS)))
+ (and (n/= _arity (list.size argsS))
+ (not (loopS.contains-self-reference? _bodyS)))
+ [(s.run _env (p.some s.int)) (#e.Success _env)])
+ (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~@ argsS)]
+ (~ (loopS.adjust _env num-locals _bodyS))))
(^code ("lux call" (~ funcS') (~@ argsS')))
(call$ funcS' (list/compose argsS' argsS))
@@ -114,7 +114,7 @@
(call$ funcS argsS))))
(def: #export (synthesize expressionA)
- (-> la;Analysis ls;Synthesis)
+ (-> la.Analysis ls.Synthesis)
(loop [arity +0
resolver init-resolver
direct? false
@@ -123,63 +123,63 @@
(case expressionA
(^code [(~ _left) (~ _right)])
(` [(~@ (list/map (recur arity resolver false num-locals)
- (la;unfold-tuple expressionA)))])
+ (la.unfold-tuple expressionA)))])
(^or (^code ("lux sum left" (~ _)))
(^code ("lux sum right" (~ _))))
- (let [[tag last? value] (maybe;assume (la;unfold-variant expressionA))]
+ (let [[tag last? value] (maybe.assume (la.unfold-variant expressionA))]
(variant$ tag last? (recur arity resolver false num-locals value)))
- (^code ((~ [_ (#;Int var)])))
- (if (variableL;local? var)
- (if (functionS;nested? arity)
- (if (variableL;self? var)
- (call$ (var$ 0) (|> (list;n.range +1 (n.dec arity))
- (list/map (|>. variableL;local code;int (~) () (`)))))
- (var$ (functionS;adjust-var arity var)))
+ (^code ((~ [_ (#.Int var)])))
+ (if (variableL.local? var)
+ (if (functionS.nested? arity)
+ (if (variableL.self? var)
+ (call$ (var$ 0) (|> (list.n/range +1 (n/dec arity))
+ (list/map (|>> variableL.local code.int (~) () (`)))))
+ (var$ (functionS.adjust-var arity var)))
(var$ var))
- (var$ (maybe;default var (dict;get var resolver))))
+ (var$ (maybe.default var (dict.get var resolver))))
- (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
+ (^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)])))
(synthesize-case arity num-locals (recur arity resolver false) inputA branchesA)
(^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
- [(s;run scope (p;some s;int)) (#e;Success raw-env)])
+ [(s.run scope (p.some s.int)) (#e.Success raw-env)])
(let [function-arity (if direct?
- (n.inc arity)
+ (n/inc arity)
+1)
env (list/map (function [closure]
- (case (dict;get closure resolver)
- (#;Some resolved)
- (if (and (variableL;local? resolved)
- (functionS;nested? arity)
- (|> resolved variableL;local-register (n.>= arity)))
- (functionS;adjust-var arity resolved)
+ (case (dict.get closure resolver)
+ (#.Some resolved)
+ (if (and (variableL.local? resolved)
+ (functionS.nested? arity)
+ (|> resolved variableL.local-register (n/>= arity)))
+ (functionS.adjust-var arity resolved)
resolved)
- #;None
- (if (and (variableL;local? closure)
- (functionS;nested? arity))
- (functionS;adjust-var arity closure)
+ #.None
+ (if (and (variableL.local? closure)
+ (functionS.nested? arity))
+ (functionS.adjust-var arity closure)
closure)))
raw-env)
env-vars (: (List Variable)
(case raw-env
- #;Nil (list)
- _ (|> (list;size raw-env) n.dec (list;n.range +0) (list/map variableL;captured))))
- resolver' (if (and (functionS;nested? function-arity)
+ #.Nil (list)
+ _ (|> (list.size raw-env) n/dec (list.n/range +0) (list/map variableL.captured))))
+ resolver' (if (and (functionS.nested? function-arity)
direct?)
(list/fold (function [[from to] resolver']
- (dict;put from to resolver'))
+ (dict.put from to resolver'))
init-resolver
- (list;zip2 env-vars env))
+ (list.zip2 env-vars env))
(list/fold (function [var resolver']
- (dict;put var var resolver'))
+ (dict.put var var resolver'))
init-resolver
env-vars))]
(case (recur function-arity resolver' true function-arity bodyA)
- (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat unmerged-arity)] env' bodyS'))])
- (let [merged-arity (n.inc unmerged-arity)]
+ (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat unmerged-arity)] env' bodyS'))])
+ (let [merged-arity (n/inc unmerged-arity)]
(function$ merged-arity env
(prepare-body function-arity merged-arity bodyS')))
@@ -189,7 +189,7 @@
(^code ("lux apply" (~@ _)))
(synthesize-apply (recur arity resolver false num-locals) num-locals expressionA)
- (^code ((~ [_ (#;Text name)]) (~@ args)))
+ (^code ((~ [_ (#.Text name)]) (~@ args)))
(procedure$ name (list/map (recur arity resolver false num-locals) args))
_
diff --git a/new-luxc/source/luxc/lang/synthesis/function.lux b/new-luxc/source/luxc/lang/synthesis/function.lux
index 52aee9a49..25dd75aff 100644
--- a/new-luxc/source/luxc/lang/synthesis/function.lux
+++ b/new-luxc/source/luxc/lang/synthesis/function.lux
@@ -1,29 +1,29 @@
-(;module:
+(.module:
lux
(luxc (lang ["la" analysis]
["ls" synthesis]
- [";L" variable #+ Variable])))
+ [".L" variable #+ Variable])))
(do-template [<name> <comp> <ref>]
[(def: #export (<name> arity)
- (-> ls;Arity Bool)
+ (-> ls.Arity Bool)
(<comp> <ref> arity))]
- [nested? n.> +1]
- [top? n.= +0]
+ [nested? n/> +1]
+ [top? n/= +0]
)
(def: #export (adjust-var outer var)
- (-> ls;Arity Variable Variable)
- (|> outer n.dec nat-to-int (i.+ var)))
+ (-> ls.Arity Variable Variable)
+ (|> outer n/dec nat-to-int (i/+ var)))
(def: #export (unfold-apply apply)
- (-> la;Analysis [la;Analysis (List la;Analysis)])
+ (-> la.Analysis [la.Analysis (List la.Analysis)])
(loop [apply apply
args (list)]
(case apply
(^code ("lux apply" (~ arg) (~ func)))
- (recur func (#;Cons arg args))
+ (recur func (#.Cons arg args))
_
[apply args])))
diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux
index a5da743d5..0510e2377 100644
--- a/new-luxc/source/luxc/lang/synthesis/loop.lux
+++ b/new-luxc/source/luxc/lang/synthesis/loop.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["p" parser])
@@ -7,101 +7,101 @@
(macro [code]
[syntax]))
(luxc (lang ["ls" synthesis]
- [";L" variable #+ Variable Register])))
+ [".L" variable #+ Variable Register])))
(def: #export (contains-self-reference? exprS)
- (-> ls;Synthesis Bool)
+ (-> ls.Synthesis Bool)
(case exprS
- (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))])
+ (^ [_ (#.Form (list [_ (#.Nat tag)] [_ (#.Bool last?)] memberS))])
(contains-self-reference? memberS)
- [_ (#;Tuple membersS)]
- (list;any? contains-self-reference? membersS)
+ [_ (#.Tuple membersS)]
+ (list.any? contains-self-reference? membersS)
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (variableL;self? var)
+ (^ [_ (#.Form (list [_ (#.Int var)]))])
+ (variableL.self? var)
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))])
(or (contains-self-reference? inputS)
(loop [pathS pathS]
(case pathS
- (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]))
+ (^or (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))]))
(or (recur leftS)
(recur rightS))
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
(contains-self-reference? bodyS)
_
false)))
- (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
- (list;any? (function [captured]
+ (^ [_ (#.Form (list [_ (#.Text "lux function")] arity [_ (#.Tuple environment)] bodyS))])
+ (list.any? (function [captured]
(case captured
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (variableL;self? var)
+ (^ [_ (#.Form (list [_ (#.Int var)]))])
+ (variableL.self? var)
_
false))
environment)
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
+ (^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))])
(or (contains-self-reference? funcS)
- (list;any? contains-self-reference? argsS))
+ (list.any? contains-self-reference? argsS))
- (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))])
(or (contains-self-reference? inputS)
(contains-self-reference? bodyS))
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))])
(or (contains-self-reference? inputS)
(contains-self-reference? thenS)
(contains-self-reference? elseS))
- (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))])
- (or (list;any? contains-self-reference? initsS)
+ (^ [_ (#.Form (list [_ (#.Text "lux loop")] offset [_ (#.Tuple initsS)] bodyS))])
+ (or (list.any? contains-self-reference? initsS)
(contains-self-reference? bodyS))
- (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
- (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]))
- (list;any? contains-self-reference? argsS)
+ (^or (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))])
+ (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))]))
+ (list.any? contains-self-reference? argsS)
_
false
))
(def: #export (reify-recursion arity exprS)
- (-> Nat ls;Synthesis ls;Synthesis)
+ (-> Nat ls.Synthesis ls.Synthesis)
(loop [exprS exprS]
(case exprS
- (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))])
(` ("lux case" (~ inputS)
(~ (let [reify-recursion' recur]
(loop [pathS pathS]
(case pathS
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))])
(` ("lux case alt" (~ (recur leftS)) (~ (recur rightS))))
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))])
(` ("lux case seq" (~ leftS) (~ (recur rightS))))
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
(` ("lux case exec" (~ (reify-recursion' bodyS))))
_
pathS))))))
- (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")]
- [_ (#;Form (list [_ (#;Int 0)]))]
+ (^multi (^ [_ (#.Form (list& [_ (#.Text "lux call")]
+ [_ (#.Form (list [_ (#.Int 0)]))]
argsS))])
- (n.= arity (list;size argsS)))
+ (n/= arity (list.size argsS)))
(` ("lux recur" (~@ argsS)))
- (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))])
(` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))])
(` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS))))
_
@@ -109,15 +109,15 @@
)))
(def: #export (adjust env offset exprS)
- (-> (List Variable) Register ls;Synthesis ls;Synthesis)
+ (-> (List Variable) Register ls.Synthesis ls.Synthesis)
(let [resolve-captured (: (-> Variable Variable)
(function [var]
- (let [idx (|> var (i.* -1) int-to-nat n.dec)]
- (|> env (list;nth idx) maybe;assume))))]
+ (let [idx (|> var (i/* -1) int-to-nat n/dec)]
+ (|> env (list.nth idx) maybe.assume))))]
(loop [exprS exprS]
(case exprS
- (^code ((~ [_ (#;Nat tag)]) (~ last?) (~ valueS)))
- (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS))))
+ (^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS)))
+ (` ((~ (code.nat tag)) (~ last?) (~ (recur valueS))))
(^code [(~@ members)])
(` [(~@ (list/map recur members))])
@@ -128,15 +128,15 @@
(loop [pathS pathS]
(case pathS
(^template [<pattern>]
- (^ [_ (#;Form (list [_ (#;Text <pattern>)] leftS rightS))])
+ (^ [_ (#.Form (list [_ (#.Text <pattern>)] leftS rightS))])
(` (<pattern> (~ (recur leftS)) (~ (recur rightS)))))
(["lux case alt"]
["lux case seq"])
- (^code ("lux case bind" (~ [_ (#;Nat register)])))
- (` ("lux case bind" (~ (code;nat (n.+ offset register)))))
+ (^code ("lux case bind" (~ [_ (#.Nat register)])))
+ (` ("lux case bind" (~ (code.nat (n/+ offset register)))))
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
(` ("lux case exec" (~ (adjust' bodyS))))
_
@@ -146,42 +146,42 @@
(` ("lux function" (~ arity)
[(~@ (list/map (function [_var]
(case _var
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (` ((~ (code;int (resolve-captured var)))))
+ (^ [_ (#.Form (list [_ (#.Int var)]))])
+ (` ((~ (code.int (resolve-captured var)))))
_
_var))
environment))]
(~ bodyS)))
- (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
+ (^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))])
(` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
- (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
+ (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))])
(` ("lux recur" (~@ (list/map recur argsS))))
- (^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ bodyS)))
- (` ("lux let" (~ (code;nat (n.+ offset register)))
+ (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS)))
+ (` ("lux let" (~ (code.nat (n/+ offset register)))
(~ (recur inputS))
(~ (recur bodyS))))
- (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
+ (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))])
(` ("lux if" (~ (recur inputS))
(~ (recur thenS))
(~ (recur elseS))))
- (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat loop-offset)] [_ (#;Tuple initsS)] bodyS))])
- (` ("lux loop" (~ (code;nat (n.+ offset loop-offset)))
+ (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat loop-offset)] [_ (#.Tuple initsS)] bodyS))])
+ (` ("lux loop" (~ (code.nat (n/+ offset loop-offset)))
[(~@ (list/map recur initsS))]
(~ (recur bodyS))))
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (if (variableL;captured? var)
- (` ((~ (code;int (resolve-captured var)))))
- (` ((~ (code;int (|> offset nat-to-int (i.+ var)))))))
+ (^ [_ (#.Form (list [_ (#.Int var)]))])
+ (if (variableL.captured? var)
+ (` ((~ (code.int (resolve-captured var)))))
+ (` ((~ (code.int (|> offset nat-to-int (i/+ var)))))))
- (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
- (` ((~ (code;text procedure)) (~@ (list/map recur argsS))))
+ (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))])
+ (` ((~ (code.text procedure)) (~@ (list/map recur argsS))))
_
exprS
diff --git a/new-luxc/source/luxc/lang/synthesis/variable.lux b/new-luxc/source/luxc/lang/synthesis/variable.lux
index 3ce9f2678..b1988018d 100644
--- a/new-luxc/source/luxc/lang/synthesis/variable.lux
+++ b/new-luxc/source/luxc/lang/synthesis/variable.lux
@@ -1,96 +1,96 @@
-(;module:
+(.module:
lux
(lux (data [number]
(coll [list "list/" Fold<List> Monoid<List>]
["s" set])))
(luxc (lang ["la" analysis]
["ls" synthesis]
- [";L" variable #+ Variable])))
+ [".L" variable #+ Variable])))
(def: (bound-vars path)
- (-> ls;Path (List Variable))
+ (-> ls.Path (List Variable))
(case path
- (#ls;BindP register)
+ (#ls.BindP register)
(list (nat-to-int register))
- (^or (#ls;SeqP pre post) (#ls;AltP pre post))
+ (^or (#ls.SeqP pre post) (#ls.AltP pre post))
(list/compose (bound-vars pre) (bound-vars post))
_
(list)))
(def: (path-bodies path)
- (-> ls;Path (List ls;Synthesis))
+ (-> ls.Path (List ls.Synthesis))
(case path
- (#ls;ExecP body)
+ (#ls.ExecP body)
(list body)
- (#ls;SeqP pre post)
+ (#ls.SeqP pre post)
(path-bodies post)
- (#ls;AltP pre post)
+ (#ls.AltP pre post)
(list/compose (path-bodies pre) (path-bodies post))
_
(list)))
(def: (non-arg? arity var)
- (-> ls;Arity Variable Bool)
- (and (variableL;local? var)
- (n.> arity (int-to-nat var))))
+ (-> ls.Arity Variable Bool)
+ (and (variableL.local? var)
+ (n/> arity (int-to-nat var))))
-(type: Tracker (s;Set Variable))
+(type: Tracker (s.Set Variable))
-(def: init-tracker Tracker (s;new number;Hash<Int>))
+(def: init-tracker Tracker (s.new number.Hash<Int>))
(def: (unused-vars current-arity bound exprS)
- (-> ls;Arity (List Variable) ls;Synthesis (List Variable))
+ (-> ls.Arity (List Variable) ls.Synthesis (List Variable))
(let [tracker (loop [exprS exprS
- tracker (list/fold s;add init-tracker bound)]
+ tracker (list/fold s.add init-tracker bound)]
(case exprS
- (#ls;Variable var)
+ (#ls.Variable var)
(if (non-arg? current-arity var)
- (s;remove var tracker)
+ (s.remove var tracker)
tracker)
- (#ls;Variant tag last? memberS)
+ (#ls.Variant tag last? memberS)
(recur memberS tracker)
- (#ls;Tuple membersS)
+ (#ls.Tuple membersS)
(list/fold recur tracker membersS)
- (#ls;Call funcS argsS)
+ (#ls.Call funcS argsS)
(list/fold recur (recur funcS tracker) argsS)
- (^or (#ls;Recur argsS)
- (#ls;Procedure name argsS))
+ (^or (#ls.Recur argsS)
+ (#ls.Procedure name argsS))
(list/fold recur tracker argsS)
- (#ls;Let offset inputS outputS)
+ (#ls.Let offset inputS outputS)
(|> tracker (recur inputS) (recur outputS))
- (#ls;If testS thenS elseS)
+ (#ls.If testS thenS elseS)
(|> tracker (recur testS) (recur thenS) (recur elseS))
- (#ls;Loop offset initsS bodyS)
+ (#ls.Loop offset initsS bodyS)
(recur bodyS (list/fold recur tracker initsS))
- (#ls;Case inputS outputPS)
- (let [tracker' (list/fold s;add
+ (#ls.Case inputS outputPS)
+ (let [tracker' (list/fold s.add
(recur inputS tracker)
(bound-vars outputPS))]
(list/fold recur tracker' (path-bodies outputPS)))
- (#ls;Function arity env bodyS)
- (list/fold s;remove tracker env)
+ (#ls.Function arity env bodyS)
+ (list/fold s.remove tracker env)
_
tracker
))]
- (s;to-list tracker)))
+ (s.to-list tracker)))
## (def: (optimize-register-use current-arity [pathS bodyS])
-## (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis])
+## (-> ls.Arity [ls.Path ls.Synthesis] [ls.Path ls.Synthesis])
## (let [bound (bound-vars pathS)
## unused (unused-vars current-arity bound bodyS)
## adjusted (adjust-vars unused bound)]
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 86b9842b6..07f1fe533 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -16,160 +16,160 @@
[io #+ IO Process io]
(world [file #+ File]))
(luxc ["&" lang]
- ["&;" io]
- (lang [";L" module]
- [";L" host]
- [";L" macro]
+ ["&." io]
+ (lang [".L" module]
+ [".L" host]
+ [".L" macro]
(host ["$" jvm])
- (analysis [";A" expression]
- [";A" common])
- (synthesis [";S" expression])
- (translation [";T" runtime]
- [";T" statement]
- [";T" common]
- [";T" expression]
- [";T" eval]
- [";T" imports])
- ["&;" eval])
+ (analysis [".A" expression]
+ [".A" common])
+ (synthesis [".S" expression])
+ (translation [".T" runtime]
+ [".T" statement]
+ [".T" common]
+ [".T" expression]
+ [".T" eval]
+ [".T" imports])
+ ["&." eval])
))
(def: analyse
- (&;Analyser)
- (expressionA;analyser &eval;eval))
+ (&.Analyser)
+ (expressionA.analyser &eval.eval))
(exception: #export Macro-Expansion-Failed)
(exception: #export Unrecognized-Statement)
(exception: #export Invalid-Alias)
(def: (process-annotations annsC)
- (-> Code (Meta [$;Inst Code]))
- (do macro;Monad<Meta>
- [[_ annsA] (&;with-scope
- (&;with-type Code
+ (-> Code (Meta [$.Inst Code]))
+ (do macro.Monad<Meta>
+ [[_ annsA] (&.with-scope
+ (&.with-type Code
(analyse annsC)))
- annsI (expressionT;translate (expressionS;synthesize annsA))
- annsV (evalT;eval annsI)]
+ annsI (expressionT.translate (expressionS.synthesize annsA))
+ annsV (evalT.eval annsI)]
(wrap [annsI (:! Code annsV)])))
(def: (switch-compiler new-compiler)
(-> Compiler (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))))
+ ((do macro.Monad<Meta>
+ [this macro.current-module]
+ (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 [])
+ (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
+ (|> pairs list.size (n/= +1)))
+ (:: macro.Monad<Meta> wrap [])
_
- (&;throw Invalid-Alias def-name)))
+ (&.throw Invalid-Alias def-name)))
(def: #export (translate translate-module aliases code)
(-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases))
(case code
- (^code ((~ [_ (#;Symbol macro-name)]) (~@ args)))
- (do macro;Monad<Meta>
- [?macro (&;with-error-tracking
- (macro;find-macro macro-name))]
+ (^code ((~ [_ (#.Symbol macro-name)]) (~@ args)))
+ (do macro.Monad<Meta>
+ [?macro (&.with-error-tracking
+ (macro.find-macro macro-name))]
(case ?macro
- (#;Some macro)
+ (#.Some macro)
(do @
[expansion (: (Meta (List Code))
(function [compiler]
- (case (macroL;expand macro args compiler)
- (#e;Error error)
- ((&;throw Macro-Expansion-Failed error) compiler)
+ (case (macroL.expand macro args compiler)
+ (#e.Error error)
+ ((&.throw Macro-Expansion-Failed error) compiler)
output
output)))
- expansion-aliases (monad;map @ (translate translate-module aliases) expansion)]
- (if (dict;empty? aliases)
+ expansion-aliases (monad.map @ (translate translate-module aliases) expansion)]
+ (if (dict.empty? aliases)
(loop [expansion-aliases expansion-aliases]
(case expansion-aliases
- #;Nil
+ #.Nil
(wrap aliases)
- (#;Cons head tail)
- (if (dict;empty? head)
+ (#.Cons head tail)
+ (if (dict.empty? head)
(recur tail)
(wrap head))))
(wrap aliases)))
- #;None
- (&;throw Unrecognized-Statement (%code code))))
+ #.None
+ (&.throw Unrecognized-Statement (%code code))))
- (^code ("lux def" (~ [_ (#;Symbol ["" def-name])]) (~ valueC) (~ annsC)))
- (hostL;with-context def-name
- (&;with-fresh-type-env
- (do macro;Monad<Meta>
+ (^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)
+ (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))]
+ _ (&.with-scope
+ (statementT.translate-def def-name Void id annsI annsV))]
(wrap aliases))
- #;None
+ #.None
(do @
- [[_ valueT valueA] (&;with-scope
- (if (macro;type? (:! Code annsV))
+ [[_ valueT valueA] (&.with-scope
+ (if (macro.type? (:! Code annsV))
(do @
- [valueA (&;with-type Type
+ [valueA (&.with-type Type
(analyse valueC))]
(wrap [Type valueA]))
- (commonA;with-unknown-type
+ (commonA.with-unknown-type
(analyse valueC))))
- valueT (&;with-type-env
- (tc;clean valueT))
+ 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))))
+ ## "SYNTHESIS: " (%code (expressionS.synthesize valueA))))
## [])]
- valueI (expressionT;translate (expressionS;synthesize valueA))
- _ (&;with-scope
- (statementT;translate-def def-name valueT valueI annsI annsV))]
+ 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>
+ (do macro.Monad<Meta>
[[annsI annsV] (process-annotations annsC)
- process (importsT;translate-imports translate-module annsV)]
- (case (io;run process)
- (#e;Success compiler')
+ process (importsT.translate-imports translate-module annsV)]
+ (case (io.run process)
+ (#e.Success compiler')
(switch-compiler compiler')
- (#e;Error error)
- (macro;fail error)))
+ (#e.Error error)
+ (macro.fail error)))
- (^code ("lux program" (~ [_ (#;Symbol ["" program-args])]) (~ programC)))
- (do macro;Monad<Meta>
- [[_ programA] (&;with-scope
- (&;with-type (type (io;IO Unit))
+ (^code ("lux program" (~ [_ (#.Symbol ["" program-args])]) (~ programC)))
+ (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)]
+ programI (expressionT.translate (expressionS.synthesize programA))
+ _ (statementT.translate-program program-args programI)]
(wrap aliases))
_
- (&;throw Unrecognized-Statement (%code code))))
+ (&.throw Unrecognized-Statement (%code code))))
(def: (forgive-eof action)
(-> (Meta Unit) (Meta Unit))
(function [compiler]
(case (action compiler)
- (#e;Error error)
- (if (ex;match? syntax;End-Of-File error)
- (#e;Success [compiler []])
- (#e;Error error))
+ (#e.Error error)
+ (if (ex.match? syntax.End-Of-File error)
+ (#e.Success [compiler []])
+ (#e.Error error))
output
output)))
@@ -178,103 +178,103 @@
(def: (with-active-compilation [module-name file-name source-code] action)
(All [a] (-> [Text Text Text] (Meta a) (Meta a)))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[#let [init-cursor [file-name +1 +0]]
- output (&;with-source-code [init-cursor +0 source-code]
+ output (&.with-source-code [init-cursor +0 source-code]
action)
- _ (moduleL;flag-compiled! module-name)]
+ _ (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)
+ (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)
+ (#e.Success [source' output])
+ (#e.Success [(set@ #.source source' compiler)
output]))))
(def: #export (translate-module source-dirs target-dir module-name compiler)
(-> (List File) File Text Compiler (Process Compiler))
- (do io;Monad<Process>
- [## _ (&io;prepare-module target-dir module-name)
- [file-name file-content] (&io;read-module source-dirs module-name)
+ (do io.Monad<Process>
+ [## _ (&io.prepare-module target-dir module-name)
+ [file-name file-content] (&io.read-module 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>
- [[_ artifacts _] (moduleL;with-module module-hash module-name
- (commonT;with-artifacts
+ (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>))]
+ (dict.new text.Hash<Text>))]
(do @
[code (read module-name aliases)
#let [[cursor _] code]
- aliases' (&;with-cursor cursor
+ aliases' (&.with-cursor cursor
(translate translate-module aliases code))]
(forgive-eof (recur aliases'))))))))]
(wrap artifacts)))
- (#e;Success [compiler artifacts])
+ (#e.Success [compiler artifacts])
(do @
- [## _ (monad;map @ (function [[class-name class-bytecode]]
- ## (&io;write-file target-dir class-name class-bytecode))
- ## (dict;entries artifacts))
+ [## _ (monad.map @ (function [[class-name class-bytecode]]
+ ## (&io.write-file target-dir class-name class-bytecode))
+ ## (dict.entries artifacts))
]
(wrap compiler))
- (#e;Error error)
- (io;fail error))))
+ (#e.Error error)
+ (io.fail error))))
(def: init-cursor Cursor ["" +1 +0])
(def: #export init-type-context
Type-Context
- {#;ex-counter +0
- #;var-counter +0
- #;var-bindings (list)})
+ {#.ex-counter +0
+ #.var-counter +0
+ #.var-bindings (list)})
(def: #export init-info
Info
- {#;target (for {"JVM" "JVM"
+ {#.target (for {"JVM" "JVM"
"JS" "JS"})
- #;version &;version
- #;mode #;Build})
+ #.version &.version
+ #.mode #.Build})
(def: #export (init-compiler host)
- (-> commonT;Host Compiler)
- {#;info init-info
- #;source [init-cursor +0 ""]
- #;cursor init-cursor
- #;current-module #;None
- #;modules (list)
- #;scopes (list)
- #;type-context init-type-context
- #;expected #;None
- #;seed +0
- #;scope-type-vars (list)
- #;host (:! Void host)})
+ (-> commonT.Host Compiler)
+ {#.info init-info
+ #.source [init-cursor +0 ""]
+ #.cursor init-cursor
+ #.current-module #.None
+ #.modules (list)
+ #.scopes (list)
+ #.type-context init-type-context
+ #.expected #.None
+ #.seed +0
+ #.scope-type-vars (list)
+ #.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)
+ (-> (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)
- (#e;Success [compiler [runtime-bc function-bc]])
+ (#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)]
+ [_ (&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))
+ (: (T.Task Compiler))
+ (:: @ map (|>> (translate-module sources target prelude) P.future)) (:: @ join)
+ (:: @ map (|>> (translate-module sources target program) P.future)) (:: @ join))
#let [_ (log! "Compilation complete!")]]
(wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/case.jvm.lux b/new-luxc/source/luxc/lang/translation/case.jvm.lux
index 3363e007c..b693f50b8 100644
--- a/new-luxc/source/luxc/lang/translation/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/case.jvm.lux
@@ -1,130 +1,130 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data text/format)
[macro "macro/" Monad<Meta>])
(luxc ["_" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$i" inst]))
["ls" synthesis]))
[//runtime])
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
(def: (pop-altI stack-depth)
- (-> Nat $;Inst)
+ (-> Nat $.Inst)
(case stack-depth
+0 id
- +1 $i;POP
- +2 $i;POP2
- _ ## (n.> +2)
- (|>. $i;POP2
- (pop-altI (n.- +2 stack-depth)))))
+ +1 $i.POP
+ +2 $i.POP2
+ _ ## (n/> +2)
+ (|>> $i.POP2
+ (pop-altI (n/- +2 stack-depth)))))
(def: peekI
- $;Inst
- (|>. $i;DUP
- ($i;INVOKESTATIC hostL;runtime-class
+ $.Inst
+ (|>> $i.DUP
+ ($i.INVOKESTATIC hostL.runtime-class
"pm_peek"
- ($t;method (list //runtime;$Stack)
- (#;Some $Object)
+ ($t.method (list //runtime.$Stack)
+ (#.Some $Object)
(list))
false)))
(def: popI
- $;Inst
- (|>. ($i;INVOKESTATIC hostL;runtime-class
+ $.Inst
+ (|>> ($i.INVOKESTATIC hostL.runtime-class
"pm_pop"
- ($t;method (list //runtime;$Stack)
- (#;Some //runtime;$Stack)
+ ($t.method (list //runtime.$Stack)
+ (#.Some //runtime.$Stack)
(list))
false)))
(def: pushI
- $;Inst
- (|>. ($i;INVOKESTATIC hostL;runtime-class
+ $.Inst
+ (|>> ($i.INVOKESTATIC hostL.runtime-class
"pm_push"
- ($t;method (list //runtime;$Stack $Object)
- (#;Some //runtime;$Stack)
+ ($t.method (list //runtime.$Stack $Object)
+ (#.Some //runtime.$Stack)
(list))
false)))
(exception: #export Unrecognized-Path)
(def: (translate-path' translate stack-depth @else @end path)
- (-> (-> ls;Synthesis (Meta $;Inst))
- Nat $;Label $;Label ls;Path (Meta $;Inst))
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ Nat $.Label $.Label ls.Path (Meta $.Inst))
(case path
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (do macro;Monad<Meta>
+ (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
+ (do macro.Monad<Meta>
[bodyI (translate bodyS)]
- (wrap (|>. (pop-altI stack-depth)
+ (wrap (|>> (pop-altI stack-depth)
bodyI
- ($i;GOTO @end))))
+ ($i.GOTO @end))))
- (^ [_ (#;Form (list [_ (#;Text "lux case pop")]))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case pop")]))])
(macro/wrap popI)
- (^ [_ (#;Form (list [_ (#;Text "lux case bind")] [_ (#;Nat register)]))])
- (macro/wrap (|>. peekI
- ($i;ASTORE register)))
+ (^ [_ (#.Form (list [_ (#.Text "lux case bind")] [_ (#.Nat register)]))])
+ (macro/wrap (|>> peekI
+ ($i.ASTORE register)))
- [_ (#;Bool value)]
- (macro/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)]
- (|>. peekI
- ($i;unwrap #$;Boolean)
+ [_ (#.Bool value)]
+ (macro/wrap (let [jumpI (if value $i.IFEQ $i.IFNE)]
+ (|>> peekI
+ ($i.unwrap #$.Boolean)
(jumpI @else))))
(^template [<tag> <prep>]
[_ (<tag> value)]
- (macro/wrap (|>. peekI
- ($i;unwrap #$;Long)
- ($i;long (|> value <prep>))
- $i;LCMP
- ($i;IFNE @else))))
- ([#;Nat (:! Int)]
- [#;Int (: Int)]
- [#;Deg (:! Int)])
-
- [_ (#;Frac value)]
- (macro/wrap (|>. peekI
- ($i;unwrap #$;Double)
- ($i;double value)
- $i;DCMPL
- ($i;IFNE @else)))
+ (macro/wrap (|>> peekI
+ ($i.unwrap #$.Long)
+ ($i.long (|> value <prep>))
+ $i.LCMP
+ ($i.IFNE @else))))
+ ([#.Nat (:! Int)]
+ [#.Int (: Int)]
+ [#.Deg (:! Int)])
+
+ [_ (#.Frac value)]
+ (macro/wrap (|>> peekI
+ ($i.unwrap #$.Double)
+ ($i.double value)
+ $i.DCMPL
+ ($i.IFNE @else)))
- [_ (#;Text value)]
- (macro/wrap (|>. peekI
- ($i;string value)
- ($i;INVOKEVIRTUAL "java.lang.Object"
+ [_ (#.Text value)]
+ (macro/wrap (|>> peekI
+ ($i.string value)
+ ($i.INVOKEVIRTUAL "java.lang.Object"
"equals"
- ($t;method (list $Object)
- (#;Some $t;boolean)
+ ($t.method (list $Object)
+ (#.Some $t.boolean)
(list))
false)
- ($i;IFEQ @else)))
+ ($i.IFEQ @else)))
(^template [<special> <method>]
- (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)]))])
+ (^ [_ (#.Form (list [_ (#.Text <special>)] [_ (#.Nat idx)]))])
(macro/wrap (case idx
+0
- (|>. peekI
- ($i;CHECKCAST ($t;descriptor //runtime;$Tuple))
- ($i;int 0)
- $i;AALOAD
+ (|>> peekI
+ ($i.CHECKCAST ($t.descriptor //runtime.$Tuple))
+ ($i.int 0)
+ $i.AALOAD
pushI)
_
- (|>. peekI
- ($i;CHECKCAST ($t;descriptor //runtime;$Tuple))
- ($i;int (nat-to-int idx))
- ($i;INVOKESTATIC hostL;runtime-class
+ (|>> peekI
+ ($i.CHECKCAST ($t.descriptor //runtime.$Tuple))
+ ($i.int (nat-to-int idx))
+ ($i.INVOKESTATIC hostL.runtime-class
<method>
- ($t;method (list //runtime;$Tuple $t;int)
- (#;Some $Object)
+ ($t.method (list //runtime.$Tuple $t.int)
+ (#.Some $Object)
(list))
false)
pushI))))
@@ -132,99 +132,99 @@
["lux case tuple right" "pm_right"])
(^template [<special> <flag>]
- (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)]))])
- (macro/wrap (<| $i;with-label (function [@success])
- $i;with-label (function [@fail])
- (|>. peekI
- ($i;CHECKCAST ($t;descriptor //runtime;$Variant))
- ($i;int (nat-to-int idx))
+ (^ [_ (#.Form (list [_ (#.Text <special>)] [_ (#.Nat idx)]))])
+ (macro/wrap (<| $i.with-label (function [@success])
+ $i.with-label (function [@fail])
+ (|>> peekI
+ ($i.CHECKCAST ($t.descriptor //runtime.$Variant))
+ ($i.int (nat-to-int idx))
<flag>
- ($i;INVOKESTATIC hostL;runtime-class "pm_variant"
- ($t;method (list //runtime;$Variant //runtime;$Tag //runtime;$Flag)
- (#;Some //runtime;$Datum)
+ ($i.INVOKESTATIC hostL.runtime-class "pm_variant"
+ ($t.method (list //runtime.$Variant //runtime.$Tag //runtime.$Flag)
+ (#.Some //runtime.$Datum)
(list))
false)
- $i;DUP
- ($i;IFNULL @fail)
- ($i;GOTO @success)
- ($i;label @fail)
- $i;POP
- ($i;GOTO @else)
- ($i;label @success)
+ $i.DUP
+ ($i.IFNULL @fail)
+ ($i.GOTO @success)
+ ($i.label @fail)
+ $i.POP
+ ($i.GOTO @else)
+ ($i.label @success)
pushI))))
- (["lux case variant left" $i;NULL]
- ["lux case variant right" ($i;string "")])
+ (["lux case variant left" $i.NULL]
+ ["lux case variant right" ($i.string "")])
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftP rightP))])
- (do macro;Monad<Meta>
+ (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftP rightP))])
+ (do macro.Monad<Meta>
[leftI (translate-path' translate stack-depth @else @end leftP)
rightI (translate-path' translate stack-depth @else @end rightP)]
- (wrap (|>. leftI
+ (wrap (|>> leftI
rightI)))
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftP rightP))])
- (do macro;Monad<Meta>
- [@alt-else $i;make-label
- leftI (translate-path' translate (n.inc stack-depth) @alt-else @end leftP)
+ (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftP rightP))])
+ (do macro.Monad<Meta>
+ [@alt-else $i.make-label
+ leftI (translate-path' translate (n/inc stack-depth) @alt-else @end leftP)
rightI (translate-path' translate stack-depth @else @end rightP)]
- (wrap (|>. $i;DUP
+ (wrap (|>> $i.DUP
leftI
- ($i;label @alt-else)
- $i;POP
+ ($i.label @alt-else)
+ $i.POP
rightI)))
_
- (_;throw Unrecognized-Path (%code path))))
+ (_.throw Unrecognized-Path (%code path))))
(def: (translate-path translate path @end)
- (-> (-> ls;Synthesis (Meta $;Inst))
- ls;Path $;Label (Meta $;Inst))
- (do macro;Monad<Meta>
- [@else $i;make-label
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ ls.Path $.Label (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [@else $i.make-label
pathI (translate-path' translate +1 @else @end path)]
- (wrap (|>. pathI
- ($i;label @else)
- $i;POP
- ($i;INVOKESTATIC hostL;runtime-class
+ (wrap (|>> pathI
+ ($i.label @else)
+ $i.POP
+ ($i.INVOKESTATIC hostL.runtime-class
"pm_fail"
- ($t;method (list) #;None (list))
+ ($t.method (list) #.None (list))
false)
- $i;NULL
- ($i;GOTO @end)))))
+ $i.NULL
+ ($i.GOTO @end)))))
(def: #export (translate-if testI thenI elseI)
- (-> $;Inst $;Inst $;Inst $;Inst)
- (<| $i;with-label (function [@else])
- $i;with-label (function [@end])
- (|>. testI
- ($i;unwrap #$;Boolean)
- ($i;IFEQ @else)
+ (-> $.Inst $.Inst $.Inst $.Inst)
+ (<| $i.with-label (function [@else])
+ $i.with-label (function [@end])
+ (|>> testI
+ ($i.unwrap #$.Boolean)
+ ($i.IFEQ @else)
thenI
- ($i;GOTO @end)
- ($i;label @else)
+ ($i.GOTO @end)
+ ($i.label @else)
elseI
- ($i;label @end))))
+ ($i.label @end))))
(def: #export (translate-case translate valueS path)
- (-> (-> ls;Synthesis (Meta $;Inst))
- ls;Synthesis ls;Path (Meta $;Inst))
- (do macro;Monad<Meta>
- [@end $i;make-label
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ ls.Synthesis ls.Path (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [@end $i.make-label
valueI (translate valueS)
pathI (translate-path translate path @end)]
- (wrap (|>. valueI
- $i;NULL
- $i;SWAP
+ (wrap (|>> valueI
+ $i.NULL
+ $i.SWAP
pushI
pathI
- ($i;label @end)))))
+ ($i.label @end)))))
(def: #export (translate-let translate register inputS exprS)
- (-> (-> ls;Synthesis (Meta $;Inst))
- Nat ls;Synthesis ls;Synthesis (Meta $;Inst))
- (do macro;Monad<Meta>
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ Nat ls.Synthesis ls.Synthesis (Meta $.Inst))
+ (do macro.Monad<Meta>
[inputI (translate inputS)
exprI (translate exprS)]
- (wrap (|>. inputI
- ($i;ASTORE register)
+ (wrap (|>> inputI
+ ($i.ASTORE register)
exprI))))
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index 7a16a749a..b75b0672b 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
[lux #- function]
(lux (control ["ex" exception #+ exception:])
[io]
@@ -10,22 +10,22 @@
[host]
(world [blob #+ Blob]
[file #+ File]))
- (luxc (lang [";L" variable #+ Register]
+ (luxc (lang [".L" variable #+ Register]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst])))))
-(host;import org.objectweb.asm.Opcodes
+(host.import org/objectweb/asm/Opcodes
(#static V1_6 int))
-(host;import org.objectweb.asm.Label)
+(host.import org/objectweb/asm/Label)
-(host;import java.lang.Object)
+(host.import java/lang/Object)
-(host;import (java.lang.Class a))
+(host.import (java/lang/Class a))
-(host;import java.lang.ClassLoader
+(host.import java/lang/ClassLoader
(loadClass [String] (Class Object)))
(type: #export Bytecode Blob)
@@ -48,57 +48,57 @@
(def: #export (with-artifacts action)
(All [a] (-> (Meta a) (Meta [Artifacts a])))
- (;function [compiler]
- (case (action (update@ #;host
- (|>. (:! Host)
- (set@ #artifacts (dict;new text;Hash<Text>))
+ (.function [compiler]
+ (case (action (update@ #.host
+ (|>> (:! Host)
+ (set@ #artifacts (dict.new text.Hash<Text>))
(:! Void))
compiler))
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;host
- (|>. (:! Host)
- (set@ #artifacts (|> (get@ #;host compiler) (:! Host) (get@ #artifacts)))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! Host)
+ (set@ #artifacts (|> (get@ #.host compiler) (:! Host) (get@ #artifacts)))
(:! Void))
compiler')
- [(|> compiler' (get@ #;host) (:! Host) (get@ #artifacts))
+ [(|> compiler' (get@ #.host) (:! Host) (get@ #artifacts))
output]])
- (#e;Error error)
- (#e;Error error))))
+ (#e.Error error)
+ (#e.Error error))))
(def: #export (record-artifact name content)
(-> Text Blob (Meta Unit))
- (;function [compiler]
- (if (|> compiler (get@ #;host) (:! Host) (get@ #artifacts) (dict;contains? name))
- (ex;throw Cannot-Overwrite-Artifact name)
- (#e;Success [(update@ #;host
- (|>. (:! Host)
- (update@ #artifacts (dict;put name content))
+ (.function [compiler]
+ (if (|> compiler (get@ #.host) (:! Host) (get@ #artifacts) (dict.contains? name))
+ (ex.throw Cannot-Overwrite-Artifact name)
+ (#e.Success [(update@ #.host
+ (|>> (:! Host)
+ (update@ #artifacts (dict.put name content))
(:! Void))
compiler)
[]]))))
(def: #export (store-class name byte-code)
(-> Text Bytecode (Meta Unit))
- (;function [compiler]
- (let [store (|> (get@ #;host compiler)
+ (.function [compiler]
+ (let [store (|> (get@ #.host compiler)
(:! Host)
(get@ #store))]
- (if (dict;contains? name (|> store atom;read io;run))
- (ex;throw Class-Already-Stored name)
- (#e;Success [compiler (io;run (atom;update (dict;put name byte-code) store))])
+ (if (dict.contains? name (|> store atom.read io.run))
+ (ex.throw Class-Already-Stored name)
+ (#e.Success [compiler (io.run (atom.update (dict.put name byte-code) store))])
))))
(def: #export (load-class name)
(-> Text (Meta (Class Object)))
- (;function [compiler]
- (let [host (:! Host (get@ #;host compiler))
- store (|> host (get@ #store) atom;read io;run)]
- (if (dict;contains? name store)
- (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
- (ex;throw Unknown-Class name)))))
+ (.function [compiler]
+ (let [host (:! Host (get@ #.host compiler))
+ store (|> host (get@ #store) atom.read io.run)]
+ (if (dict.contains? name store)
+ (#e.Success [compiler (ClassLoader::loadClass [name] (get@ #loader host))])
+ (ex.throw Unknown-Class name)))))
-(def: #export bytecode-version Int Opcodes.V1_6)
+## (def: #export bytecode-version Int Opcodes::V1_6)
(def: #export value-field Text "_value")
-(def: #export $Object $;Type ($t;class "java.lang.Object" (list)))
+(def: #export $Object $.Type ($t.class "java.lang.Object" (list)))
diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
index 6b9ee9743..9cce16a49 100644
--- a/new-luxc/source/luxc/lang/translation/eval.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad)
(data [text]
@@ -12,72 +12,36 @@
["$i" inst]))
["la" analysis]
["ls" synthesis]
- (translation [";T" common]))
+ (translation [".T" common]))
))
-(host;import java.lang.Object)
-(host;import java.lang.String)
-
-(host;import java.lang.reflect.Field
+(host.import java/lang/reflect/Field
(get [Object] Object))
-(host;import (java.lang.Class a)
+(host.import (java/lang/Class a)
(getField [String] Field))
-(host;import org.objectweb.asm.Opcodes
- (#static ACC_PUBLIC int)
- (#static ACC_SUPER int)
- (#static ACC_FINAL int)
- (#static ACC_STATIC int)
- (#static PUTSTATIC int)
- (#static RETURN int)
- (#static V1_6 int)
- )
-
-(host;import org.objectweb.asm.MethodVisitor
- (visitCode [] void)
- (visitEnd [] void)
- (visitLdcInsn [Object] void)
- (visitFieldInsn [int String String String] void)
- (visitInsn [int] void)
- (visitMaxs [int int] void))
-
-(host;import org.objectweb.asm.FieldVisitor
- (visitEnd [] void))
-
-(host;import org.objectweb.asm.ClassWriter
- (#static COMPUTE_MAXS int)
- (new [int])
- (visit [int int String String String (Array String)] void)
- (visitEnd [] void)
- (visitField [int String String String Object] FieldVisitor)
- (visitMethod [int String String String (Array String)] MethodVisitor)
- (toByteArray [] (Array byte)))
-
(def: #export (eval valueI)
- (-> $;Inst (Meta Top))
- (do macro;Monad<Meta>
- [current-module macro;current-module-name
- class-name (:: @ map %code (macro;gensym (format current-module "/eval")))
- #let [store-name (text;replace-all "/" "." class-name)
- writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
- (ClassWriter.visit [commonT;bytecode-version
- (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER)
- class-name
- (host;null)
- "java/lang/Object"
- (host;null)]))
- ($d;field #$;Public ($_ $;++F $;finalF $;staticF)
- commonT;value-field commonT;$Object)
- ($d;method #$;Public ($_ $;++M $;staticM $;strictM)
- "<clinit>"
- ($t;method (list) #;None (list))
- (|>. valueI
- ($i;PUTSTATIC store-name commonT;value-field commonT;$Object)
- $i;RETURN)))
- bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
- _ (commonT;store-class store-name bytecode)
- class (commonT;load-class store-name)]
+ (-> $.Inst (Meta Top))
+ (do macro.Monad<Meta>
+ [current-module macro.current-module-name
+ class-name (:: @ map %code (macro.gensym (format current-module "/eval")))
+ #let [store-name (text.replace-all "/" "." class-name)
+ bytecode ($d.class #$.V1_6
+ #$.Public $.noneC
+ class-name
+ (list) ["java.lang.Object" (list)]
+ (list)
+ (|>> ($d.field #$.Public ($_ $.++F $.finalF $.staticF)
+ commonT.value-field commonT.$Object)
+ ($d.method #$.Public ($_ $.++M $.staticM $.strictM)
+ "<clinit>"
+ ($t.method (list) #.None (list))
+ (|>> valueI
+ ($i.PUTSTATIC store-name commonT.value-field commonT.$Object)
+ $i.RETURN))))]
+ _ (commonT.store-class store-name bytecode)
+ class (commonT.load-class store-name)]
(wrap (|> class
- (Class.getField [commonT;value-field])
- (Field.get (host;null))))))
+ (Class::getField [commonT.value-field])
+ (Field::get (host.null))))))
diff --git a/new-luxc/source/luxc/lang/translation/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
index 65bb5b772..c75ef0a19 100644
--- a/new-luxc/source/luxc/lang/translation/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad
["ex" exception #+ exception:]
@@ -8,25 +8,25 @@
[macro]
(macro ["s" syntax]))
(luxc ["&" lang]
- (lang [";L" variable #+ Variable Register]
+ (lang [".L" variable #+ Variable Register]
(host ["$" jvm])
["ls" synthesis]
- (translation [";T" common]
- [";T" primitive]
- [";T" structure]
- [";T" eval]
- [";T" procedure]
- [";T" function]
- [";T" reference]
- [";T" case]))))
+ (translation [".T" common]
+ [".T" primitive]
+ [".T" structure]
+ [".T" eval]
+ [".T" procedure]
+ [".T" function]
+ [".T" reference]
+ [".T" case]))))
(exception: #export Unrecognized-Synthesis)
(def: #export (translate synthesis)
- (-> ls;Synthesis (Meta $;Inst))
+ (-> ls.Synthesis (Meta $.Inst))
(case synthesis
(^code [])
- primitiveT;translate-unit
+ primitiveT.translate-unit
(^code [(~ singleton)])
(translate singleton)
@@ -34,43 +34,43 @@
(^template [<tag> <generator>]
[_ (<tag> value)]
(<generator> value))
- ([#;Bool primitiveT;translate-bool]
- [#;Nat primitiveT;translate-nat]
- [#;Int primitiveT;translate-int]
- [#;Deg primitiveT;translate-deg]
- [#;Frac primitiveT;translate-frac]
- [#;Text primitiveT;translate-text])
+ ([#.Bool primitiveT.translate-bool]
+ [#.Nat primitiveT.translate-nat]
+ [#.Int primitiveT.translate-int]
+ [#.Deg primitiveT.translate-deg]
+ [#.Frac primitiveT.translate-frac]
+ [#.Text primitiveT.translate-text])
- (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Bool last?)]) (~ valueS)))
- (structureT;translate-variant translate tag last? valueS)
+ (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS)))
+ (structureT.translate-variant translate tag last? valueS)
(^code [(~@ members)])
- (structureT;translate-tuple translate members)
+ (structureT.translate-tuple translate members)
- (^ [_ (#;Form (list [_ (#;Int var)]))])
- (if (variableL;captured? var)
- (referenceT;translate-captured var)
- (referenceT;translate-local var))
+ (^ [_ (#.Form (list [_ (#.Int var)]))])
+ (if (variableL.captured? var)
+ (referenceT.translate-captured var)
+ (referenceT.translate-local var))
- [_ (#;Symbol definition)]
- (referenceT;translate-definition definition)
+ [_ (#.Symbol definition)]
+ (referenceT.translate-definition definition)
- (^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ exprS)))
- (caseT;translate-let translate register inputS exprS)
+ (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
+ (caseT.translate-let translate register inputS exprS)
(^code ("lux case" (~ inputS) (~ pathPS)))
- (caseT;translate-case translate inputS pathPS)
+ (caseT.translate-case translate inputS pathPS)
- (^multi (^code ("lux function" (~ [_ (#;Nat arity)]) [(~@ environment)] (~ bodyS)))
- [(s;run environment (p;some s;int)) (#e;Success environment)])
- (functionT;translate-function translate environment arity bodyS)
+ (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~@ environment)] (~ bodyS)))
+ [(s.run environment (p.some s.int)) (#e.Success environment)])
+ (functionT.translate-function translate environment arity bodyS)
(^code ("lux call" (~ functionS) (~@ argsS)))
- (functionT;translate-call translate functionS argsS)
+ (functionT.translate-call translate functionS argsS)
- (^code ((~ [_ (#;Text procedure)]) (~@ argsS)))
- (procedureT;translate-procedure translate procedure argsS)
+ (^code ((~ [_ (#.Text procedure)]) (~@ argsS)))
+ (procedureT.translate-procedure translate procedure argsS)
_
- (&;throw Unrecognized-Synthesis (%code synthesis))
+ (&.throw Unrecognized-Synthesis (%code synthesis))
))
diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux
index ab3382952..3070800fe 100644
--- a/new-luxc/source/luxc/lang/translation/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do])
(data [text]
@@ -6,320 +6,320 @@
(coll [list "list/" Functor<List> Monoid<List>]))
[macro])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["la" analysis]
["ls" synthesis]
- (translation [";T" common]
- [";T" runtime]
- [";T" reference])
- [";L" variable #+ Variable])))
+ (translation [".T" common]
+ [".T" runtime]
+ [".T" reference])
+ [".L" variable #+ Variable])))
(def: arity-field Text "arity")
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
(def: (poly-arg? arity)
- (-> ls;Arity Bool)
- (n.> +1 arity))
+ (-> ls.Arity Bool)
+ (n/> +1 arity))
(def: (reset-method class)
- (-> Text $;Method)
- ($t;method (list) (#;Some ($t;class class (list))) (list)))
+ (-> Text $.Method)
+ ($t.method (list) (#.Some ($t.class class (list))) (list)))
(def: (captured-args env)
- (-> (List Variable) (List $;Type))
- (list;repeat (list;size env) $Object))
+ (-> (List Variable) (List $.Type))
+ (list.repeat (list.size env) $Object))
(def: (init-method env arity)
- (-> (List Variable) ls;Arity $;Method)
+ (-> (List Variable) ls.Arity $.Method)
(if (poly-arg? arity)
- ($t;method (list;concat (list (captured-args env)
- (list $t;int)
- (list;repeat (n.dec arity) $Object)))
- #;None
+ ($t.method (list.concat (list (captured-args env)
+ (list $t.int)
+ (list.repeat (n/dec arity) $Object)))
+ #.None
(list))
- ($t;method (captured-args env) #;None (list))))
+ ($t.method (captured-args env) #.None (list))))
(def: (implementation-method arity)
- ($t;method (list;repeat arity $Object) (#;Some $Object) (list)))
+ ($t.method (list.repeat arity $Object) (#.Some $Object) (list)))
(def: get-amount-of-partialsI
- $;Inst
- (|>. ($i;ALOAD +0)
- ($i;GETFIELD hostL;function-class runtimeT;partials-field $t;int)))
+ $.Inst
+ (|>> ($i.ALOAD +0)
+ ($i.GETFIELD hostL.function-class runtimeT.partials-field $t.int)))
(def: (load-fieldI class field)
- (-> Text Text $;Inst)
- (|>. ($i;ALOAD +0)
- ($i;GETFIELD class field $Object)))
+ (-> Text Text $.Inst)
+ (|>> ($i.ALOAD +0)
+ ($i.GETFIELD class field $Object)))
(def: (inputsI start amount)
- (-> $;Register Nat $;Inst)
- (|> (list;n.range start (n.+ start (n.dec amount)))
- (list/map $i;ALOAD)
- $i;fuse))
+ (-> $.Register Nat $.Inst)
+ (|> (list.n/range start (n/+ start (n/dec amount)))
+ (list/map $i.ALOAD)
+ $i.fuse))
(def: (applysI start amount)
- (-> $;Register Nat $;Inst)
- (let [max-args (n.min amount runtimeT;num-apply-variants)
- later-applysI (if (n.> runtimeT;num-apply-variants amount)
- (applysI (n.+ runtimeT;num-apply-variants start) (n.- runtimeT;num-apply-variants amount))
+ (-> $.Register Nat $.Inst)
+ (let [max-args (n/min amount runtimeT.num-apply-variants)
+ later-applysI (if (n/> runtimeT.num-apply-variants amount)
+ (applysI (n/+ runtimeT.num-apply-variants start) (n/- runtimeT.num-apply-variants amount))
id)]
- (|>. ($i;CHECKCAST hostL;function-class)
+ (|>> ($i.CHECKCAST hostL.function-class)
(inputsI start max-args)
- ($i;INVOKEVIRTUAL hostL;function-class runtimeT;apply-method (runtimeT;apply-signature max-args) false)
+ ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature max-args) false)
later-applysI)))
(def: (inc-intI by)
- (-> Nat $;Inst)
- (|>. ($i;int (nat-to-int by))
- $i;IADD))
+ (-> Nat $.Inst)
+ (|>> ($i.int (nat-to-int by))
+ $i.IADD))
(def: (nullsI amount)
- (-> Nat $;Inst)
- (|> $i;NULL
- (list;repeat amount)
- $i;fuse))
+ (-> Nat $.Inst)
+ (|> $i.NULL
+ (list.repeat amount)
+ $i.fuse))
(def: (with-captured env)
- (-> (List Variable) $;Def)
- (|> (list;enumerate env)
+ (-> (List Variable) $.Def)
+ (|> (list.enumerate env)
(list/map (function [[env-idx env-source]]
- ($d;field #$;Private $;finalF (referenceT;captured env-idx) $Object)))
- $d;fuse))
+ ($d.field #$.Private $.finalF (referenceT.captured env-idx) $Object)))
+ $d.fuse))
(def: (with-partial arity)
- (-> ls;Arity $;Def)
+ (-> ls.Arity $.Def)
(if (poly-arg? arity)
- (|> (list;n.range +0 (n.- +2 arity))
+ (|> (list.n/range +0 (n/- +2 arity))
(list/map (function [idx]
- ($d;field #$;Private $;finalF (referenceT;partial idx) $Object)))
- $d;fuse)
+ ($d.field #$.Private $.finalF (referenceT.partial idx) $Object)))
+ $d.fuse)
id))
(def: (instance class arity env)
- (-> Text ls;Arity (List Variable) (Meta $;Inst))
- (do macro;Monad<Meta>
- [captureI+ (monad;map @ referenceT;translate-variable env)
+ (-> Text ls.Arity (List Variable) (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [captureI+ (monad.map @ referenceT.translate-variable env)
#let [argsI (if (poly-arg? arity)
- (|> (nullsI (n.dec arity))
- (list ($i;int 0))
- $i;fuse)
+ (|> (nullsI (n/dec arity))
+ (list ($i.int 0))
+ $i.fuse)
id)]]
- (wrap (|>. ($i;NEW class)
- $i;DUP
- ($i;fuse captureI+)
+ (wrap (|>> ($i.NEW class)
+ $i.DUP
+ ($i.fuse captureI+)
argsI
- ($i;INVOKESPECIAL class "<init>" (init-method env arity) false)))))
+ ($i.INVOKESPECIAL class "<init>" (init-method env arity) false)))))
(def: (with-reset class arity env)
- (-> Text ls;Arity (List Variable) $;Def)
- ($d;method #$;Public $;noneM "reset" (reset-method class)
+ (-> Text ls.Arity (List Variable) $.Def)
+ ($d.method #$.Public $.noneM "reset" (reset-method class)
(if (poly-arg? arity)
- (let [env-size (list;size env)
+ (let [env-size (list.size env)
captureI (|> (case env-size
+0 (list)
- _ (list;n.range +0 (n.dec env-size)))
+ _ (list.n/range +0 (n/dec env-size)))
(list/map (function [source]
- (|>. ($i;ALOAD +0)
- ($i;GETFIELD class (referenceT;captured source) $Object))))
- $i;fuse)
- argsI (|> (nullsI (n.dec arity))
- (list ($i;int 0))
- $i;fuse)]
- (|>. ($i;NEW class)
- $i;DUP
+ (|>> ($i.ALOAD +0)
+ ($i.GETFIELD class (referenceT.captured source) $Object))))
+ $i.fuse)
+ argsI (|> (nullsI (n/dec arity))
+ (list ($i.int 0))
+ $i.fuse)]
+ (|>> ($i.NEW class)
+ $i.DUP
captureI
argsI
- ($i;INVOKESPECIAL class "<init>" (init-method env arity) false)
- $i;ARETURN))
- (|>. ($i;ALOAD +0)
- $i;ARETURN))))
+ ($i.INVOKESPECIAL class "<init>" (init-method env arity) false)
+ $i.ARETURN))
+ (|>> ($i.ALOAD +0)
+ $i.ARETURN))))
(def: (with-implementation arity @begin bodyI)
- (-> Nat $;Label $;Inst $;Def)
- ($d;method #$;Public $;strictM "impl" (implementation-method arity)
- (|>. ($i;label @begin)
+ (-> Nat $.Label $.Inst $.Def)
+ ($d.method #$.Public $.strictM "impl" (implementation-method arity)
+ (|>> ($i.label @begin)
bodyI
- $i;ARETURN)))
+ $i.ARETURN)))
(def: function-init-method
- $;Method
- ($t;method (list $t;int) #;None (list)))
+ $.Method
+ ($t.method (list $t.int) #.None (list)))
(def: (function-init arity env-size)
- (-> ls;Arity Nat $;Inst)
- (if (n.= +1 arity)
- (|>. ($i;int 0)
- ($i;INVOKESPECIAL hostL;function-class "<init>" function-init-method false))
- (|>. ($i;ILOAD (n.inc env-size))
- ($i;INVOKESPECIAL hostL;function-class "<init>" function-init-method false))))
+ (-> ls.Arity Nat $.Inst)
+ (if (n/= +1 arity)
+ (|>> ($i.int 0)
+ ($i.INVOKESPECIAL hostL.function-class "<init>" function-init-method false))
+ (|>> ($i.ILOAD (n/inc env-size))
+ ($i.INVOKESPECIAL hostL.function-class "<init>" function-init-method false))))
(def: (with-init class env arity)
- (-> Text (List Variable) ls;Arity $;Def)
- (let [env-size (list;size env)
+ (-> Text (List Variable) ls.Arity $.Def)
+ (let [env-size (list.size env)
offset-partial (: (-> Nat Nat)
- (|>. n.inc (n.+ env-size)))
+ (|>> n/inc (n/+ env-size)))
store-capturedI (|> (case env-size
+0 (list)
- _ (list;n.range +0 (n.dec env-size)))
+ _ (list.n/range +0 (n/dec env-size)))
(list/map (function [register]
- (|>. ($i;ALOAD +0)
- ($i;ALOAD (n.inc register))
- ($i;PUTFIELD class (referenceT;captured register) $Object))))
- $i;fuse)
+ (|>> ($i.ALOAD +0)
+ ($i.ALOAD (n/inc register))
+ ($i.PUTFIELD class (referenceT.captured register) $Object))))
+ $i.fuse)
store-partialI (if (poly-arg? arity)
- (|> (list;n.range +0 (n.- +2 arity))
+ (|> (list.n/range +0 (n/- +2 arity))
(list/map (function [idx]
(let [register (offset-partial idx)]
- (|>. ($i;ALOAD +0)
- ($i;ALOAD (n.inc register))
- ($i;PUTFIELD class (referenceT;partial idx) $Object)))))
- $i;fuse)
+ (|>> ($i.ALOAD +0)
+ ($i.ALOAD (n/inc register))
+ ($i.PUTFIELD class (referenceT.partial idx) $Object)))))
+ $i.fuse)
id)]
- ($d;method #$;Public $;noneM "<init>" (init-method env arity)
- (|>. ($i;ALOAD +0)
+ ($d.method #$.Public $.noneM "<init>" (init-method env arity)
+ (|>> ($i.ALOAD +0)
(function-init arity env-size)
store-capturedI
store-partialI
- $i;RETURN))))
+ $i.RETURN))))
(def: (with-apply class env function-arity @begin bodyI apply-arity)
- (-> Text (List Variable) ls;Arity $;Label $;Inst ls;Arity
- $;Def)
- (let [num-partials (n.dec function-arity)
- @default ($;new-label [])
- @labels (list/map $;new-label (list;repeat num-partials []))
- arity-over-extent (|> (nat-to-int function-arity) (i.- (nat-to-int apply-arity)))
+ (-> Text (List Variable) ls.Arity $.Label $.Inst ls.Arity
+ $.Def)
+ (let [num-partials (n/dec function-arity)
+ @default ($.new-label [])
+ @labels (list/map $.new-label (list.repeat num-partials []))
+ arity-over-extent (|> (nat-to-int function-arity) (i/- (nat-to-int apply-arity)))
casesI (|> (list/compose @labels (list @default))
- (list;zip2 (list;n.range +0 num-partials))
+ (list.zip2 (list.n/range +0 num-partials))
(list/map (function [[stage @label]]
- (let [load-partialsI (if (n.> +0 stage)
- (|> (list;n.range +0 (n.dec stage))
- (list/map (|>. referenceT;partial (load-fieldI class)))
- $i;fuse)
+ (let [load-partialsI (if (n/> +0 stage)
+ (|> (list.n/range +0 (n/dec stage))
+ (list/map (|>> referenceT.partial (load-fieldI class)))
+ $i.fuse)
id)]
- (cond (i.= arity-over-extent (nat-to-int stage))
- (|>. ($i;label @label)
- ($i;ALOAD +0)
- (when (n.> +0 stage)
- ($i;INVOKEVIRTUAL class "reset" (reset-method class) false))
+ (cond (i/= arity-over-extent (nat-to-int stage))
+ (|>> ($i.label @label)
+ ($i.ALOAD +0)
+ (when (n/> +0 stage)
+ ($i.INVOKEVIRTUAL class "reset" (reset-method class) false))
load-partialsI
(inputsI +1 apply-arity)
- ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
- $i;ARETURN)
+ ($i.INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
+ $i.ARETURN)
- (i.> arity-over-extent (nat-to-int stage))
- (let [args-to-completion (|> function-arity (n.- stage))
- args-left (|> apply-arity (n.- args-to-completion))]
- (|>. ($i;label @label)
- ($i;ALOAD +0)
- ($i;INVOKEVIRTUAL class "reset" (reset-method class) false)
+ (i/> arity-over-extent (nat-to-int stage))
+ (let [args-to-completion (|> function-arity (n/- stage))
+ args-left (|> apply-arity (n/- args-to-completion))]
+ (|>> ($i.label @label)
+ ($i.ALOAD +0)
+ ($i.INVOKEVIRTUAL class "reset" (reset-method class) false)
load-partialsI
(inputsI +1 args-to-completion)
- ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
- (applysI (n.inc args-to-completion) args-left)
- $i;ARETURN))
+ ($i.INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
+ (applysI (n/inc args-to-completion) args-left)
+ $i.ARETURN))
- ## (i.< arity-over-extent (nat-to-int stage))
- (let [env-size (list;size env)
+ ## (i/< arity-over-extent (nat-to-int stage))
+ (let [env-size (list.size env)
load-capturedI (|> (case env-size
+0 (list)
- _ (list;n.range +0 (n.dec env-size)))
- (list/map (|>. referenceT;captured (load-fieldI class)))
- $i;fuse)]
- (|>. ($i;label @label)
- ($i;NEW class)
- $i;DUP
+ _ (list.n/range +0 (n/dec env-size)))
+ (list/map (|>> referenceT.captured (load-fieldI class)))
+ $i.fuse)]
+ (|>> ($i.label @label)
+ ($i.NEW class)
+ $i.DUP
load-capturedI
get-amount-of-partialsI
(inc-intI apply-arity)
load-partialsI
(inputsI +1 apply-arity)
- (nullsI (|> num-partials (n.- apply-arity) (n.- stage)))
- ($i;INVOKESPECIAL class "<init>" (init-method env function-arity) false)
- $i;ARETURN))
+ (nullsI (|> num-partials (n/- apply-arity) (n/- stage)))
+ ($i.INVOKESPECIAL class "<init>" (init-method env function-arity) false)
+ $i.ARETURN))
))))
- $i;fuse)]
- ($d;method #$;Public $;noneM runtimeT;apply-method (runtimeT;apply-signature apply-arity)
- (|>. get-amount-of-partialsI
- ($i;TABLESWITCH 0 (|> num-partials n.dec nat-to-int)
+ $i.fuse)]
+ ($d.method #$.Public $.noneM runtimeT.apply-method (runtimeT.apply-signature apply-arity)
+ (|>> get-amount-of-partialsI
+ ($i.TABLESWITCH 0 (|> num-partials n/dec nat-to-int)
@default @labels)
casesI
- ($i;INVOKESTATIC hostL;runtime-class "apply_fail" ($t;method (list) #;None (list)) false)
- $i;NULL
- $i;ARETURN
+ ($i.INVOKESTATIC hostL.runtime-class "apply_fail" ($t.method (list) #.None (list)) false)
+ $i.NULL
+ $i.ARETURN
))))
(def: #export (with-function @begin class env arity bodyI)
- (-> $;Label Text (List Variable) ls;Arity $;Inst
- (Meta [$;Def $;Inst]))
- (let [env-size (list;size env)
- applyD (: $;Def
+ (-> $.Label Text (List Variable) ls.Arity $.Inst
+ (Meta [$.Def $.Inst]))
+ (let [env-size (list.size env)
+ applyD (: $.Def
(if (poly-arg? arity)
- (|> (n.min arity runtimeT;num-apply-variants)
- (list;n.range +1)
+ (|> (n/min arity runtimeT.num-apply-variants)
+ (list.n/range +1)
(list/map (with-apply class env arity @begin bodyI))
(list& (with-implementation arity @begin bodyI))
- $d;fuse)
- ($d;method #$;Public $;strictM runtimeT;apply-method (runtimeT;apply-signature +1)
- (|>. ($i;label @begin)
+ $d.fuse)
+ ($d.method #$.Public $.strictM runtimeT.apply-method (runtimeT.apply-signature +1)
+ (|>> ($i.label @begin)
bodyI
- $i;ARETURN))))
- functionD (: $;Def
- (|>. ($d;int-field #$;Public ($_ $;++F $;staticF $;finalF) arity-field (nat-to-int arity))
+ $i.ARETURN))))
+ functionD (: $.Def
+ (|>> ($d.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (nat-to-int arity))
(with-captured env)
(with-partial arity)
(with-init class env arity)
(with-reset class arity env)
applyD
))]
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[instanceI (instance class arity env)]
(wrap [functionD instanceI]))))
(def: #export (translate-function translate env arity bodyS)
- (-> (-> ls;Synthesis (Meta $;Inst))
- (List Variable) ls;Arity ls;Synthesis
- (Meta $;Inst))
- (do macro;Monad<Meta>
- [@begin $i;make-label
- [function-class bodyI] (hostL;with-sub-context
- (hostL;with-anchor [@begin +1]
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ (List Variable) ls.Arity ls.Synthesis
+ (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [@begin $i.make-label
+ [function-class bodyI] (hostL.with-sub-context
+ (hostL.with-anchor [@begin +1]
(translate bodyS)))
- this-module macro;current-module-name
- #let [function-class (format (text;replace-all "/" "." this-module) "." function-class)]
+ this-module macro.current-module-name
+ #let [function-class (format (text.replace-all "/" "." this-module) "." function-class)]
[functionD instanceI] (with-function @begin function-class env arity bodyI)
- _ (commonT;store-class function-class
- ($d;class #$;V1.6 #$;Public $;finalC
+ _ (commonT.store-class function-class
+ ($d.class #$.V1_6 #$.Public $.finalC
function-class (list)
- ($;simple-class hostL;function-class) (list)
+ ($.simple-class hostL.function-class) (list)
functionD))]
(wrap instanceI)))
(def: (segment size elems)
(All [a] (-> Nat (List a) (List (List a))))
- (let [[pre post] (list;split size elems)]
- (if (list;empty? post)
+ (let [[pre post] (list.split size elems)]
+ (if (list.empty? post)
(list pre)
(list& pre (segment size post)))))
(def: #export (translate-call translate functionS argsS)
- (-> (-> ls;Synthesis (Meta $;Inst))
- ls;Synthesis (List ls;Synthesis)
- (Meta $;Inst))
- (do macro;Monad<Meta>
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ ls.Synthesis (List ls.Synthesis)
+ (Meta $.Inst))
+ (do macro.Monad<Meta>
[functionI (translate functionS)
- argsI (monad;map @ translate argsS)
- #let [applyI (|> (segment runtimeT;num-apply-variants argsI)
+ argsI (monad.map @ translate argsS)
+ #let [applyI (|> (segment runtimeT.num-apply-variants argsI)
(list/map (function [chunkI+]
- (|>. ($i;CHECKCAST hostL;function-class)
- ($i;fuse chunkI+)
- ($i;INVOKEVIRTUAL hostL;function-class runtimeT;apply-method (runtimeT;apply-signature (list;size chunkI+)) false))))
- $i;fuse)]]
- (wrap (|>. functionI
+ (|>> ($i.CHECKCAST hostL.function-class)
+ ($i.fuse chunkI+)
+ ($i.INVOKEVIRTUAL hostL.function-class runtimeT.apply-method (runtimeT.apply-signature (list.size chunkI+)) false))))
+ $i.fuse)]]
+ (wrap (|>> functionI
applyI))))
diff --git a/new-luxc/source/luxc/lang/translation/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/imports.jvm.lux
index be8b828cd..892dd869f 100644
--- a/new-luxc/source/luxc/lang/translation/imports.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/imports.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["p" parser]
@@ -19,16 +19,16 @@
[io #+ IO Process io]
[host])
(luxc ["&" lang]
- (lang [";L" module])))
+ (lang [".L" module])))
(exception: #export Invalid-Imports)
(exception: #export Module-Cannot-Import-Itself)
(exception: #export Circular-Dependency)
-(host;import (java.util.concurrent.Future a)
+(host.import (java/util/concurrent/Future a)
(get [] #io a))
-(host;import (java.util.concurrent.CompletableFuture a)
+(host.import (java/util/concurrent/CompletableFuture a)
(new [])
(complete [a] boolean)
(#static [a] completedFuture [a] (CompletableFuture a)))
@@ -37,55 +37,55 @@
{#module Text
#alias Text})
-(def: import (s;Syntax Import) (s;tuple (p;seq s;text s;text)))
+(def: import (s.Syntax Import) (s.tuple (p.seq s.text s.text)))
(def: compilations
(Var (Dict Text (CompletableFuture (Error Compiler))))
- (stm;var (dict;new text;Hash<Text>)))
+ (stm.var (dict.new text.Hash<Text>)))
(def: (promise-to-future promise)
(All [a] (-> (Promise a) (Future a)))
- (let [future (CompletableFuture.new [])]
- (exec (:: promise;Functor<Promise> map
- (function [value] (CompletableFuture.complete [value] future))
+ (let [future (CompletableFuture::new [])]
+ (exec (:: promise.Functor<Promise> map
+ (function [value] (CompletableFuture::complete [value] future))
promise)
future)))
(def: from-io
(All [a] (-> (IO a) (Process a)))
- (:: io;Monad<IO> map (|>. #e;Success)))
+ (:: io.Monad<IO> map (|>> #e.Success)))
(def: (translate-dependency translate-module dependency compiler)
(-> (-> Text Compiler (Process Compiler))
(-> Text Compiler (IO (Future (Error Compiler)))))
- (<| (Future.get [])
+ (<| (Future::get [])
promise-to-future
- (do promise;Monad<Promise>
- [[new? future] (stm;commit (: (STM [Bool (CompletableFuture (Error Compiler))])
- (do stm;Monad<STM>
- [current-compilations (stm;read compilations)]
- (case (dict;get dependency current-compilations)
- (#;Some ongoing)
+ (do promise.Monad<Promise>
+ [[new? future] (stm.commit (: (STM [Bool (CompletableFuture (Error Compiler))])
+ (do stm.Monad<STM>
+ [current-compilations (stm.read compilations)]
+ (case (dict.get dependency current-compilations)
+ (#.Some ongoing)
(wrap [false ongoing])
- #;None
+ #.None
(do @
[#let [pending (: (CompletableFuture (Error Compiler))
- (CompletableFuture.new []))]
- _ (stm;write (dict;put dependency pending current-compilations)
+ (CompletableFuture::new []))]
+ _ (stm.write (dict.put dependency pending current-compilations)
compilations)]
(wrap [true pending]))))))]
(if new?
- (exec (promise;future (io (CompletableFuture.complete [(io;run (translate-module dependency compiler))]
- future)))
+ (exec (promise.future (io (CompletableFuture::complete [(io.run (translate-module dependency compiler))]
+ future)))
(wrap future))
(wrap future)))))
(def: compiled?
(-> Module Bool)
- (|>. (get@ #;module-state)
+ (|>> (get@ #.module-state)
(case>
- (^or #;Cached #;Compiled)
+ (^or #.Cached #.Compiled)
true
_
@@ -94,56 +94,56 @@
(def: (merge-modules current-module from-dependency from-current)
(-> Text (List [Text Module]) (List [Text Module]) (List [Text Module]))
(|> from-dependency
- (list;filter (|>. product;right compiled?))
- (list/fold (function [[dep-name dep-module] total] (&;pl-put dep-name dep-module total))
+ (list.filter (|>> product.right compiled?))
+ (list/fold (function [[dep-name dep-module] total] (&.pl-put dep-name dep-module total))
from-current)))
(def: (merge-compilers current-module dependency total)
(-> Text Compiler Compiler Compiler)
(|> total
- (update@ #;modules (merge-modules current-module (get@ #;modules dependency)))
- (set@ #;seed (get@ #;seed dependency))))
+ (update@ #.modules (merge-modules current-module (get@ #.modules dependency)))
+ (set@ #.seed (get@ #.seed dependency))))
(def: #export (translate-imports translate-module annotations)
(-> (-> Text Compiler (Process Compiler))
Code
(Meta (Process Compiler)))
- (do macro;Monad<Meta>
- [_ (moduleL;set-annotations annotations)
- current-module macro;current-module-name
- imports (let [imports (|> (macro;get-tuple-ann (ident-for #;imports) annotations)
- (maybe;default (list)))]
- (case (s;run imports (p;some import))
- (#e;Success imports)
+ (do macro.Monad<Meta>
+ [_ (moduleL.set-annotations annotations)
+ current-module macro.current-module-name
+ imports (let [imports (|> (macro.get-tuple-ann (ident-for #.imports) annotations)
+ (maybe.default (list)))]
+ (case (s.run imports (p.some import))
+ (#e.Success imports)
(wrap imports)
- (#e;Error error)
- (&;throw Invalid-Imports (%code (code;tuple imports)))))
- dependencies (monad;map @ (: (-> [Text Text] (Meta (IO (Future (Error Compiler)))))
+ (#e.Error error)
+ (&.throw Invalid-Imports (%code (code.tuple imports)))))
+ dependencies (monad.map @ (: (-> [Text Text] (Meta (IO (Future (Error Compiler)))))
(function [[dependency alias]]
(do @
- [_ (&;assert Module-Cannot-Import-Itself current-module
+ [_ (&.assert Module-Cannot-Import-Itself current-module
(not (text/= current-module dependency)))
- already-seen? (moduleL;exists? dependency)
+ already-seen? (moduleL.exists? dependency)
circular-dependency? (if already-seen?
- (moduleL;active? dependency)
+ (moduleL.active? dependency)
(wrap false))
- _ (&;assert Circular-Dependency (format "From: " current-module "\n"
+ _ (&.assert Circular-Dependency (format "From: " current-module "\n"
" To: " dependency)
(not circular-dependency?))
- _ (moduleL;import dependency)
+ _ (moduleL.import dependency)
_ (if (text/= "" alias)
(wrap [])
- (moduleL;alias alias dependency))
- compiler macro;get-compiler]
+ (moduleL.alias alias dependency))
+ compiler macro.get-compiler]
(if already-seen?
- (wrap (io (CompletableFuture.completedFuture [(#e;Success compiler)])))
+ (wrap (io (CompletableFuture::completedFuture [(#e.Success compiler)])))
(wrap (translate-dependency translate-module dependency compiler))))))
imports)
- compiler macro;get-compiler]
- (wrap (do io;Monad<Process>
- [dependencies (monad;seq io;Monad<Process> (list/map from-io dependencies))
+ compiler macro.get-compiler]
+ (wrap (do io.Monad<Process>
+ [dependencies (monad.seq io.Monad<Process> (list/map from-io dependencies))
dependencies (|> dependencies
- (list/map (Future.get []))
- (monad;seq io;Monad<Process>))]
+ (list/map (Future::get []))
+ (monad.seq io.Monad<Process>))]
(wrap (list/fold (merge-compilers current-module) compiler dependencies))))))
diff --git a/new-luxc/source/luxc/lang/translation/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/loop.jvm.lux
index 77d43a0e5..8920dc936 100644
--- a/new-luxc/source/luxc/lang/translation/loop.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/loop.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do])
(data [text]
@@ -6,23 +6,23 @@
(coll [list "list/" Functor<List> Monoid<List>]))
[macro])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["la" analysis]
["ls" synthesis]
- (translation [";T" common]
- [";T" runtime]
- [";T" reference])
- [";L" variable #+ Variable Register])))
+ (translation [".T" common]
+ [".T" runtime]
+ [".T" reference])
+ [".L" variable #+ Variable Register])))
(def: (constant? register changeS)
- (-> Register ls;Synthesis Bool)
+ (-> Register ls.Synthesis Bool)
(case changeS
- (^multi (^code ((~ [_ (#;Int var)])))
- (i.= (variableL;local register)
+ (^multi (^code ((~ [_ (#.Int var)])))
+ (i/= (variableL.local register)
var))
true
@@ -30,12 +30,12 @@
false))
(def: #export (translate-recur translate argsS)
- (-> (-> ls;Synthesis (Meta $;Inst))
- (List ls;Synthesis)
- (Meta $;Inst))
- (do macro;Monad<Meta>
- [[@begin offset] hostL;anchor
- #let [pairs (list;zip2 (list;n.range offset (|> (list;size argsS) n.dec (n.+ offset)))
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ (List ls.Synthesis)
+ (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [[@begin offset] hostL.anchor
+ #let [pairs (list.zip2 (list.n/range offset (|> (list.size argsS) n/dec (n/+ offset)))
argsS)]
## It may look weird that first I compile the values separately,
## and then I compile the stores/allocations.
@@ -45,36 +45,36 @@
## and stores separately, then by the time Y is evaluated, it
## will refer to the new value of X, instead of the old value, as
## must be the case.
- valuesI+ (monad;map @ (function [[register argS]]
- (: (Meta $;Inst)
+ valuesI+ (monad.map @ (function [[register argS]]
+ (: (Meta $.Inst)
(if (constant? register argS)
(wrap id)
(translate argS))))
pairs)
#let [storesI+ (list/map (function [[register argS]]
- (: $;Inst
+ (: $.Inst
(if (constant? register argS)
id
- ($i;ASTORE register))))
- (list;reverse pairs))]]
- (wrap (|>. ($i;fuse valuesI+)
- ($i;fuse storesI+)
- ($i;GOTO @begin)))))
+ ($i.ASTORE register))))
+ (list.reverse pairs))]]
+ (wrap (|>> ($i.fuse valuesI+)
+ ($i.fuse storesI+)
+ ($i.GOTO @begin)))))
(def: #export (translate-loop translate offset initsS+ bodyS)
- (-> (-> ls;Synthesis (Meta $;Inst))
- Nat (List ls;Synthesis) ls;Synthesis
- (Meta $;Inst))
- (do macro;Monad<Meta>
- [@begin $i;make-label
- initsI+ (monad;map @ translate initsS+)
- bodyI (hostL;with-anchor [@begin offset]
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ Nat (List ls.Synthesis) ls.Synthesis
+ (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [@begin $i.make-label
+ initsI+ (monad.map @ translate initsS+)
+ bodyI (hostL.with-anchor [@begin offset]
(translate bodyS))
- #let [initializationI (|> (list;enumerate initsI+)
+ #let [initializationI (|> (list.enumerate initsI+)
(list/map (function [[register initI]]
- (|>. initI
- ($i;ASTORE (n.+ offset register)))))
- $i;fuse)]]
- (wrap (|>. initializationI
- ($i;label @begin)
+ (|>> initI
+ ($i.ASTORE (n/+ offset register)))))
+ $i.fuse)]]
+ (wrap (|>> initializationI
+ ($i.label @begin)
bodyI))))
diff --git a/new-luxc/source/luxc/lang/translation/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
index acd3b95e3..8fed1de18 100644
--- a/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
@@ -1,35 +1,35 @@
-(;module:
+(.module:
lux
(lux (control monad)
(data text/format)
[macro "macro/" Monad<Meta>])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$i" inst]
["$t" type]))
["la" analysis]
["ls" synthesis]
- (translation [";T" common]))))
+ (translation [".T" common]))))
(def: #export translate-unit
- (Meta $;Inst)
- (macro/wrap ($i;string hostL;unit)))
+ (Meta $.Inst)
+ (macro/wrap ($i.string hostL.unit)))
(def: #export (translate-bool value)
- (-> Bool (Meta $;Inst))
- (macro/wrap ($i;GETSTATIC "java.lang.Boolean"
+ (-> Bool (Meta $.Inst))
+ (macro/wrap ($i.GETSTATIC "java.lang.Boolean"
(if value "TRUE" "FALSE")
- ($t;class "java.lang.Boolean" (list)))))
+ ($t.class "java.lang.Boolean" (list)))))
(do-template [<name> <type> <load> <wrap>]
[(def: #export (<name> value)
- (-> <type> (Meta $;Inst))
- (macro/wrap (|>. (<load> value) <wrap>)))]
+ (-> <type> (Meta $.Inst))
+ (macro/wrap (|>> (<load> value) <wrap>)))]
- [translate-nat Nat (|>. (:! Int) $i;long) ($i;wrap #$;Long)]
- [translate-int Int $i;long ($i;wrap #$;Long)]
- [translate-deg Deg (|>. (:! Int) $i;long) ($i;wrap #$;Long)]
- [translate-frac Frac $i;double ($i;wrap #$;Double)]
- [translate-text Text $i;string id]
+ [translate-nat Nat (|>> (:! Int) $i.long) ($i.wrap #$.Long)]
+ [translate-int Int $i.long ($i.wrap #$.Long)]
+ [translate-deg Deg (|>> (:! Int) $i.long) ($i.wrap #$.Long)]
+ [translate-frac Frac $i.double ($i.wrap #$.Double)]
+ [translate-text Text $i.string id]
)
diff --git a/new-luxc/source/luxc/lang/translation/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
index 14fbe2f1a..e4f8b9908 100644
--- a/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -8,20 +8,20 @@
(luxc ["&" lang]
(lang (host ["$" jvm])
["ls" synthesis]))
- (/ ["/;" common]
- ["/;" host]))
+ (/ ["/." common]
+ ["/." host]))
(exception: #export Unknown-Procedure)
(def: procedures
- /common;Bundle
- (|> /common;procedures
- (dict;merge /host;procedures)))
+ /common.Bundle
+ (|> /common.procedures
+ (dict.merge /host.procedures)))
(def: #export (translate-procedure translate name args)
- (-> (-> ls;Synthesis (Meta $;Inst)) Text (List ls;Synthesis)
- (Meta $;Inst))
- (<| (maybe;default (&;throw Unknown-Procedure (%t name)))
- (do maybe;Monad<Maybe>
- [proc (dict;get name procedures)]
+ (-> (-> ls.Synthesis (Meta $.Inst)) Text (List ls.Synthesis)
+ (Meta $.Inst))
+ (<| (maybe.default (&.throw Unknown-Procedure (%t name)))
+ (do maybe.Monad<Maybe>
+ [proc (dict.get name procedures)]
(wrap (proc translate args)))))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
index 01f2a33c7..41d9b91ab 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["p" parser]
@@ -13,23 +13,23 @@
["s" syntax #+ syntax:])
[host])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["la" analysis]
["ls" synthesis]
- (translation [";T" runtime]
- [";T" case]
- [";T" function]
- [";T" loop]))))
+ (translation [".T" runtime]
+ [".T" case]
+ [".T" function]
+ [".T" loop]))))
-(host;import java.lang.Long
+(host.import java/lang/Long
(#static MIN_VALUE Long)
(#static MAX_VALUE Long))
-(host;import java.lang.Double
+(host.import java/lang/Double
(#static MIN_VALUE Double)
(#static MAX_VALUE Double)
(#static NaN Double)
@@ -38,42 +38,42 @@
## [Types]
(type: #export Translator
- (-> ls;Synthesis (Meta $;Inst)))
+ (-> ls.Synthesis (Meta $.Inst)))
(type: #export Proc
- (-> Translator (List ls;Synthesis) (Meta $;Inst)))
+ (-> Translator (List ls.Synthesis) (Meta $.Inst)))
(type: #export Bundle
(Dict Text Proc))
-(syntax: (Vector [size s;nat] elemT)
- (wrap (list (` [(~@ (list;repeat size elemT))]))))
+(syntax: (Vector [size s.nat] elemT)
+ (wrap (list (` [(~@ (list.repeat size elemT))]))))
-(type: #export Nullary (-> (Vector +0 $;Inst) $;Inst))
-(type: #export Unary (-> (Vector +1 $;Inst) $;Inst))
-(type: #export Binary (-> (Vector +2 $;Inst) $;Inst))
-(type: #export Trinary (-> (Vector +3 $;Inst) $;Inst))
-(type: #export Variadic (-> (List $;Inst) $;Inst))
+(type: #export Nullary (-> (Vector +0 $.Inst) $.Inst))
+(type: #export Unary (-> (Vector +1 $.Inst) $.Inst))
+(type: #export Binary (-> (Vector +2 $.Inst) $.Inst))
+(type: #export Trinary (-> (Vector +3 $.Inst) $.Inst))
+(type: #export Variadic (-> (List $.Inst) $.Inst))
## [Utils]
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
-(def: $Object-Array $;Type ($t;array +1 $Object))
-(def: $Variant $;Type ($t;array +1 $Object))
-(def: $String $;Type ($t;class "java.lang.String" (list)))
-(def: $CharSequence $;Type ($t;class "java.lang.CharSequence" (list)))
-(def: $Function $;Type ($t;class hostL;function-class (list)))
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
+(def: $Object-Array $.Type ($t.array +1 $Object))
+(def: $Variant $.Type ($t.array +1 $Object))
+(def: $String $.Type ($t.class "java.lang.String" (list)))
+(def: $CharSequence $.Type ($t.class "java.lang.CharSequence" (list)))
+(def: $Function $.Type ($t.class hostL.function-class (list)))
(def: #export (install name unnamed)
(-> Text (-> Text Proc)
(-> Bundle Bundle))
- (dict;put name (unnamed name)))
+ (dict.put name (unnamed name)))
(def: #export (prefix prefix bundle)
(-> Text Bundle Bundle)
(|> bundle
- dict;entries
+ dict.entries
(list/map (function [[key val]] [(format prefix " " key) val]))
- (dict;from-list text;Hash<Text>)))
+ (dict.from-list text.Hash<Text>)))
(def: (wrong-arity proc expected actual)
(-> Text Nat Nat Text)
@@ -81,26 +81,26 @@
"Expected: " (|> expected nat-to-int %i) "\n"
" Actual: " (|> actual nat-to-int %i)))
-(syntax: (arity: [name s;local-symbol] [arity s;nat])
+(syntax: (arity: [name s.local-symbol] [arity s.nat])
(with-gensyms [g!proc g!name g!translate g!inputs]
(do @
- [g!input+ (monad;seq @ (list;repeat arity (macro;gensym "input")))]
- (wrap (list (` (def: #export ((~ (code;local-symbol name)) (~ g!proc))
- (-> (-> (;;Vector (~ (code;nat arity)) $;Inst) $;Inst)
- (-> Text ;;Proc))
+ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+ (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc))
+ (-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst)
+ (-> Text ..Proc))
(function [(~ g!name)]
(function [(~ g!translate) (~ g!inputs)]
(case (~ g!inputs)
(^ (list (~@ g!input+)))
- (do macro;Monad<Meta>
+ (do macro.Monad<Meta>
[(~@ (|> g!input+
(list/map (function [g!input]
(list g!input (` ((~ g!translate) (~ g!input))))))
- list;concat))]
+ list.concat))]
((~' wrap) ((~ g!proc) [(~@ g!input+)])))
(~' _)
- (macro;fail (wrong-arity (~ g!name) +1 (list;size (~ g!inputs))))))))))))))
+ (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))
(arity: nullary +0)
(arity: unary +1)
@@ -111,54 +111,54 @@
(-> Variadic (-> Text Proc))
(function [proc-name]
(function [translate inputsS]
- (do macro;Monad<Meta>
- [inputsI (monad;map @ translate inputsS)]
+ (do macro.Monad<Meta>
+ [inputsI (monad.map @ translate inputsS)]
(wrap (proc inputsI))))))
## [Instructions]
-(def: lux-intI $;Inst (|>. $i;I2L ($i;wrap #$;Long)))
-(def: jvm-intI $;Inst (|>. ($i;unwrap #$;Long) $i;L2I))
+(def: lux-intI $.Inst (|>> $i.I2L ($i.wrap #$.Long)))
+(def: jvm-intI $.Inst (|>> ($i.unwrap #$.Long) $i.L2I))
(def: (array-writeI arrayI idxI elemI)
- (-> $;Inst $;Inst $;Inst
- $;Inst)
- (|>. arrayI ($i;CHECKCAST ($t;descriptor $Object-Array))
- $i;DUP
+ (-> $.Inst $.Inst $.Inst
+ $.Inst)
+ (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array))
+ $i.DUP
idxI jvm-intI
elemI
- $i;AASTORE))
+ $i.AASTORE))
(def: (predicateI tester)
- (-> (-> $;Label $;Inst)
- $;Inst)
- (<| $i;with-label (function [@then])
- $i;with-label (function [@end])
- (|>. (tester @then)
- ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
- ($i;GOTO @end)
- ($i;label @then)
- ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
- ($i;label @end)
+ (-> (-> $.Label $.Inst)
+ $.Inst)
+ (<| $i.with-label (function [@then])
+ $i.with-label (function [@end])
+ (|>> (tester @then)
+ ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+ ($i.GOTO @end)
+ ($i.label @then)
+ ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+ ($i.label @end)
)))
## [Procedures]
## [[Lux]]
(def: (lux//is [leftI rightI])
Binary
- (|>. leftI
+ (|>> leftI
rightI
- (predicateI $i;IF_ACMPEQ)))
+ (predicateI $i.IF_ACMPEQ)))
(def: (lux//if [testI thenI elseI])
Trinary
- (caseT;translate-if testI thenI elseI))
+ (caseT.translate-if testI thenI elseI))
(def: (lux//try riskyI)
Unary
- (|>. riskyI
- ($i;CHECKCAST hostL;function-class)
- ($i;INVOKESTATIC hostL;runtime-class "try"
- ($t;method (list $Function) (#;Some $Object-Array) (list))
+ (|>> riskyI
+ ($i.CHECKCAST hostL.function-class)
+ ($i.INVOKESTATIC hostL.runtime-class "try"
+ ($t.method (list $Function) (#.Some $Object-Array) (list))
false)))
(def: (lux//noop valueI)
@@ -167,80 +167,80 @@
(exception: #export Wrong-Syntax)
(def: #export (wrong-syntax procedure args)
- (-> Text (List ls;Synthesis) Text)
+ (-> Text (List ls.Synthesis) Text)
(format "Procedure: " procedure "\n"
- "Arguments: " (%code (code;tuple args))))
+ "Arguments: " (%code (code.tuple args))))
(def: lux//loop
(-> Text Proc)
(function [proc-name]
(function [translate inputsS]
- (case (s;run inputsS ($_ p;seq s;nat (s;tuple (p;many s;any)) s;any))
- (#e;Success [offset initsS+ bodyS])
- (loopT;translate-loop translate offset initsS+ bodyS)
+ (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any))
+ (#e.Success [offset initsS+ bodyS])
+ (loopT.translate-loop translate offset initsS+ bodyS)
- (#e;Error error)
- (&;throw Wrong-Syntax (wrong-syntax proc-name inputsS)))
+ (#e.Error error)
+ (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS)))
)))
(def: lux//recur
(-> Text Proc)
(function [proc-name]
(function [translate inputsS]
- (loopT;translate-recur translate inputsS))))
+ (loopT.translate-recur translate inputsS))))
## [[Bits]]
(do-template [<name> <op>]
[(def: (<name> [inputI maskI])
Binary
- (|>. inputI ($i;unwrap #$;Long)
- maskI ($i;unwrap #$;Long)
- <op> ($i;wrap #$;Long)))]
+ (|>> inputI ($i.unwrap #$.Long)
+ maskI ($i.unwrap #$.Long)
+ <op> ($i.wrap #$.Long)))]
- [bit//and $i;LAND]
- [bit//or $i;LOR]
- [bit//xor $i;LXOR]
+ [bit//and $i.LAND]
+ [bit//or $i.LOR]
+ [bit//xor $i.LXOR]
)
(def: (bit//count inputI)
Unary
- (|>. inputI ($i;unwrap #$;Long)
- ($i;INVOKESTATIC "java.lang.Long" "bitCount" ($t;method (list $t;long) (#;Some $t;int) (list)) false)
+ (|>> inputI ($i.unwrap #$.Long)
+ ($i.INVOKESTATIC "java.lang.Long" "bitCount" ($t.method (list $t.long) (#.Some $t.int) (list)) false)
lux-intI))
(do-template [<name> <op>]
[(def: (<name> [inputI shiftI])
Binary
- (|>. inputI ($i;unwrap #$;Long)
+ (|>> inputI ($i.unwrap #$.Long)
shiftI jvm-intI
<op>
- ($i;wrap #$;Long)))]
+ ($i.wrap #$.Long)))]
- [bit//shift-left $i;LSHL]
- [bit//shift-right $i;LSHR]
- [bit//unsigned-shift-right $i;LUSHR]
+ [bit//shift-left $i.LSHL]
+ [bit//shift-right $i.LSHR]
+ [bit//unsigned-shift-right $i.LUSHR]
)
## [[Arrays]]
(def: (array//new lengthI)
Unary
- (|>. lengthI jvm-intI ($i;ANEWARRAY ($t;binary-name "java.lang.Object"))))
+ (|>> lengthI jvm-intI ($i.ANEWARRAY ($t.binary-name "java.lang.Object"))))
(def: (array//get [arrayI idxI])
Binary
- (<| $i;with-label (function [@is-null])
- $i;with-label (function [@end])
- (|>. arrayI ($i;CHECKCAST ($t;descriptor $Object-Array))
+ (<| $i.with-label (function [@is-null])
+ $i.with-label (function [@end])
+ (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array))
idxI jvm-intI
- $i;AALOAD
- $i;DUP
- ($i;IFNULL @is-null)
- runtimeT;someI
- ($i;GOTO @end)
- ($i;label @is-null)
- $i;POP
- runtimeT;noneI
- ($i;label @end))))
+ $i.AALOAD
+ $i.DUP
+ ($i.IFNULL @is-null)
+ runtimeT.someI
+ ($i.GOTO @end)
+ ($i.label @is-null)
+ $i.POP
+ runtimeT.noneI
+ ($i.label @end))))
(def: (array//put [arrayI idxI elemI])
Trinary
@@ -248,137 +248,137 @@
(def: (array//remove [arrayI idxI])
Binary
- (array-writeI arrayI idxI $i;NULL))
+ (array-writeI arrayI idxI $i.NULL))
(def: (array//size arrayI)
Unary
- (|>. arrayI ($i;CHECKCAST ($t;descriptor $Object-Array))
- $i;ARRAYLENGTH
+ (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array))
+ $i.ARRAYLENGTH
lux-intI))
## [[Numbers]]
(def: nat-method
- $;Method
- ($t;method (list $t;long $t;long) (#;Some $t;long) (list)))
+ $.Method
+ ($t.method (list $t.long $t.long) (#.Some $t.long) (list)))
-(def: deg-method $;Method nat-method)
+(def: deg-method $.Method nat-method)
(def: compare-nat-method
- $;Method
- ($t;method (list $t;long $t;long) (#;Some $t;int) (list)))
+ $.Method
+ ($t.method (list $t.long $t.long) (#.Some $t.int) (list)))
(do-template [<name> <const> <type>]
[(def: (<name> _)
Nullary
- (|>. <const> ($i;wrap <type>)))]
+ (|>> <const> ($i.wrap <type>)))]
- [nat//min ($i;long 0) #$;Long]
- [nat//max ($i;long -1) #$;Long]
+ [nat//min ($i.long 0) #$.Long]
+ [nat//max ($i.long -1) #$.Long]
- [int//min ($i;long Long.MIN_VALUE) #$;Long]
- [int//max ($i;long Long.MAX_VALUE) #$;Long]
+ [int//min ($i.long Long::MIN_VALUE) #$.Long]
+ [int//max ($i.long Long::MAX_VALUE) #$.Long]
- [frac//smallest ($i;double Double.MIN_VALUE) #$;Double]
- [frac//min ($i;double (f.* -1.0 Double.MAX_VALUE)) #$;Double]
- [frac//max ($i;double Double.MAX_VALUE) #$;Double]
- [frac//not-a-number ($i;double Double.NaN) #$;Double]
- [frac//positive-infinity ($i;double Double.POSITIVE_INFINITY) #$;Double]
- [frac//negative-infinity ($i;double Double.NEGATIVE_INFINITY) #$;Double]
-
- [deg//min ($i;long 0) #$;Long]
- [deg//max ($i;long -1) #$;Long]
+ [frac//smallest ($i.double Double::MIN_VALUE) #$.Double]
+ [frac//min ($i.double (f/* -1.0 Double::MAX_VALUE)) #$.Double]
+ [frac//max ($i.double Double::MAX_VALUE) #$.Double]
+ [frac//not-a-number ($i.double Double::NaN) #$.Double]
+ [frac//positive-infinity ($i.double Double::POSITIVE_INFINITY) #$.Double]
+ [frac//negative-infinity ($i.double Double::NEGATIVE_INFINITY) #$.Double]
+
+ [deg//min ($i.long 0) #$.Long]
+ [deg//max ($i.long -1) #$.Long]
)
(do-template [<name> <type> <op>]
[(def: (<name> [subjectI paramI])
Binary
- (|>. subjectI ($i;unwrap <type>)
- paramI ($i;unwrap <type>)
+ (|>> subjectI ($i.unwrap <type>)
+ paramI ($i.unwrap <type>)
<op>
- ($i;wrap <type>)))]
+ ($i.wrap <type>)))]
- [int//add #$;Long $i;LADD]
- [int//sub #$;Long $i;LSUB]
- [int//mul #$;Long $i;LMUL]
- [int//div #$;Long $i;LDIV]
- [int//rem #$;Long $i;LREM]
+ [int//add #$.Long $i.LADD]
+ [int//sub #$.Long $i.LSUB]
+ [int//mul #$.Long $i.LMUL]
+ [int//div #$.Long $i.LDIV]
+ [int//rem #$.Long $i.LREM]
- [nat//add #$;Long $i;LADD]
- [nat//sub #$;Long $i;LSUB]
- [nat//mul #$;Long $i;LMUL]
- [nat//div #$;Long ($i;INVOKESTATIC hostL;runtime-class "div_nat" nat-method false)]
- [nat//rem #$;Long ($i;INVOKESTATIC hostL;runtime-class "rem_nat" nat-method false)]
-
- [frac//add #$;Double $i;DADD]
- [frac//sub #$;Double $i;DSUB]
- [frac//mul #$;Double $i;DMUL]
- [frac//div #$;Double $i;DDIV]
- [frac//rem #$;Double $i;DREM]
-
- [deg//add #$;Long $i;LADD]
- [deg//sub #$;Long $i;LSUB]
- [deg//mul #$;Long ($i;INVOKESTATIC hostL;runtime-class "mul_deg" deg-method false)]
- [deg//div #$;Long ($i;INVOKESTATIC hostL;runtime-class "div_deg" deg-method false)]
- [deg//rem #$;Long $i;LSUB]
- [deg//scale #$;Long $i;LMUL]
- [deg//reciprocal #$;Long $i;LDIV]
+ [nat//add #$.Long $i.LADD]
+ [nat//sub #$.Long $i.LSUB]
+ [nat//mul #$.Long $i.LMUL]
+ [nat//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_nat" nat-method false)]
+ [nat//rem #$.Long ($i.INVOKESTATIC hostL.runtime-class "rem_nat" nat-method false)]
+
+ [frac//add #$.Double $i.DADD]
+ [frac//sub #$.Double $i.DSUB]
+ [frac//mul #$.Double $i.DMUL]
+ [frac//div #$.Double $i.DDIV]
+ [frac//rem #$.Double $i.DREM]
+
+ [deg//add #$.Long $i.LADD]
+ [deg//sub #$.Long $i.LSUB]
+ [deg//mul #$.Long ($i.INVOKESTATIC hostL.runtime-class "mul_deg" deg-method false)]
+ [deg//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_deg" deg-method false)]
+ [deg//rem #$.Long $i.LSUB]
+ [deg//scale #$.Long $i.LMUL]
+ [deg//reciprocal #$.Long $i.LDIV]
)
(do-template [<eq> <lt> <unwrap> <cmp>]
[(do-template [<name> <reference>]
[(def: (<name> [subjectI paramI])
Binary
- (|>. subjectI <unwrap>
+ (|>> subjectI <unwrap>
paramI <unwrap>
<cmp>
- ($i;int <reference>)
- (predicateI $i;IF_ICMPEQ)))]
+ ($i.int <reference>)
+ (predicateI $i.IF_ICMPEQ)))]
[<eq> 0]
[<lt> -1])]
- [nat//eq nat//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false)]
- [int//eq int//lt ($i;unwrap #$;Long) $i;LCMP]
- [frac//eq frac//lt ($i;unwrap #$;Double) $i;DCMPG]
- [deg//eq deg//lt ($i;unwrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false)]
+ [nat//eq nat//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
+ [int//eq int//lt ($i.unwrap #$.Long) $i.LCMP]
+ [frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG]
+ [deg//eq deg//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
)
(do-template [<name> <prepare> <transform>]
[(def: (<name> inputI)
Unary
- (|>. inputI <prepare> <transform>))]
+ (|>> inputI <prepare> <transform>))]
[nat//to-int id id]
- [nat//char ($i;unwrap #$;Long)
- ((|>. $i;L2I $i;I2C ($i;INVOKESTATIC "java.lang.Character" "toString" ($t;method (list $t;char) (#;Some $String) (list)) false)))]
+ [nat//char ($i.unwrap #$.Long)
+ ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))]
[int//to-nat id id]
- [int//to-frac ($i;unwrap #$;Long) (<| ($i;wrap #$;Double) $i;L2D)]
-
- [frac//to-int ($i;unwrap #$;Double) (<| ($i;wrap #$;Long) $i;D2L)]
- [frac//to-deg ($i;unwrap #$;Double)
- (<| ($i;wrap #$;Long) ($i;INVOKESTATIC hostL;runtime-class "frac_to_deg"
- ($t;method (list $t;double) (#;Some $t;long) (list)) false))]
- [frac//encode ($i;unwrap #$;Double)
- ($i;INVOKESTATIC "java.lang.Double" "toString" ($t;method (list $t;double) (#;Some $String) (list)) false)]
- [frac//decode ($i;CHECKCAST "java.lang.String")
- ($i;INVOKESTATIC hostL;runtime-class "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list)) false)]
-
- [deg//to-frac ($i;unwrap #$;Long)
- (<| ($i;wrap #$;Double) ($i;INVOKESTATIC hostL;runtime-class "deg_to_frac"
- ($t;method (list $t;long) (#;Some $t;double) (list)) false))]
+ [int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)]
+
+ [frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)]
+ [frac//to-deg ($i.unwrap #$.Double)
+ (<| ($i.wrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "frac_to_deg"
+ ($t.method (list $t.double) (#.Some $t.long) (list)) false))]
+ [frac//encode ($i.unwrap #$.Double)
+ ($i.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) false)]
+ [frac//decode ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) false)]
+
+ [deg//to-frac ($i.unwrap #$.Long)
+ (<| ($i.wrap #$.Double) ($i.INVOKESTATIC hostL.runtime-class "deg_to_frac"
+ ($t.method (list $t.long) (#.Some $t.double) (list)) false))]
)
## [[Text]]
(do-template [<name> <class> <method> <post> <outputT>]
[(def: (<name> inputI)
Unary
- (|>. inputI
- ($i;CHECKCAST "java.lang.String")
- ($i;INVOKEVIRTUAL <class> <method> ($t;method (list) (#;Some <outputT>) (list)) false)
+ (|>> inputI
+ ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKEVIRTUAL <class> <method> ($t.method (list) (#.Some <outputT>) (list)) false)
<post>))]
- [text//size "java.lang.String" "length" lux-intI $t;int]
- [text//hash "java.lang.Object" "hashCode" lux-intI $t;int]
+ [text//size "java.lang.String" "length" lux-intI $t.int]
+ [text//hash "java.lang.Object" "hashCode" lux-intI $t.int]
[text//trim "java.lang.String" "trim" id $String]
[text//upper "java.lang.String" "toUpperCase" id $String]
[text//lower "java.lang.String" "toLowerCase" id $String]
@@ -387,86 +387,86 @@
(do-template [<name> <pre-subject> <pre-param> <op> <post>]
[(def: (<name> [subjectI paramI])
Binary
- (|>. subjectI <pre-subject>
+ (|>> subjectI <pre-subject>
paramI <pre-param>
<op> <post>))]
[text//eq id id
- ($i;INVOKEVIRTUAL "java.lang.Object" "equals" ($t;method (list $Object) (#;Some $t;boolean) (list)) false)
- ($i;wrap #$;Boolean)]
- [text//lt ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
- ($i;INVOKEVIRTUAL "java.lang.String" "compareTo" ($t;method (list $String) (#;Some $t;int) (list)) false)
- (<| (predicateI $i;IF_ICMPEQ) ($i;int -1))]
- [text//concat ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
- ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false)
+ ($i.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) false)
+ ($i.wrap #$.Boolean)]
+ [text//lt ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) false)
+ (<| (predicateI $i.IF_ICMPEQ) ($i.int -1))]
+ [text//concat ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) false)
id]
- [text//contains? ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
- ($i;INVOKEVIRTUAL "java.lang.String" "contains" ($t;method (list $CharSequence) (#;Some $t;boolean) (list)) false)
- ($i;wrap #$;Boolean)]
- [text//char ($i;CHECKCAST "java.lang.String") jvm-intI
- ($i;INVOKESTATIC hostL;runtime-class "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list)) false)
+ [text//contains? ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKEVIRTUAL "java.lang.String" "contains" ($t.method (list $CharSequence) (#.Some $t.boolean) (list)) false)
+ ($i.wrap #$.Boolean)]
+ [text//char ($i.CHECKCAST "java.lang.String") jvm-intI
+ ($i.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) false)
id]
)
(do-template [<name> <pre-subject> <pre-param> <pre-extra> <op>]
[(def: (<name> [subjectI paramI extraI])
Trinary
- (|>. subjectI <pre-subject>
+ (|>> subjectI <pre-subject>
paramI <pre-param>
extraI <pre-extra>
<op>))]
- [text//clip ($i;CHECKCAST "java.lang.String") jvm-intI jvm-intI
- ($i;INVOKESTATIC hostL;runtime-class "text_clip"
- ($t;method (list $String $t;int $t;int) (#;Some $Variant) (list)) false)]
- [text//replace-once ($i;CHECKCAST "java.lang.String")
- (<| ($i;INVOKESTATIC "java.util.regex.Pattern" "quote" ($t;method (list $String) (#;Some $String) (list)) false)
- ($i;CHECKCAST "java.lang.String"))
- ($i;CHECKCAST "java.lang.String")
- ($i;INVOKEVIRTUAL "java.lang.String" "replaceFirst" ($t;method (list $String $String) (#;Some $String) (list)) false)]
- [text//replace-all ($i;CHECKCAST "java.lang.String")
- (<| ($i;INVOKESTATIC "java.util.regex.Pattern" "quote" ($t;method (list $String) (#;Some $String) (list)) false)
- ($i;CHECKCAST "java.lang.String"))
- ($i;CHECKCAST "java.lang.String")
- ($i;INVOKEVIRTUAL "java.lang.String" "replaceAll" ($t;method (list $String $String) (#;Some $String) (list)) false)]
+ [text//clip ($i.CHECKCAST "java.lang.String") jvm-intI jvm-intI
+ ($i.INVOKESTATIC hostL.runtime-class "text_clip"
+ ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) false)]
+ [text//replace-once ($i.CHECKCAST "java.lang.String")
+ (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false)
+ ($i.CHECKCAST "java.lang.String"))
+ ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKEVIRTUAL "java.lang.String" "replaceFirst" ($t.method (list $String $String) (#.Some $String) (list)) false)]
+ [text//replace-all ($i.CHECKCAST "java.lang.String")
+ (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false)
+ ($i.CHECKCAST "java.lang.String"))
+ ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKEVIRTUAL "java.lang.String" "replaceAll" ($t.method (list $String $String) (#.Some $String) (list)) false)]
)
-(def: index-method $;Method ($t;method (list $String $t;int) (#;Some $t;int) (list)))
+(def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list)))
(do-template [<name> <method>]
[(def: (<name> [textI partI startI])
Trinary
- (<| $i;with-label (function [@not-found])
- $i;with-label (function [@end])
- (|>. textI ($i;CHECKCAST "java.lang.String")
- partI ($i;CHECKCAST "java.lang.String")
+ (<| $i.with-label (function [@not-found])
+ $i.with-label (function [@end])
+ (|>> textI ($i.CHECKCAST "java.lang.String")
+ partI ($i.CHECKCAST "java.lang.String")
startI jvm-intI
- ($i;INVOKEVIRTUAL "java.lang.String" <method> index-method false)
- $i;DUP
- ($i;int -1)
- ($i;IF_ICMPEQ @not-found)
+ ($i.INVOKEVIRTUAL "java.lang.String" <method> index-method false)
+ $i.DUP
+ ($i.int -1)
+ ($i.IF_ICMPEQ @not-found)
lux-intI
- runtimeT;someI
- ($i;GOTO @end)
- ($i;label @not-found)
- $i;POP
- runtimeT;noneI
- ($i;label @end))))]
+ runtimeT.someI
+ ($i.GOTO @end)
+ ($i.label @not-found)
+ $i.POP
+ runtimeT.noneI
+ ($i.label @end))))]
[text//index "indexOf"]
[text//last-index "lastIndexOf"]
)
## [[Math]]
-(def: math-unary-method ($t;method (list $t;double) (#;Some $t;double) (list)))
-(def: math-binary-method ($t;method (list $t;double $t;double) (#;Some $t;double) (list)))
+(def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list)))
+(def: math-binary-method ($t.method (list $t.double $t.double) (#.Some $t.double) (list)))
(do-template [<name> <method>]
[(def: (<name> inputI)
Unary
- (|>. inputI
- ($i;unwrap #$;Double)
- ($i;INVOKESTATIC "java.lang.Math" <method> math-unary-method false)
- ($i;wrap #$;Double)))]
+ (|>> inputI
+ ($i.unwrap #$.Double)
+ ($i.INVOKESTATIC "java.lang.Math" <method> math-unary-method false)
+ ($i.wrap #$.Double)))]
[math//cos "cos"]
[math//sin "sin"]
@@ -488,10 +488,10 @@
(do-template [<name> <method>]
[(def: (<name> [inputI paramI])
Binary
- (|>. inputI ($i;unwrap #$;Double)
- paramI ($i;unwrap #$;Double)
- ($i;INVOKESTATIC "java.lang.Math" <method> math-binary-method false)
- ($i;wrap #$;Double)))]
+ (|>> inputI ($i.unwrap #$.Double)
+ paramI ($i.unwrap #$.Double)
+ ($i.INVOKESTATIC "java.lang.Math" <method> math-binary-method false)
+ ($i.wrap #$.Double)))]
[math//atan2 "atan2"]
[math//pow "pow"]
@@ -499,90 +499,90 @@
(def: (math//round inputI)
Unary
- (|>. inputI
- ($i;unwrap #$;Double)
- ($i;INVOKESTATIC "java.lang.Math" "round" ($t;method (list $t;double) (#;Some $t;long) (list)) false)
- $i;L2D
- ($i;wrap #$;Double)))
+ (|>> inputI
+ ($i.unwrap #$.Double)
+ ($i.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) false)
+ $i.L2D
+ ($i.wrap #$.Double)))
## [[IO]]
-(def: string-method $;Method ($t;method (list $String) #;None (list)))
+(def: string-method $.Method ($t.method (list $String) #.None (list)))
(def: (io//log messageI)
Unary
- (|>. ($i;GETSTATIC "java.lang.System" "out" ($t;class "java.io.PrintStream" (list)))
+ (|>> ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list)))
messageI
- ($i;CHECKCAST "java.lang.String")
- ($i;INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false)
- ($i;string hostL;unit)))
+ ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false)
+ ($i.string hostL.unit)))
(def: (io//error messageI)
Unary
- (|>. ($i;NEW "java.lang.Error")
- $i;DUP
+ (|>> ($i.NEW "java.lang.Error")
+ $i.DUP
messageI
- ($i;CHECKCAST "java.lang.String")
- ($i;INVOKESPECIAL "java.lang.Error" "<init>" string-method false)
- $i;ATHROW))
+ ($i.CHECKCAST "java.lang.String")
+ ($i.INVOKESPECIAL "java.lang.Error" "<init>" string-method false)
+ $i.ATHROW))
(def: (io//exit codeI)
Unary
- (|>. codeI jvm-intI
- ($i;INVOKESTATIC "java.lang.System" "exit" ($t;method (list $t;int) #;None (list)) false)
- $i;NULL))
+ (|>> codeI jvm-intI
+ ($i.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) false)
+ $i.NULL))
(def: (io//current-time [])
Nullary
- (|>. ($i;INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t;method (list) (#;Some $t;long) (list)) false)
- ($i;wrap #$;Long)))
+ (|>> ($i.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) false)
+ ($i.wrap #$.Long)))
## [[Atoms]]
(def: atom-class Text "java.util.concurrent.atomic.AtomicReference")
(def: (atom//new initI)
Unary
- (|>. ($i;NEW atom-class)
- $i;DUP
+ (|>> ($i.NEW atom-class)
+ $i.DUP
initI
- ($i;INVOKESPECIAL atom-class "<init>" ($t;method (list $Object) #;None (list)) false)))
+ ($i.INVOKESPECIAL atom-class "<init>" ($t.method (list $Object) #.None (list)) false)))
(def: (atom//read atomI)
Unary
- (|>. atomI
- ($i;CHECKCAST atom-class)
- ($i;INVOKEVIRTUAL atom-class "get" ($t;method (list) (#;Some $Object) (list)) false)))
+ (|>> atomI
+ ($i.CHECKCAST atom-class)
+ ($i.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) false)))
(def: (atom//compare-and-swap [atomI oldI newI])
Trinary
- (|>. atomI
- ($i;CHECKCAST atom-class)
+ (|>> atomI
+ ($i.CHECKCAST atom-class)
oldI
newI
- ($i;INVOKEVIRTUAL atom-class "compareAndSet" ($t;method (list $Object $Object) (#;Some $t;boolean) (list)) false)
- ($i;wrap #$;Boolean)))
+ ($i.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) false)
+ ($i.wrap #$.Boolean)))
## [[Processes]]
(def: (process//concurrency-level [])
Nullary
- (|>. ($i;INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t;method (list) (#;Some ($t;class "java.lang.Runtime" (list))) (list)) false)
- ($i;INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t;method (list) (#;Some $t;int) (list)) false)
+ (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) false)
+ ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) false)
lux-intI))
(def: (process//future procedureI)
Unary
- (|>. procedureI ($i;CHECKCAST hostL;function-class)
- ($i;INVOKESTATIC hostL;runtime-class "future"
- ($t;method (list $Function) (#;Some $Object) (list)) false)))
+ (|>> procedureI ($i.CHECKCAST hostL.function-class)
+ ($i.INVOKESTATIC hostL.runtime-class "future"
+ ($t.method (list $Function) (#.Some $Object) (list)) false)))
(def: (process//schedule [millisecondsI procedureI])
Binary
- (|>. millisecondsI ($i;unwrap #$;Long)
- procedureI ($i;CHECKCAST hostL;function-class)
- ($i;INVOKESTATIC hostL;runtime-class "schedule"
- ($t;method (list $t;long $Function) (#;Some $Object) (list)) false)))
+ (|>> millisecondsI ($i.unwrap #$.Long)
+ procedureI ($i.CHECKCAST hostL.function-class)
+ ($i.INVOKESTATIC hostL.runtime-class "schedule"
+ ($t.method (list $t.long $Function) (#.Some $Object) (list)) false)))
## [Bundles]
(def: lux-procs
Bundle
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary lux//try))
@@ -594,7 +594,7 @@
(def: bit-procs
Bundle
(<| (prefix "bit")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "count" (unary bit//count))
(install "and" (binary bit//and))
(install "or" (binary bit//or))
@@ -607,7 +607,7 @@
(def: nat-procs
Bundle
(<| (prefix "nat")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary nat//add))
(install "-" (binary nat//sub))
(install "*" (binary nat//mul))
@@ -623,7 +623,7 @@
(def: int-procs
Bundle
(<| (prefix "int")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary int//add))
(install "-" (binary int//sub))
(install "*" (binary int//mul))
@@ -639,7 +639,7 @@
(def: deg-procs
Bundle
(<| (prefix "deg")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary deg//add))
(install "-" (binary deg//sub))
(install "*" (binary deg//mul))
@@ -656,7 +656,7 @@
(def: frac-procs
Bundle
(<| (prefix "frac")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "+" (binary frac//add))
(install "-" (binary frac//sub))
(install "*" (binary frac//mul))
@@ -678,7 +678,7 @@
(def: text-procs
Bundle
(<| (prefix "text")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "=" (binary text//eq))
(install "<" (binary text//lt))
(install "concat" (binary text//concat))
@@ -696,7 +696,7 @@
(def: array-procs
Bundle
(<| (prefix "array")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "new" (unary array//new))
(install "get" (binary array//get))
(install "put" (trinary array//put))
@@ -707,7 +707,7 @@
(def: math-procs
Bundle
(<| (prefix "math")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "cos" (unary math//cos))
(install "sin" (unary math//sin))
(install "tan" (unary math//tan))
@@ -731,7 +731,7 @@
(def: io-procs
Bundle
(<| (prefix "io")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "log" (unary io//log))
(install "error" (unary io//error))
(install "exit" (unary io//exit))
@@ -740,7 +740,7 @@
(def: atom-procs
Bundle
(<| (prefix "atom")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "new" (unary atom//new))
(install "read" (unary atom//read))
(install "compare-and-swap" (trinary atom//compare-and-swap)))))
@@ -748,7 +748,7 @@
(def: process-procs
Bundle
(<| (prefix "process")
- (|> (dict;new text;Hash<Text>)
+ (|> (dict.new text.Hash<Text>)
(install "concurrency-level" (nullary process//concurrency-level))
(install "future" (unary process//future))
(install "schedule" (binary process//schedule))
@@ -757,17 +757,17 @@
(def: #export procedures
Bundle
(<| (prefix "lux")
- (|> (dict;new text;Hash<Text>)
- (dict;merge lux-procs)
- (dict;merge bit-procs)
- (dict;merge nat-procs)
- (dict;merge int-procs)
- (dict;merge deg-procs)
- (dict;merge frac-procs)
- (dict;merge text-procs)
- (dict;merge array-procs)
- (dict;merge math-procs)
- (dict;merge io-procs)
- (dict;merge atom-procs)
- (dict;merge process-procs)
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge lux-procs)
+ (dict.merge bit-procs)
+ (dict.merge nat-procs)
+ (dict.merge int-procs)
+ (dict.merge deg-procs)
+ (dict.merge frac-procs)
+ (dict.merge text-procs)
+ (dict.merge array-procs)
+ (dict.merge math-procs)
+ (dict.merge io-procs)
+ (dict.merge atom-procs)
+ (dict.merge process-procs)
)))
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 2aa693d2c..f2f88904d 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["p" parser "parser/" Monad<Parser>]
@@ -15,13 +15,13 @@
["s" syntax #+ syntax:])
[host])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["la" analysis]
- (analysis (procedure ["&;" host]))
+ (analysis (procedure ["&." host]))
["ls" synthesis]))
["@" //common])
@@ -30,732 +30,732 @@
(do-template [<name> <inst>]
[(def: <name>
- $;Inst
+ $.Inst
<inst>)]
- [L2S (|>. $i;L2I $i;I2S)]
- [L2B (|>. $i;L2I $i;I2B)]
- [L2C (|>. $i;L2I $i;I2C)]
+ [L2S (|>> $i.L2I $i.I2S)]
+ [L2B (|>> $i.L2I $i.I2B)]
+ [L2C (|>> $i.L2I $i.I2C)]
)
(do-template [<name> <unwrap> <conversion> <wrap>]
[(def: (<name> inputI)
- @;Unary
- (if (is $i;NOP <conversion>)
- (|>. inputI
- ($i;unwrap <unwrap>)
- ($i;wrap <wrap>))
- (|>. inputI
- ($i;unwrap <unwrap>)
+ @.Unary
+ (if (is $i.NOP <conversion>)
+ (|>> inputI
+ ($i.unwrap <unwrap>)
+ ($i.wrap <wrap>))
+ (|>> inputI
+ ($i.unwrap <unwrap>)
<conversion>
- ($i;wrap <wrap>))))]
+ ($i.wrap <wrap>))))]
- [convert//double-to-float #$;Double $i;D2F #$;Float]
- [convert//double-to-int #$;Double $i;D2I #$;Int]
- [convert//double-to-long #$;Double $i;D2L #$;Long]
- [convert//float-to-double #$;Float $i;F2D #$;Double]
- [convert//float-to-int #$;Float $i;F2I #$;Int]
- [convert//float-to-long #$;Float $i;F2L #$;Long]
- [convert//int-to-byte #$;Int $i;I2B #$;Byte]
- [convert//int-to-char #$;Int $i;I2C #$;Char]
- [convert//int-to-double #$;Int $i;I2D #$;Double]
- [convert//int-to-float #$;Int $i;I2F #$;Float]
- [convert//int-to-long #$;Int $i;I2L #$;Long]
- [convert//int-to-short #$;Int $i;I2S #$;Short]
- [convert//long-to-double #$;Long $i;L2D #$;Double]
- [convert//long-to-float #$;Long $i;L2F #$;Float]
- [convert//long-to-int #$;Long $i;L2I #$;Int]
- [convert//long-to-short #$;Long L2S #$;Short]
- [convert//long-to-byte #$;Long L2B #$;Byte]
- [convert//long-to-char #$;Long L2C #$;Char]
- [convert//char-to-byte #$;Char $i;I2B #$;Byte]
- [convert//char-to-short #$;Char $i;I2S #$;Short]
- [convert//char-to-int #$;Char $i;NOP #$;Int]
- [convert//char-to-long #$;Char $i;I2L #$;Long]
- [convert//byte-to-long #$;Byte $i;I2L #$;Long]
- [convert//short-to-long #$;Short $i;I2L #$;Long]
+ [convert//double-to-float #$.Double $i.D2F #$.Float]
+ [convert//double-to-int #$.Double $i.D2I #$.Int]
+ [convert//double-to-long #$.Double $i.D2L #$.Long]
+ [convert//float-to-double #$.Float $i.F2D #$.Double]
+ [convert//float-to-int #$.Float $i.F2I #$.Int]
+ [convert//float-to-long #$.Float $i.F2L #$.Long]
+ [convert//int-to-byte #$.Int $i.I2B #$.Byte]
+ [convert//int-to-char #$.Int $i.I2C #$.Char]
+ [convert//int-to-double #$.Int $i.I2D #$.Double]
+ [convert//int-to-float #$.Int $i.I2F #$.Float]
+ [convert//int-to-long #$.Int $i.I2L #$.Long]
+ [convert//int-to-short #$.Int $i.I2S #$.Short]
+ [convert//long-to-double #$.Long $i.L2D #$.Double]
+ [convert//long-to-float #$.Long $i.L2F #$.Float]
+ [convert//long-to-int #$.Long $i.L2I #$.Int]
+ [convert//long-to-short #$.Long L2S #$.Short]
+ [convert//long-to-byte #$.Long L2B #$.Byte]
+ [convert//long-to-char #$.Long L2C #$.Char]
+ [convert//char-to-byte #$.Char $i.I2B #$.Byte]
+ [convert//char-to-short #$.Char $i.I2S #$.Short]
+ [convert//char-to-int #$.Char $i.NOP #$.Int]
+ [convert//char-to-long #$.Char $i.I2L #$.Long]
+ [convert//byte-to-long #$.Byte $i.I2L #$.Long]
+ [convert//short-to-long #$.Short $i.I2L #$.Long]
)
(def: conversion-procs
- @;Bundle
- (<| (@;prefix "convert")
- (|> (dict;new text;Hash<Text>)
- (@;install "double-to-float" (@;unary convert//double-to-float))
- (@;install "double-to-int" (@;unary convert//double-to-int))
- (@;install "double-to-long" (@;unary convert//double-to-long))
- (@;install "float-to-double" (@;unary convert//float-to-double))
- (@;install "float-to-int" (@;unary convert//float-to-int))
- (@;install "float-to-long" (@;unary convert//float-to-long))
- (@;install "int-to-byte" (@;unary convert//int-to-byte))
- (@;install "int-to-char" (@;unary convert//int-to-char))
- (@;install "int-to-double" (@;unary convert//int-to-double))
- (@;install "int-to-float" (@;unary convert//int-to-float))
- (@;install "int-to-long" (@;unary convert//int-to-long))
- (@;install "int-to-short" (@;unary convert//int-to-short))
- (@;install "long-to-double" (@;unary convert//long-to-double))
- (@;install "long-to-float" (@;unary convert//long-to-float))
- (@;install "long-to-int" (@;unary convert//long-to-int))
- (@;install "long-to-short" (@;unary convert//long-to-short))
- (@;install "long-to-byte" (@;unary convert//long-to-byte))
- (@;install "long-to-char" (@;unary convert//long-to-char))
- (@;install "char-to-byte" (@;unary convert//char-to-byte))
- (@;install "char-to-short" (@;unary convert//char-to-short))
- (@;install "char-to-int" (@;unary convert//char-to-int))
- (@;install "char-to-long" (@;unary convert//char-to-long))
- (@;install "byte-to-long" (@;unary convert//byte-to-long))
- (@;install "short-to-long" (@;unary convert//short-to-long))
+ @.Bundle
+ (<| (@.prefix "convert")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "double-to-float" (@.unary convert//double-to-float))
+ (@.install "double-to-int" (@.unary convert//double-to-int))
+ (@.install "double-to-long" (@.unary convert//double-to-long))
+ (@.install "float-to-double" (@.unary convert//float-to-double))
+ (@.install "float-to-int" (@.unary convert//float-to-int))
+ (@.install "float-to-long" (@.unary convert//float-to-long))
+ (@.install "int-to-byte" (@.unary convert//int-to-byte))
+ (@.install "int-to-char" (@.unary convert//int-to-char))
+ (@.install "int-to-double" (@.unary convert//int-to-double))
+ (@.install "int-to-float" (@.unary convert//int-to-float))
+ (@.install "int-to-long" (@.unary convert//int-to-long))
+ (@.install "int-to-short" (@.unary convert//int-to-short))
+ (@.install "long-to-double" (@.unary convert//long-to-double))
+ (@.install "long-to-float" (@.unary convert//long-to-float))
+ (@.install "long-to-int" (@.unary convert//long-to-int))
+ (@.install "long-to-short" (@.unary convert//long-to-short))
+ (@.install "long-to-byte" (@.unary convert//long-to-byte))
+ (@.install "long-to-char" (@.unary convert//long-to-char))
+ (@.install "char-to-byte" (@.unary convert//char-to-byte))
+ (@.install "char-to-short" (@.unary convert//char-to-short))
+ (@.install "char-to-int" (@.unary convert//char-to-int))
+ (@.install "char-to-long" (@.unary convert//char-to-long))
+ (@.install "byte-to-long" (@.unary convert//byte-to-long))
+ (@.install "short-to-long" (@.unary convert//short-to-long))
)))
(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
[(def: (<name> [xI yI])
- @;Binary
- (|>. xI ($i;unwrap <unwrapX>)
- yI ($i;unwrap <unwrapY>)
- <op> ($i;wrap <wrap>)))]
-
- [int//+ $i;IADD #$;Int #$;Int #$;Int]
- [int//- $i;ISUB #$;Int #$;Int #$;Int]
- [int//* $i;IMUL #$;Int #$;Int #$;Int]
- [int/// $i;IDIV #$;Int #$;Int #$;Int]
- [int//% $i;IREM #$;Int #$;Int #$;Int]
- [int//and $i;IAND #$;Int #$;Int #$;Int]
- [int//or $i;IOR #$;Int #$;Int #$;Int]
- [int//xor $i;IXOR #$;Int #$;Int #$;Int]
- [int//shl $i;ISHL #$;Int #$;Int #$;Int]
- [int//shr $i;ISHR #$;Int #$;Int #$;Int]
- [int//ushr $i;IUSHR #$;Int #$;Int #$;Int]
+ @.Binary
+ (|>> xI ($i.unwrap <unwrapX>)
+ yI ($i.unwrap <unwrapY>)
+ <op> ($i.wrap <wrap>)))]
+
+ [int//+ $i.IADD #$.Int #$.Int #$.Int]
+ [int//- $i.ISUB #$.Int #$.Int #$.Int]
+ [int//* $i.IMUL #$.Int #$.Int #$.Int]
+ [int/// $i.IDIV #$.Int #$.Int #$.Int]
+ [int//% $i.IREM #$.Int #$.Int #$.Int]
+ [int//and $i.IAND #$.Int #$.Int #$.Int]
+ [int//or $i.IOR #$.Int #$.Int #$.Int]
+ [int//xor $i.IXOR #$.Int #$.Int #$.Int]
+ [int//shl $i.ISHL #$.Int #$.Int #$.Int]
+ [int//shr $i.ISHR #$.Int #$.Int #$.Int]
+ [int//ushr $i.IUSHR #$.Int #$.Int #$.Int]
- [long//+ $i;LADD #$;Long #$;Long #$;Long]
- [long//- $i;LSUB #$;Long #$;Long #$;Long]
- [long//* $i;LMUL #$;Long #$;Long #$;Long]
- [long/// $i;LDIV #$;Long #$;Long #$;Long]
- [long//% $i;LREM #$;Long #$;Long #$;Long]
- [long//and $i;LAND #$;Long #$;Long #$;Long]
- [long//or $i;LOR #$;Long #$;Long #$;Long]
- [long//xor $i;LXOR #$;Long #$;Long #$;Long]
- [long//shl $i;LSHL #$;Long #$;Int #$;Long]
- [long//shr $i;LSHR #$;Long #$;Int #$;Long]
- [long//ushr $i;LUSHR #$;Long #$;Int #$;Long]
-
- [float//+ $i;FADD #$;Float #$;Float #$;Float]
- [float//- $i;FSUB #$;Float #$;Float #$;Float]
- [float//* $i;FMUL #$;Float #$;Float #$;Float]
- [float/// $i;FDIV #$;Float #$;Float #$;Float]
- [float//% $i;FREM #$;Float #$;Float #$;Float]
+ [long//+ $i.LADD #$.Long #$.Long #$.Long]
+ [long//- $i.LSUB #$.Long #$.Long #$.Long]
+ [long//* $i.LMUL #$.Long #$.Long #$.Long]
+ [long/// $i.LDIV #$.Long #$.Long #$.Long]
+ [long//% $i.LREM #$.Long #$.Long #$.Long]
+ [long//and $i.LAND #$.Long #$.Long #$.Long]
+ [long//or $i.LOR #$.Long #$.Long #$.Long]
+ [long//xor $i.LXOR #$.Long #$.Long #$.Long]
+ [long//shl $i.LSHL #$.Long #$.Int #$.Long]
+ [long//shr $i.LSHR #$.Long #$.Int #$.Long]
+ [long//ushr $i.LUSHR #$.Long #$.Int #$.Long]
+
+ [float//+ $i.FADD #$.Float #$.Float #$.Float]
+ [float//- $i.FSUB #$.Float #$.Float #$.Float]
+ [float//* $i.FMUL #$.Float #$.Float #$.Float]
+ [float/// $i.FDIV #$.Float #$.Float #$.Float]
+ [float//% $i.FREM #$.Float #$.Float #$.Float]
- [double//+ $i;DADD #$;Double #$;Double #$;Double]
- [double//- $i;DSUB #$;Double #$;Double #$;Double]
- [double//* $i;DMUL #$;Double #$;Double #$;Double]
- [double/// $i;DDIV #$;Double #$;Double #$;Double]
- [double//% $i;DREM #$;Double #$;Double #$;Double]
+ [double//+ $i.DADD #$.Double #$.Double #$.Double]
+ [double//- $i.DSUB #$.Double #$.Double #$.Double]
+ [double//* $i.DMUL #$.Double #$.Double #$.Double]
+ [double/// $i.DDIV #$.Double #$.Double #$.Double]
+ [double//% $i.DREM #$.Double #$.Double #$.Double]
)
(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
[(def: (<name> [xI yI])
- @;Binary
- (<| $i;with-label (function [@then])
- $i;with-label (function [@end])
- (|>. xI ($i;unwrap <unwrapX>)
- yI ($i;unwrap <unwrapY>)
+ @.Binary
+ (<| $i.with-label (function [@then])
+ $i.with-label (function [@end])
+ (|>> xI ($i.unwrap <unwrapX>)
+ yI ($i.unwrap <unwrapY>)
(<op> @then)
- ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
- ($i;GOTO @end)
- ($i;label @then)
- ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
- ($i;label @end))))]
+ ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+ ($i.GOTO @end)
+ ($i.label @then)
+ ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+ ($i.label @end))))]
- [int//= $i;IF_ICMPEQ #$;Int #$;Int #$;Boolean]
- [int//< $i;IF_ICMPLT #$;Int #$;Int #$;Boolean]
+ [int//= $i.IF_ICMPEQ #$.Int #$.Int #$.Boolean]
+ [int//< $i.IF_ICMPLT #$.Int #$.Int #$.Boolean]
- [char//= $i;IF_ICMPEQ #$;Char #$;Char #$;Boolean]
- [char//< $i;IF_ICMPLT #$;Char #$;Char #$;Boolean]
+ [char//= $i.IF_ICMPEQ #$.Char #$.Char #$.Boolean]
+ [char//< $i.IF_ICMPLT #$.Char #$.Char #$.Boolean]
)
(do-template [<name> <op> <reference> <unwrapX> <unwrapY> <wrap>]
[(def: (<name> [xI yI])
- @;Binary
- (<| $i;with-label (function [@then])
- $i;with-label (function [@end])
- (|>. xI ($i;unwrap <unwrapX>)
- yI ($i;unwrap <unwrapY>)
+ @.Binary
+ (<| $i.with-label (function [@then])
+ $i.with-label (function [@end])
+ (|>> xI ($i.unwrap <unwrapX>)
+ yI ($i.unwrap <unwrapY>)
<op>
- ($i;int <reference>)
- ($i;IF_ICMPEQ @then)
- ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
- ($i;GOTO @end)
- ($i;label @then)
- ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
- ($i;label @end))))]
-
- [long//= $i;LCMP 0 #$;Long #$;Long #$;Boolean]
- [long//< $i;LCMP -1 #$;Long #$;Long #$;Boolean]
+ ($i.int <reference>)
+ ($i.IF_ICMPEQ @then)
+ ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+ ($i.GOTO @end)
+ ($i.label @then)
+ ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+ ($i.label @end))))]
+
+ [long//= $i.LCMP 0 #$.Long #$.Long #$.Boolean]
+ [long//< $i.LCMP -1 #$.Long #$.Long #$.Boolean]
- [float//= $i;FCMPG 0 #$;Float #$;Float #$;Boolean]
- [float//< $i;FCMPG -1 #$;Float #$;Float #$;Boolean]
+ [float//= $i.FCMPG 0 #$.Float #$.Float #$.Boolean]
+ [float//< $i.FCMPG -1 #$.Float #$.Float #$.Boolean]
- [double//= $i;DCMPG 0 #$;Double #$;Double #$;Boolean]
- [double//< $i;DCMPG -1 #$;Double #$;Double #$;Boolean]
+ [double//= $i.DCMPG 0 #$.Double #$.Double #$.Boolean]
+ [double//< $i.DCMPG -1 #$.Double #$.Double #$.Boolean]
)
(def: int-procs
- @;Bundle
- (<| (@;prefix "int")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary int//+))
- (@;install "-" (@;binary int//-))
- (@;install "*" (@;binary int//*))
- (@;install "/" (@;binary int///))
- (@;install "%" (@;binary int//%))
- (@;install "=" (@;binary int//=))
- (@;install "<" (@;binary int//<))
- (@;install "and" (@;binary int//and))
- (@;install "or" (@;binary int//or))
- (@;install "xor" (@;binary int//xor))
- (@;install "shl" (@;binary int//shl))
- (@;install "shr" (@;binary int//shr))
- (@;install "ushr" (@;binary int//ushr))
+ @.Bundle
+ (<| (@.prefix "int")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary int//+))
+ (@.install "-" (@.binary int//-))
+ (@.install "*" (@.binary int//*))
+ (@.install "/" (@.binary int///))
+ (@.install "%" (@.binary int//%))
+ (@.install "=" (@.binary int//=))
+ (@.install "<" (@.binary int//<))
+ (@.install "and" (@.binary int//and))
+ (@.install "or" (@.binary int//or))
+ (@.install "xor" (@.binary int//xor))
+ (@.install "shl" (@.binary int//shl))
+ (@.install "shr" (@.binary int//shr))
+ (@.install "ushr" (@.binary int//ushr))
)))
(def: long-procs
- @;Bundle
- (<| (@;prefix "long")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary long//+))
- (@;install "-" (@;binary long//-))
- (@;install "*" (@;binary long//*))
- (@;install "/" (@;binary long///))
- (@;install "%" (@;binary long//%))
- (@;install "=" (@;binary long//=))
- (@;install "<" (@;binary long//<))
- (@;install "and" (@;binary long//and))
- (@;install "or" (@;binary long//or))
- (@;install "xor" (@;binary long//xor))
- (@;install "shl" (@;binary long//shl))
- (@;install "shr" (@;binary long//shr))
- (@;install "ushr" (@;binary long//ushr))
+ @.Bundle
+ (<| (@.prefix "long")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary long//+))
+ (@.install "-" (@.binary long//-))
+ (@.install "*" (@.binary long//*))
+ (@.install "/" (@.binary long///))
+ (@.install "%" (@.binary long//%))
+ (@.install "=" (@.binary long//=))
+ (@.install "<" (@.binary long//<))
+ (@.install "and" (@.binary long//and))
+ (@.install "or" (@.binary long//or))
+ (@.install "xor" (@.binary long//xor))
+ (@.install "shl" (@.binary long//shl))
+ (@.install "shr" (@.binary long//shr))
+ (@.install "ushr" (@.binary long//ushr))
)))
(def: float-procs
- @;Bundle
- (<| (@;prefix "float")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary float//+))
- (@;install "-" (@;binary float//-))
- (@;install "*" (@;binary float//*))
- (@;install "/" (@;binary float///))
- (@;install "%" (@;binary float//%))
- (@;install "=" (@;binary float//=))
- (@;install "<" (@;binary float//<))
+ @.Bundle
+ (<| (@.prefix "float")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary float//+))
+ (@.install "-" (@.binary float//-))
+ (@.install "*" (@.binary float//*))
+ (@.install "/" (@.binary float///))
+ (@.install "%" (@.binary float//%))
+ (@.install "=" (@.binary float//=))
+ (@.install "<" (@.binary float//<))
)))
(def: double-procs
- @;Bundle
- (<| (@;prefix "double")
- (|> (dict;new text;Hash<Text>)
- (@;install "+" (@;binary double//+))
- (@;install "-" (@;binary double//-))
- (@;install "*" (@;binary double//*))
- (@;install "/" (@;binary double///))
- (@;install "%" (@;binary double//%))
- (@;install "=" (@;binary double//=))
- (@;install "<" (@;binary double//<))
+ @.Bundle
+ (<| (@.prefix "double")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "+" (@.binary double//+))
+ (@.install "-" (@.binary double//-))
+ (@.install "*" (@.binary double//*))
+ (@.install "/" (@.binary double///))
+ (@.install "%" (@.binary double//%))
+ (@.install "=" (@.binary double//=))
+ (@.install "<" (@.binary double//<))
)))
(def: char-procs
- @;Bundle
- (<| (@;prefix "char")
- (|> (dict;new text;Hash<Text>)
- (@;install "=" (@;binary char//=))
- (@;install "<" (@;binary char//<))
+ @.Bundle
+ (<| (@.prefix "char")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "=" (@.binary char//=))
+ (@.install "<" (@.binary char//<))
)))
(def: (array//length arrayI)
- @;Unary
- (|>. arrayI
- $i;ARRAYLENGTH
- $i;I2L
- ($i;wrap #$;Long)))
+ @.Unary
+ (|>> arrayI
+ $i.ARRAYLENGTH
+ $i.I2L
+ ($i.wrap #$.Long)))
(def: (array//new proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Nat level)] [_ (#;Text class)] lengthS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Nat level)] [_ (#.Text class)] lengthS))
+ (do macro.Monad<Meta>
[lengthI (translate lengthS)
- #let [arrayJT ($t;array level (case class
- "boolean" $t;boolean
- "byte" $t;byte
- "short" $t;short
- "int" $t;int
- "long" $t;long
- "float" $t;float
- "double" $t;double
- "char" $t;char
- _ ($t;class class (list))))]]
- (wrap (|>. lengthI
- ($i;unwrap #$;Long)
- $i;L2I
- ($i;array arrayJT))))
+ #let [arrayJT ($t.array level (case class
+ "boolean" $t.boolean
+ "byte" $t.byte
+ "short" $t.short
+ "int" $t.int
+ "long" $t.long
+ "float" $t.float
+ "double" $t.double
+ "char" $t.char
+ _ ($t.class class (list))))]]
+ (wrap (|>> lengthI
+ ($i.unwrap #$.Long)
+ $i.L2I
+ ($i.array arrayJT))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (array//read proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] idxS arrayS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] idxS arrayS))
+ (do macro.Monad<Meta>
[arrayI (translate arrayS)
idxI (translate idxS)
#let [loadI (case class
- "boolean" (|>. $i;BALOAD ($i;wrap #$;Boolean))
- "byte" (|>. $i;BALOAD ($i;wrap #$;Byte))
- "short" (|>. $i;SALOAD ($i;wrap #$;Short))
- "int" (|>. $i;IALOAD ($i;wrap #$;Int))
- "long" (|>. $i;LALOAD ($i;wrap #$;Long))
- "float" (|>. $i;FALOAD ($i;wrap #$;Float))
- "double" (|>. $i;DALOAD ($i;wrap #$;Double))
- "char" (|>. $i;CALOAD ($i;wrap #$;Char))
- _ $i;AALOAD)]]
- (wrap (|>. arrayI
+ "boolean" (|>> $i.BALOAD ($i.wrap #$.Boolean))
+ "byte" (|>> $i.BALOAD ($i.wrap #$.Byte))
+ "short" (|>> $i.SALOAD ($i.wrap #$.Short))
+ "int" (|>> $i.IALOAD ($i.wrap #$.Int))
+ "long" (|>> $i.LALOAD ($i.wrap #$.Long))
+ "float" (|>> $i.FALOAD ($i.wrap #$.Float))
+ "double" (|>> $i.DALOAD ($i.wrap #$.Double))
+ "char" (|>> $i.CALOAD ($i.wrap #$.Char))
+ _ $i.AALOAD)]]
+ (wrap (|>> arrayI
idxI
- ($i;unwrap #$;Long)
- $i;L2I
+ ($i.unwrap #$.Long)
+ $i.L2I
loadI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (array//write proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] idxS valueS arrayS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] idxS valueS arrayS))
+ (do macro.Monad<Meta>
[arrayI (translate arrayS)
idxI (translate idxS)
valueI (translate valueS)
#let [storeI (case class
- "boolean" (|>. ($i;unwrap #$;Boolean) $i;BASTORE)
- "byte" (|>. ($i;unwrap #$;Byte) $i;BASTORE)
- "short" (|>. ($i;unwrap #$;Short) $i;SASTORE)
- "int" (|>. ($i;unwrap #$;Int) $i;IASTORE)
- "long" (|>. ($i;unwrap #$;Long) $i;LASTORE)
- "float" (|>. ($i;unwrap #$;Float) $i;FASTORE)
- "double" (|>. ($i;unwrap #$;Double) $i;DASTORE)
- "char" (|>. ($i;unwrap #$;Char) $i;CASTORE)
- _ $i;AASTORE)]]
- (wrap (|>. arrayI
- $i;DUP
+ "boolean" (|>> ($i.unwrap #$.Boolean) $i.BASTORE)
+ "byte" (|>> ($i.unwrap #$.Byte) $i.BASTORE)
+ "short" (|>> ($i.unwrap #$.Short) $i.SASTORE)
+ "int" (|>> ($i.unwrap #$.Int) $i.IASTORE)
+ "long" (|>> ($i.unwrap #$.Long) $i.LASTORE)
+ "float" (|>> ($i.unwrap #$.Float) $i.FASTORE)
+ "double" (|>> ($i.unwrap #$.Double) $i.DASTORE)
+ "char" (|>> ($i.unwrap #$.Char) $i.CASTORE)
+ _ $i.AASTORE)]]
+ (wrap (|>> arrayI
+ $i.DUP
idxI
- ($i;unwrap #$;Long)
- $i;L2I
+ ($i.unwrap #$.Long)
+ $i.L2I
valueI
storeI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: array-procs
- @;Bundle
- (<| (@;prefix "array")
- (|> (dict;new text;Hash<Text>)
- (@;install "length" (@;unary array//length))
- (@;install "new" array//new)
- (@;install "read" array//read)
- (@;install "write" array//write)
+ @.Bundle
+ (<| (@.prefix "array")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "length" (@.unary array//length))
+ (@.install "new" array//new)
+ (@.install "read" array//read)
+ (@.install "write" array//write)
)))
(def: (object//null _)
- @;Nullary
- $i;NULL)
+ @.Nullary
+ $i.NULL)
(def: (object//null? objectI)
- @;Unary
- (<| $i;with-label (function [@then])
- $i;with-label (function [@end])
- (|>. objectI
- ($i;IFNULL @then)
- ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
- ($i;GOTO @end)
- ($i;label @then)
- ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
- ($i;label @end))))
+ @.Unary
+ (<| $i.with-label (function [@then])
+ $i.with-label (function [@end])
+ (|>> objectI
+ ($i.IFNULL @then)
+ ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+ ($i.GOTO @end)
+ ($i.label @then)
+ ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+ ($i.label @end))))
(def: (object//synchronized [monitorI exprI])
- @;Binary
- (|>. monitorI
- $i;DUP
- $i;MONITORENTER
+ @.Binary
+ (|>> monitorI
+ $i.DUP
+ $i.MONITORENTER
exprI
- $i;SWAP
- $i;MONITOREXIT))
+ $i.SWAP
+ $i.MONITOREXIT))
(def: (object//throw exceptionI)
- @;Unary
- (|>. exceptionI
- $i;ATHROW))
+ @.Unary
+ (|>> exceptionI
+ $i.ATHROW))
(def: (object//class proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)]))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)]))
+ (do macro.Monad<Meta>
[]
- (wrap (|>. ($i;string class)
- ($i;INVOKESTATIC "java.lang.Class" "forName"
- ($t;method (list ($t;class "java.lang.String" (list)))
- (#;Some ($t;class "java.lang.Class" (list)))
+ (wrap (|>> ($i.string class)
+ ($i.INVOKESTATIC "java.lang.Class" "forName"
+ ($t.method (list ($t.class "java.lang.String" (list)))
+ (#.Some ($t.class "java.lang.Class" (list)))
(list))
false))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (object//instance? proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] objectS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] objectS))
+ (do macro.Monad<Meta>
[objectI (translate objectS)]
- (wrap (|>. objectI
- ($i;INSTANCEOF class)
- ($i;wrap #$;Boolean))))
+ (wrap (|>> objectI
+ ($i.INSTANCEOF class)
+ ($i.wrap #$.Boolean))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: object-procs
- @;Bundle
- (<| (@;prefix "object")
- (|> (dict;new text;Hash<Text>)
- (@;install "null" (@;nullary object//null))
- (@;install "null?" (@;unary object//null?))
- (@;install "synchronized" (@;binary object//synchronized))
- (@;install "throw" (@;unary object//throw))
- (@;install "class" object//class)
- (@;install "instance?" object//instance?)
+ @.Bundle
+ (<| (@.prefix "object")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "null" (@.nullary object//null))
+ (@.install "null?" (@.unary object//null?))
+ (@.install "synchronized" (@.binary object//synchronized))
+ (@.install "throw" (@.unary object//throw))
+ (@.install "class" object//class)
+ (@.install "instance?" object//instance?)
)))
(def: primitives
- (Dict Text $;Primitive)
- (|> (list ["boolean" #$;Boolean]
- ["byte" #$;Byte]
- ["short" #$;Short]
- ["int" #$;Int]
- ["long" #$;Long]
- ["float" #$;Float]
- ["double" #$;Double]
- ["char" #$;Char])
- (dict;from-list text;Hash<Text>)))
+ (Dict Text $.Primitive)
+ (|> (list ["boolean" #$.Boolean]
+ ["byte" #$.Byte]
+ ["short" #$.Short]
+ ["int" #$.Int]
+ ["long" #$.Long]
+ ["float" #$.Float]
+ ["double" #$.Double]
+ ["char" #$.Char])
+ (dict.from-list text.Hash<Text>)))
(def: (static//get proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)]))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)]))
+ (do macro.Monad<Meta>
[]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. ($i;GETSTATIC class field (#$;Primitive primitive))
- ($i;wrap primitive))))
+ (wrap (|>> ($i.GETSTATIC class field (#$.Primitive primitive))
+ ($i.wrap primitive))))
- #;None
- (wrap ($i;GETSTATIC class field ($t;class unboxed (list))))))
+ #.None
+ (wrap ($i.GETSTATIC class field ($t.class unboxed (list))))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (static//put proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS))
+ (do macro.Monad<Meta>
[valueI (translate valueS)]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. valueI
- ($i;unwrap primitive)
- ($i;PUTSTATIC class field (#$;Primitive primitive))
- ($i;string hostL;unit))))
+ (wrap (|>> valueI
+ ($i.unwrap primitive)
+ ($i.PUTSTATIC class field (#$.Primitive primitive))
+ ($i.string hostL.unit))))
- #;None
- (wrap (|>. valueI
- ($i;CHECKCAST class)
- ($i;PUTSTATIC class field ($t;class class (list)))
- ($i;string hostL;unit)))))
+ #.None
+ (wrap (|>> valueI
+ ($i.CHECKCAST class)
+ ($i.PUTSTATIC class field ($t.class class (list)))
+ ($i.string hostL.unit)))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (virtual//get proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] objectS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] objectS))
+ (do macro.Monad<Meta>
[objectI (translate objectS)]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- ($i;GETFIELD class field (#$;Primitive primitive))
- ($i;wrap primitive))))
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ ($i.GETFIELD class field (#$.Primitive primitive))
+ ($i.wrap primitive))))
- #;None
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- ($i;GETFIELD class field ($t;class unboxed (list)))))))
+ #.None
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ ($i.GETFIELD class field ($t.class unboxed (list)))))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: (virtual//put proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS objectS))
- (do macro;Monad<Meta>
+ (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS objectS))
+ (do macro.Monad<Meta>
[valueI (translate valueS)
objectI (translate objectS)]
- (case (dict;get unboxed primitives)
- (#;Some primitive)
+ (case (dict.get unboxed primitives)
+ (#.Some primitive)
(let [primitive (case unboxed
- "boolean" #$;Boolean
- "byte" #$;Byte
- "short" #$;Short
- "int" #$;Int
- "long" #$;Long
- "float" #$;Float
- "double" #$;Double
- "char" #$;Char
+ "boolean" #$.Boolean
+ "byte" #$.Byte
+ "short" #$.Short
+ "int" #$.Int
+ "long" #$.Long
+ "float" #$.Float
+ "double" #$.Double
+ "char" #$.Char
_ (undefined))]
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- $i;DUP
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ $i.DUP
valueI
- ($i;unwrap primitive)
- ($i;PUTFIELD class field (#$;Primitive primitive)))))
+ ($i.unwrap primitive)
+ ($i.PUTFIELD class field (#$.Primitive primitive)))))
- #;None
- (wrap (|>. objectI
- ($i;CHECKCAST class)
- $i;DUP
+ #.None
+ (wrap (|>> objectI
+ ($i.CHECKCAST class)
+ $i.DUP
valueI
- ($i;CHECKCAST unboxed)
- ($i;PUTFIELD class field ($t;class unboxed (list)))))))
+ ($i.CHECKCAST unboxed)
+ ($i.PUTFIELD class field ($t.class unboxed (list)))))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: base-type
- (l;Lexer $;Type)
- ($_ p;either
- (p;after (l;this "boolean") (parser/wrap $t;boolean))
- (p;after (l;this "byte") (parser/wrap $t;byte))
- (p;after (l;this "short") (parser/wrap $t;short))
- (p;after (l;this "int") (parser/wrap $t;int))
- (p;after (l;this "long") (parser/wrap $t;long))
- (p;after (l;this "float") (parser/wrap $t;float))
- (p;after (l;this "double") (parser/wrap $t;double))
- (p;after (l;this "char") (parser/wrap $t;char))
+ (l.Lexer $.Type)
+ ($_ p.either
+ (p.after (l.this "boolean") (parser/wrap $t.boolean))
+ (p.after (l.this "byte") (parser/wrap $t.byte))
+ (p.after (l.this "short") (parser/wrap $t.short))
+ (p.after (l.this "int") (parser/wrap $t.int))
+ (p.after (l.this "long") (parser/wrap $t.long))
+ (p.after (l.this "float") (parser/wrap $t.float))
+ (p.after (l.this "double") (parser/wrap $t.double))
+ (p.after (l.this "char") (parser/wrap $t.char))
(parser/map (function [name]
- ($t;class name (list)))
- (l;many (l;none-of "[")))
+ ($t.class name (list)))
+ (l.many (l.none-of "[")))
))
(def: java-type
- (l;Lexer $;Type)
- (do p;Monad<Parser>
+ (l.Lexer $.Type)
+ (do p.Monad<Parser>
[raw base-type
- nesting (p;some (l;this "[]"))]
- (wrap ($t;array (list;size nesting) raw))))
+ nesting (p.some (l.this "[]"))]
+ (wrap ($t.array (list.size nesting) raw))))
(def: (translate-type argD)
- (-> Text (Meta $;Type))
- (case (l;run argD java-type)
- (#e;Error error)
- (&;throw Invalid-Syntax-For-JVM-Type argD)
+ (-> Text (Meta $.Type))
+ (case (l.run argD java-type)
+ (#e.Error error)
+ (&.throw Invalid-Syntax-For-JVM-Type argD)
- (#e;Success type)
+ (#e.Success type)
(macro/wrap type)))
(def: (prepare-input inputT inputI)
- (-> $;Type $;Inst $;Inst)
+ (-> $.Type $.Inst $.Inst)
(case inputT
- (#$;Primitive primitive)
- (|>. inputI ($i;unwrap primitive))
+ (#$.Primitive primitive)
+ (|>> inputI ($i.unwrap primitive))
- (#$;Generic generic)
+ (#$.Generic generic)
(case generic
- (^or (#$;Var _) (#$;Wildcard _))
- (|>. inputI ($i;CHECKCAST "java.lang.Object"))
+ (^or (#$.Var _) (#$.Wildcard _))
+ (|>> inputI ($i.CHECKCAST "java.lang.Object"))
- (#$;Class class-name _)
- (|>. inputI ($i;CHECKCAST class-name)))
+ (#$.Class class-name _)
+ (|>> inputI ($i.CHECKCAST class-name)))
_
- (|>. inputI ($i;CHECKCAST ($t;descriptor inputT)))))
+ (|>> inputI ($i.CHECKCAST ($t.descriptor inputT)))))
(def: (translate-args translate argsS)
- (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis)
- (Meta (List [$;Type $;Inst])))
+ (-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis)
+ (Meta (List [$.Type $.Inst])))
(case argsS
- #;Nil
- (macro/wrap #;Nil)
+ #.Nil
+ (macro/wrap #.Nil)
- (^ (list& [_ (#;Tuple (list [_ (#;Text argD)] argS))] tail))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Tuple (list [_ (#.Text argD)] argS))] tail))
+ (do macro.Monad<Meta>
[argT (translate-type argD)
argI (:: @ map (prepare-input argT) (translate argS))
=tail (translate-args translate tail)]
(wrap (list& [argT argI] =tail)))
_
- (&;throw Invalid-Syntax-For-Argument-Generation "")))
+ (&.throw Invalid-Syntax-For-Argument-Generation "")))
(def: (method-return-type description)
- (-> Text (Meta (Maybe $;Type)))
+ (-> Text (Meta (Maybe $.Type)))
(case description
"void"
- (macro/wrap #;None)
+ (macro/wrap #.None)
_
- (macro/map (|>. #;Some) (translate-type description))))
+ (macro/map (|>> #.Some) (translate-type description))))
(def: (prepare-return returnT returnI)
- (-> (Maybe $;Type) $;Inst $;Inst)
+ (-> (Maybe $.Type) $.Inst $.Inst)
(case returnT
- #;None
- (|>. returnI
- ($i;string hostL;unit))
+ #.None
+ (|>> returnI
+ ($i.string hostL.unit))
- (#;Some type)
+ (#.Some type)
(case type
- (#$;Primitive primitive)
- (|>. returnI ($i;wrap primitive))
+ (#$.Primitive primitive)
+ (|>> returnI ($i.wrap primitive))
_
returnI)))
(def: (invoke//static proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list& [_ (#;Text class)] [_ (#;Text method)]
- [_ (#;Text unboxed)] argsS))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Text class)] [_ (#.Text method)]
+ [_ (#.Text unboxed)] argsS))
+ (do macro.Monad<Meta>
[argsTI (translate-args translate argsS)
returnT (method-return-type unboxed)
- #let [callI (|>. ($i;fuse (list/map product;right argsTI))
- ($i;INVOKESTATIC class method
- ($t;method (list/map product;left argsTI) returnT (list))
+ #let [callI (|>> ($i.fuse (list/map product.right argsTI))
+ ($i.INVOKESTATIC class method
+ ($t.method (list/map product.left argsTI) returnT (list))
false))]]
(wrap (prepare-return returnT callI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(do-template [<name> <invoke> <interface?>]
[(def: (<name> proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list& [_ (#;Text class)] [_ (#;Text method)]
- [_ (#;Text unboxed)] objectS argsS))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Text class)] [_ (#.Text method)]
+ [_ (#.Text unboxed)] objectS argsS))
+ (do macro.Monad<Meta>
[objectI (translate objectS)
argsTI (translate-args translate argsS)
returnT (method-return-type unboxed)
- #let [callI (|>. objectI
- ($i;CHECKCAST class)
- ($i;fuse (list/map product;right argsTI))
+ #let [callI (|>> objectI
+ ($i.CHECKCAST class)
+ ($i.fuse (list/map product.right argsTI))
(<invoke> class method
- ($t;method (list/map product;left argsTI) returnT (list))
+ ($t.method (list/map product.left argsTI) returnT (list))
<interface?>))]]
(wrap (prepare-return returnT callI)))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))]
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))]
- [invoke//virtual $i;INVOKEVIRTUAL false]
- [invoke//special $i;INVOKESPECIAL false]
- [invoke//interface $i;INVOKEINTERFACE true]
+ [invoke//virtual $i.INVOKEVIRTUAL false]
+ [invoke//special $i.INVOKESPECIAL false]
+ [invoke//interface $i.INVOKEINTERFACE true]
)
(def: (invoke//constructor proc translate inputs)
- (-> Text @;Proc)
+ (-> Text @.Proc)
(case inputs
- (^ (list& [_ (#;Text class)] argsS))
- (do macro;Monad<Meta>
+ (^ (list& [_ (#.Text class)] argsS))
+ (do macro.Monad<Meta>
[argsTI (translate-args translate argsS)]
- (wrap (|>. ($i;NEW class)
- $i;DUP
- ($i;fuse (list/map product;right argsTI))
- ($i;INVOKESPECIAL class "<init>"
- ($t;method (list/map product;left argsTI) #;None (list))
+ (wrap (|>> ($i.NEW class)
+ $i.DUP
+ ($i.fuse (list/map product.right argsTI))
+ ($i.INVOKESPECIAL class "<init>"
+ ($t.method (list/map product.left argsTI) #.None (list))
false))))
_
- (&;throw @;Wrong-Syntax (@;wrong-syntax proc inputs))))
+ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
(def: member-procs
- @;Bundle
- (<| (@;prefix "member")
- (|> (dict;new text;Hash<Text>)
- (dict;merge (<| (@;prefix "static")
- (|> (dict;new text;Hash<Text>)
- (@;install "get" static//get)
- (@;install "put" static//put))))
- (dict;merge (<| (@;prefix "virtual")
- (|> (dict;new text;Hash<Text>)
- (@;install "get" virtual//get)
- (@;install "put" virtual//put))))
- (dict;merge (<| (@;prefix "invoke")
- (|> (dict;new text;Hash<Text>)
- (@;install "static" invoke//static)
- (@;install "virtual" invoke//virtual)
- (@;install "special" invoke//special)
- (@;install "interface" invoke//interface)
- (@;install "constructor" invoke//constructor))))
+ @.Bundle
+ (<| (@.prefix "member")
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge (<| (@.prefix "static")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "get" static//get)
+ (@.install "put" static//put))))
+ (dict.merge (<| (@.prefix "virtual")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "get" virtual//get)
+ (@.install "put" virtual//put))))
+ (dict.merge (<| (@.prefix "invoke")
+ (|> (dict.new text.Hash<Text>)
+ (@.install "static" invoke//static)
+ (@.install "virtual" invoke//virtual)
+ (@.install "special" invoke//special)
+ (@.install "interface" invoke//interface)
+ (@.install "constructor" invoke//constructor))))
)))
(def: #export procedures
- @;Bundle
- (<| (@;prefix "jvm")
- (|> (dict;new text;Hash<Text>)
- (dict;merge conversion-procs)
- (dict;merge int-procs)
- (dict;merge long-procs)
- (dict;merge float-procs)
- (dict;merge double-procs)
- (dict;merge char-procs)
- (dict;merge array-procs)
- (dict;merge object-procs)
- (dict;merge member-procs)
+ @.Bundle
+ (<| (@.prefix "jvm")
+ (|> (dict.new text.Hash<Text>)
+ (dict.merge conversion-procs)
+ (dict.merge int-procs)
+ (dict.merge long-procs)
+ (dict.merge float-procs)
+ (dict.merge double-procs)
+ (dict.merge char-procs)
+ (dict.merge array-procs)
+ (dict.merge object-procs)
+ (dict.merge member-procs)
)))
diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
index bfc838041..bfb5856d4 100644
--- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -1,17 +1,17 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do])
(data [text "text/" Hash<Text>]
text/format)
[macro "macro/" Monad<Meta>])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$i" inst]))
["ls" synthesis]
- [";L" variable #+ Variable]
- (translation [";T" common]))))
+ [".L" variable #+ Variable]
+ (translation [".T" common]))))
(do-template [<name> <prefix>]
[(def: #export (<name> idx)
@@ -23,27 +23,27 @@
)
(def: #export (translate-captured variable)
- (-> Variable (Meta $;Inst))
- (do macro;Monad<Meta>
- [this-module macro;current-module-name
- function-class hostL;context
- #let [function-class (format (text;replace-all "/" "." this-module) "." function-class)]]
- (wrap (|>. ($i;ALOAD +0)
- ($i;GETFIELD function-class
- (|> variable i.inc (i.* -1) int-to-nat captured)
- commonT;$Object)))))
+ (-> Variable (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [this-module macro.current-module-name
+ function-class hostL.context
+ #let [function-class (format (text.replace-all "/" "." this-module) "." function-class)]]
+ (wrap (|>> ($i.ALOAD +0)
+ ($i.GETFIELD function-class
+ (|> variable i/inc (i/* -1) int-to-nat captured)
+ commonT.$Object)))))
(def: #export (translate-local variable)
- (-> Variable (Meta $;Inst))
- (macro/wrap ($i;ALOAD (int-to-nat variable))))
+ (-> Variable (Meta $.Inst))
+ (macro/wrap ($i.ALOAD (int-to-nat variable))))
(def: #export (translate-variable variable)
- (-> Variable (Meta $;Inst))
- (if (variableL;captured? variable)
+ (-> Variable (Meta $.Inst))
+ (if (variableL.captured? variable)
(translate-captured variable)
(translate-local variable)))
(def: #export (translate-definition [def-module def-name])
- (-> Ident (Meta $;Inst))
- (let [bytecode-name (format def-module "/" (&;normalize-name def-name) (%n (text/hash def-name)))]
- (macro/wrap ($i;GETSTATIC bytecode-name commonT;value-field commonT;$Object))))
+ (-> Ident (Meta $.Inst))
+ (let [bytecode-name (format def-module "/" (&.normalize-name def-name) (%n (text/hash def-name)))]
+ (macro/wrap ($i.GETSTATIC bytecode-name commonT.value-field commonT.$Object))))
diff --git a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
index d2bb1645b..aa210718b 100644
--- a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
@@ -1,371 +1,347 @@
-(;module:
+(.module:
lux
(lux (control monad)
(data text/format
(coll [list "list/" Functor<List>]))
[math]
- [macro]
- [host])
+ [macro])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["la" analysis]
["ls" synthesis]
- (translation [";T" common]))))
+ (translation [".T" common]))))
-(host;import java.lang.Object)
-(host;import java.lang.String)
-
-(host;import java.lang.reflect.Field
- (get [Object] #try Object))
-
-(host;import (java.lang.Class a)
- (getField [String] Field))
-
-(host;import org.objectweb.asm.Opcodes
- (#static ACC_PUBLIC int)
- (#static ACC_SUPER int)
- (#static ACC_FINAL int)
- (#static ACC_STATIC int)
- (#static V1_6 int))
-
-(host;import org.objectweb.asm.ClassWriter
- (#static COMPUTE_MAXS int)
- (new [int])
- (visit [int int String String String (Array String)] void)
- (visitEnd [] void)
- (toByteArray [] (Array byte)))
-
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
-(def: $Object-Array $;Type ($t;array +1 $Object))
-(def: $String $;Type ($t;class "java.lang.String" (list)))
-(def: #export $Stack $;Type ($t;array +1 $Object))
-(def: #export $Tuple $;Type $Object-Array)
-(def: #export $Variant $;Type $Object-Array)
-(def: #export $Tag $;Type $t;int)
-(def: #export $Flag $;Type $Object)
-(def: #export $Datum $;Type $Object)
-(def: #export $Function $;Type ($t;class hostL;function-class (list)))
-(def: $Throwable $;Type ($t;class "java.lang.Throwable" (list)))
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
+(def: $Object-Array $.Type ($t.array +1 $Object))
+(def: $String $.Type ($t.class "java.lang.String" (list)))
+(def: #export $Stack $.Type ($t.array +1 $Object))
+(def: #export $Tuple $.Type $Object-Array)
+(def: #export $Variant $.Type $Object-Array)
+(def: #export $Tag $.Type $t.int)
+(def: #export $Flag $.Type $Object)
+(def: #export $Datum $.Type $Object)
+(def: #export $Function $.Type ($t.class hostL.function-class (list)))
+(def: $Throwable $.Type ($t.class "java.lang.Throwable" (list)))
(def: #export logI
- $;Inst
- (let [outI ($i;GETSTATIC "java.lang.System" "out" ($t;class "java.io.PrintStream" (list)))
- printI (function [method] ($i;INVOKEVIRTUAL "java.io.PrintStream" method ($t;method (list $Object) #;None (list)) false))]
- (|>. outI ($i;string "LOG: ") (printI "print")
- outI $i;SWAP (printI "println"))))
+ $.Inst
+ (let [outI ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list)))
+ printI (function [method] ($i.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) false))]
+ (|>> outI ($i.string "LOG: ") (printI "print")
+ outI $i.SWAP (printI "println"))))
(def: variant-method
- $;Method
- ($t;method (list $t;int $Object $Object) (#;Some $Object-Array) (list)))
+ $.Method
+ ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list)))
(def: variantI
- $;Inst
- ($i;INVOKESTATIC hostL;runtime-class "variant_make" variant-method false))
+ $.Inst
+ ($i.INVOKESTATIC hostL.runtime-class "variant_make" variant-method false))
(def: #export leftI
- $;Inst
- (|>. ($i;int 0)
- $i;NULL
- $i;DUP2_X1
- $i;POP2
+ $.Inst
+ (|>> ($i.int 0)
+ $i.NULL
+ $i.DUP2_X1
+ $i.POP2
variantI))
(def: #export rightI
- $;Inst
- (|>. ($i;int 1)
- ($i;string "")
- $i;DUP2_X1
- $i;POP2
+ $.Inst
+ (|>> ($i.int 1)
+ ($i.string "")
+ $i.DUP2_X1
+ $i.POP2
variantI))
-(def: #export someI $;Inst rightI)
+(def: #export someI $.Inst rightI)
(def: #export noneI
- $;Inst
- (|>. ($i;int 0)
- $i;NULL
- ($i;string hostL;unit)
+ $.Inst
+ (|>> ($i.int 0)
+ $i.NULL
+ ($i.string hostL.unit)
variantI))
(def: (try-methodI unsafeI)
- (-> $;Inst $;Inst)
- (<| $i;with-label (function [@from])
- $i;with-label (function [@to])
- $i;with-label (function [@handler])
- (|>. ($i;try @from @to @handler "java.lang.Exception")
- ($i;label @from)
+ (-> $.Inst $.Inst)
+ (<| $i.with-label (function [@from])
+ $i.with-label (function [@to])
+ $i.with-label (function [@handler])
+ (|>> ($i.try @from @to @handler "java.lang.Exception")
+ ($i.label @from)
unsafeI
someI
- $i;ARETURN
- ($i;label @to)
- ($i;label @handler)
+ $i.ARETURN
+ ($i.label @to)
+ ($i.label @handler)
noneI
- $i;ARETURN)))
+ $i.ARETURN)))
(def: #export string-concatI
- $;Inst
- ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false))
+ $.Inst
+ ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) false))
(def: #export partials-field Text "partials")
(def: #export apply-method Text "apply")
(def: #export num-apply-variants Nat +8)
(def: #export (apply-signature arity)
- (-> ls;Arity $;Method)
- ($t;method (list;repeat arity $Object) (#;Some $Object) (list)))
+ (-> ls.Arity $.Method)
+ ($t.method (list.repeat arity $Object) (#.Some $Object) (list)))
(def: adt-methods
- $;Def
- (let [store-tagI (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) ($i;wrap #$;Int) $i;AASTORE)
- store-flagI (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE)
- store-valueI (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)
- force-textMT ($t;method (list $Object) (#;Some $String) (list))]
- (|>. ($d;method #$;Public $;staticM "force_text" force-textMT
- (<| $i;with-label (function [@is-null])
- $i;with-label (function [@normal-object])
- $i;with-label (function [@array-loop])
- $i;with-label (function [@within-bounds])
- $i;with-label (function [@is-first])
- $i;with-label (function [@elem-end])
- $i;with-label (function [@fold-end])
- (let [on-normal-objectI (|>. ($i;ALOAD +0)
- ($i;INVOKEVIRTUAL "java.lang.Object" "toString" ($t;method (list) (#;Some $String) (list)) false))
- on-null-objectI ($i;string "NULL")
- arrayI (|>. ($i;ALOAD +0)
- ($i;CHECKCAST ($t;descriptor $Object-Array)))
- recurseI ($i;INVOKESTATIC hostL;runtime-class "force_text" force-textMT false)
- force-elemI (|>. $i;DUP arrayI $i;SWAP $i;AALOAD recurseI)
- swap2 (|>. $i;DUP2_X2 ## X,Y => Y,X,Y
- $i;POP2 ## Y,X,Y => Y,X
+ $.Def
+ (let [store-tagI (|>> $i.DUP ($i.int 0) ($i.ILOAD +0) ($i.wrap #$.Int) $i.AASTORE)
+ store-flagI (|>> $i.DUP ($i.int 1) ($i.ALOAD +1) $i.AASTORE)
+ store-valueI (|>> $i.DUP ($i.int 2) ($i.ALOAD +2) $i.AASTORE)
+ force-textMT ($t.method (list $Object) (#.Some $String) (list))]
+ (|>> ($d.method #$.Public $.staticM "force_text" force-textMT
+ (<| $i.with-label (function [@is-null])
+ $i.with-label (function [@normal-object])
+ $i.with-label (function [@array-loop])
+ $i.with-label (function [@within-bounds])
+ $i.with-label (function [@is-first])
+ $i.with-label (function [@elem-end])
+ $i.with-label (function [@fold-end])
+ (let [on-normal-objectI (|>> ($i.ALOAD +0)
+ ($i.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) false))
+ on-null-objectI ($i.string "NULL")
+ arrayI (|>> ($i.ALOAD +0)
+ ($i.CHECKCAST ($t.descriptor $Object-Array)))
+ recurseI ($i.INVOKESTATIC hostL.runtime-class "force_text" force-textMT false)
+ force-elemI (|>> $i.DUP arrayI $i.SWAP $i.AALOAD recurseI)
+ swap2 (|>> $i.DUP2_X2 ## X,Y => Y,X,Y
+ $i.POP2 ## Y,X,Y => Y,X
)
- add-spacingI (|>. ($i;string ", ") $i;SWAP string-concatI)
- merge-with-totalI (|>. $i;DUP_X2 $i;POP ## TSIP => TPSI
+ add-spacingI (|>> ($i.string ", ") $i.SWAP string-concatI)
+ merge-with-totalI (|>> $i.DUP_X2 $i.POP ## TSIP => TPSI
swap2 ## TPSI => SITP
string-concatI ## SITP => SIT
- $i;DUP_X2 $i;POP ## SIT => TSI
+ $i.DUP_X2 $i.POP ## SIT => TSI
)
- foldI (|>. $i;DUP ## TSI => TSII
- ($i;IFEQ @is-first) ## TSI
- force-elemI add-spacingI merge-with-totalI ($i;GOTO @elem-end)
- ($i;label @is-first) ## TSI
+ foldI (|>> $i.DUP ## TSI => TSII
+ ($i.IFEQ @is-first) ## TSI
+ force-elemI add-spacingI merge-with-totalI ($i.GOTO @elem-end)
+ ($i.label @is-first) ## TSI
force-elemI merge-with-totalI
- ($i;label @elem-end) ## TSI
+ ($i.label @elem-end) ## TSI
)
- inc-idxI (|>. ($i;int 1) $i;IADD)
- on-array-objectI (|>. ($i;string "[") ## T
- arrayI $i;ARRAYLENGTH ## TS
- ($i;int 0) ## TSI
- ($i;label @array-loop) ## TSI
- $i;DUP2
- ($i;IF_ICMPGT @within-bounds) ## TSI
- $i;POP2 ($i;string "]") string-concatI ($i;GOTO @fold-end)
- ($i;label @within-bounds)
- foldI inc-idxI ($i;GOTO @array-loop)
- ($i;label @fold-end))])
- (|>. ($i;ALOAD +0)
- ($i;IFNULL @is-null)
- ($i;ALOAD +0)
- ($i;INSTANCEOF ($t;descriptor $Object-Array))
- ($i;IFEQ @normal-object)
- on-array-objectI $i;ARETURN
- ($i;label @normal-object) on-normal-objectI $i;ARETURN
- ($i;label @is-null) on-null-objectI $i;ARETURN)))
- ($d;method #$;Public $;staticM "variant_make"
- ($t;method (list $t;int $Object $Object)
- (#;Some $Variant)
+ inc-idxI (|>> ($i.int 1) $i.IADD)
+ on-array-objectI (|>> ($i.string "[") ## T
+ arrayI $i.ARRAYLENGTH ## TS
+ ($i.int 0) ## TSI
+ ($i.label @array-loop) ## TSI
+ $i.DUP2
+ ($i.IF_ICMPGT @within-bounds) ## TSI
+ $i.POP2 ($i.string "]") string-concatI ($i.GOTO @fold-end)
+ ($i.label @within-bounds)
+ foldI inc-idxI ($i.GOTO @array-loop)
+ ($i.label @fold-end))])
+ (|>> ($i.ALOAD +0)
+ ($i.IFNULL @is-null)
+ ($i.ALOAD +0)
+ ($i.INSTANCEOF ($t.descriptor $Object-Array))
+ ($i.IFEQ @normal-object)
+ on-array-objectI $i.ARETURN
+ ($i.label @normal-object) on-normal-objectI $i.ARETURN
+ ($i.label @is-null) on-null-objectI $i.ARETURN)))
+ ($d.method #$.Public $.staticM "variant_make"
+ ($t.method (list $t.int $Object $Object)
+ (#.Some $Variant)
(list))
- (|>. ($i;int 3)
- ($i;array $Object)
+ (|>> ($i.int 3)
+ ($i.array $Object)
store-tagI
store-flagI
store-valueI
- $i;ARETURN)))))
+ $i.ARETURN)))))
(def: #export force-textI
- $;Inst
- ($i;INVOKESTATIC hostL;runtime-class "force_text" ($t;method (list $Object) (#;Some $String) (list)) false))
+ $.Inst
+ ($i.INVOKESTATIC hostL.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) false))
(def: nat-methods
- $;Def
- (let [compare-nat-method ($t;method (list $t;long $t;long) (#;Some $t;int) (list))
- less-thanI (function [@where] (|>. ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false) ($i;IFLT @where)))
- $BigInteger ($t;class "java.math.BigInteger" (list))
- upcast-method ($t;method (list $t;long) (#;Some $BigInteger) (list))
- div-method ($t;method (list $t;long $t;long) (#;Some $t;long) (list))
- upcastI ($i;INVOKESTATIC hostL;runtime-class "_toUnsignedBigInteger" upcast-method false)
- downcastI ($i;INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t;method (list) (#;Some $t;long) (list)) false)]
- (|>. ($d;method #$;Public $;staticM "_toUnsignedBigInteger" upcast-method
- (let [upcastI ($i;INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false)
- discernI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGE @where)))
- prepare-upperI (|>. ($i;LLOAD +0) ($i;int 32) $i;LUSHR
+ $.Def
+ (let [compare-nat-method ($t.method (list $t.long $t.long) (#.Some $t.int) (list))
+ less-thanI (function [@where] (|>> ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false) ($i.IFLT @where)))
+ $BigInteger ($t.class "java.math.BigInteger" (list))
+ upcast-method ($t.method (list $t.long) (#.Some $BigInteger) (list))
+ div-method ($t.method (list $t.long $t.long) (#.Some $t.long) (list))
+ upcastI ($i.INVOKESTATIC hostL.runtime-class "_toUnsignedBigInteger" upcast-method false)
+ downcastI ($i.INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t.method (list) (#.Some $t.long) (list)) false)]
+ (|>> ($d.method #$.Public $.staticM "_toUnsignedBigInteger" upcast-method
+ (let [upcastI ($i.INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false)
+ discernI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGE @where)))
+ prepare-upperI (|>> ($i.LLOAD +0) ($i.int 32) $i.LUSHR
upcastI
- ($i;int 32) ($i;INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t;method (list $t;int) (#;Some $BigInteger) (list)) false))
- prepare-lowerI (|>. ($i;LLOAD +0) ($i;int 32) $i;LSHL
- ($i;int 32) $i;LUSHR
+ ($i.int 32) ($i.INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t.method (list $t.int) (#.Some $BigInteger) (list)) false))
+ prepare-lowerI (|>> ($i.LLOAD +0) ($i.int 32) $i.LSHL
+ ($i.int 32) $i.LUSHR
upcastI)]
- (<| $i;with-label (function [@simple])
- (|>. (discernI @simple)
+ (<| $i.with-label (function [@simple])
+ (|>> (discernI @simple)
## else
prepare-upperI
prepare-lowerI
- ($i;INVOKEVIRTUAL "java.math.BigInteger" "add" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)
- $i;ARETURN
+ ($i.INVOKEVIRTUAL "java.math.BigInteger" "add" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)
+ $i.ARETURN
## then
- ($i;label @simple)
- ($i;LLOAD +0)
+ ($i.label @simple)
+ ($i.LLOAD +0)
upcastI
- $i;ARETURN))))
- ($d;method #$;Public $;staticM "compare_nat" compare-nat-method
- (let [shiftI (|>. ($i;GETSTATIC "java.lang.Long" "MIN_VALUE" $t;long) $i;LADD)]
- (|>. ($i;LLOAD +0) shiftI
- ($i;LLOAD +2) shiftI
- $i;LCMP
- $i;IRETURN)))
- ($d;method #$;Public $;staticM "div_nat" div-method
- (let [is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLT @where)))
- is-subject-smallI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGT @where)))
- small-division (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LDIV $i;LRETURN)
- big-divisionI ($i;INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)]
- (<| $i;with-label (function [@is-zero])
- $i;with-label (function [@param-is-large])
- $i;with-label (function [@subject-is-small])
- (|>. (is-param-largeI @param-is-large)
+ $i.ARETURN))))
+ ($d.method #$.Public $.staticM "compare_nat" compare-nat-method
+ (let [shiftI (|>> ($i.GETSTATIC "java.lang.Long" "MIN_VALUE" $t.long) $i.LADD)]
+ (|>> ($i.LLOAD +0) shiftI
+ ($i.LLOAD +2) shiftI
+ $i.LCMP
+ $i.IRETURN)))
+ ($d.method #$.Public $.staticM "div_nat" div-method
+ (let [is-param-largeI (function [@where] (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLT @where)))
+ is-subject-smallI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGT @where)))
+ small-division (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LDIV $i.LRETURN)
+ big-divisionI ($i.INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)]
+ (<| $i.with-label (function [@is-zero])
+ $i.with-label (function [@param-is-large])
+ $i.with-label (function [@subject-is-small])
+ (|>> (is-param-largeI @param-is-large)
## Param is not too large
(is-subject-smallI @subject-is-small)
## Param is small, but subject is large
- ($i;LLOAD +0) upcastI
- ($i;LLOAD +2) upcastI
- big-divisionI downcastI $i;LRETURN
+ ($i.LLOAD +0) upcastI
+ ($i.LLOAD +2) upcastI
+ big-divisionI downcastI $i.LRETURN
## Both param and subject are small,
## and can thus be divided normally.
- ($i;label @subject-is-small)
+ ($i.label @subject-is-small)
small-division
## Param is too large. Cannot simply divide.
## Depending on the result of the
## comparison, a result will be determined.
- ($i;label @param-is-large)
- ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @is-zero)
+ ($i.label @param-is-large)
+ ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @is-zero)
## Greater-than or equals
- ($i;long 1) $i;LRETURN
+ ($i.long 1) $i.LRETURN
## Less than
- ($i;label @is-zero)
- ($i;long 0) $i;LRETURN))))
- ($d;method #$;Public $;staticM "rem_nat" div-method
- (let [is-subject-largeI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFLE @where)))
- is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLE @where)))
- small-remainderI (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LREM $i;LRETURN)
- big-remainderI ($i;INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)]
- (<| $i;with-label (function [@large-number])
- $i;with-label (function [@subject-is-smaller-than-param])
- (|>. (is-subject-largeI @large-number)
+ ($i.label @is-zero)
+ ($i.long 0) $i.LRETURN))))
+ ($d.method #$.Public $.staticM "rem_nat" div-method
+ (let [is-subject-largeI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFLE @where)))
+ is-param-largeI (function [@where] (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLE @where)))
+ small-remainderI (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LREM $i.LRETURN)
+ big-remainderI ($i.INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)]
+ (<| $i.with-label (function [@large-number])
+ $i.with-label (function [@subject-is-smaller-than-param])
+ (|>> (is-subject-largeI @large-number)
(is-param-largeI @large-number)
small-remainderI
- ($i;label @large-number)
- ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @subject-is-smaller-than-param)
+ ($i.label @large-number)
+ ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @subject-is-smaller-than-param)
- ($i;LLOAD +0) upcastI
- ($i;LLOAD +2) upcastI
- big-remainderI downcastI $i;LRETURN
+ ($i.LLOAD +0) upcastI
+ ($i.LLOAD +2) upcastI
+ big-remainderI downcastI $i.LRETURN
- ($i;label @subject-is-smaller-than-param)
- ($i;LLOAD +0)
- $i;LRETURN))))
+ ($i.label @subject-is-smaller-than-param)
+ ($i.LLOAD +0)
+ $i.LRETURN))))
)))
-(def: frac-shiftI $;Inst ($i;double (math;pow 32.0 2.0)))
+(def: frac-shiftI $.Inst ($i.double (math.pow 32.0 2.0)))
(def: frac-methods
- $;Def
- (|>. ($d;method #$;Public $;staticM "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list))
+ $.Def
+ (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list))
(try-methodI
- (|>. ($i;ALOAD +0)
- ($i;INVOKESTATIC "java.lang.Double" "parseDouble" ($t;method (list $String) (#;Some $t;double) (list)) false)
- ($i;wrap #$;Double))))
- ($d;method #$;Public $;staticM "frac_to_deg" ($t;method (list $t;double) (#;Some $t;long) (list))
- (let [swap2 (|>. $i;DUP2_X2 $i;POP2)
- drop-excessI (|>. ($i;double 1.0) $i;DREM)
- shiftI (|>. frac-shiftI $i;DMUL)]
- (|>. ($i;DLOAD +0)
+ (|>> ($i.ALOAD +0)
+ ($i.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) false)
+ ($i.wrap #$.Double))))
+ ($d.method #$.Public $.staticM "frac_to_deg" ($t.method (list $t.double) (#.Some $t.long) (list))
+ (let [swap2 (|>> $i.DUP2_X2 $i.POP2)
+ drop-excessI (|>> ($i.double 1.0) $i.DREM)
+ shiftI (|>> frac-shiftI $i.DMUL)]
+ (|>> ($i.DLOAD +0)
## Get upper half
drop-excessI
shiftI
## Make a copy, so the lower half can be extracted
- $i;DUP2
+ $i.DUP2
## Get lower half
drop-excessI
shiftI
## Turn it into a deg
- $i;D2L
+ $i.D2L
## Turn the upper half into deg too
swap2
- $i;D2L
+ $i.D2L
## Combine both pieces
- $i;LADD
+ $i.LADD
## FINISH
- $i;LRETURN
+ $i.LRETURN
)))
))
(def: deg-bits Nat +64)
-(def: deg-method $;Method ($t;method (list $t;long $t;long) (#;Some $t;long) (list)))
-(def: clz-method $;Method ($t;method (list $t;long) (#;Some $t;int) (list)))
+(def: deg-method $.Method ($t.method (list $t.long $t.long) (#.Some $t.long) (list)))
+(def: clz-method $.Method ($t.method (list $t.long) (#.Some $t.int) (list)))
(def: deg-methods
- $;Def
+ $.Def
(let [## "And" mask corresponding to -1 (FFFF...), on the low 32 bits.
- low-half (|>. ($i;int -1) $i;I2L $i;LAND)
- high-half (|>. ($i;int 32) $i;LUSHR)]
- (|>. ($d;method #$;Public $;staticM "mul_deg" deg-method
+ low-half (|>> ($i.int -1) $i.I2L $i.LAND)
+ high-half (|>> ($i.int 32) $i.LUSHR)]
+ (|>> ($d.method #$.Public $.staticM "mul_deg" deg-method
## Based on: http://stackoverflow.com/a/31629280/6823464
- (let [shift-downI (|>. ($i;int 32) $i;LUSHR)
- low-leftI (|>. ($i;LLOAD +0) low-half)
- high-leftI (|>. ($i;LLOAD +0) high-half)
- low-rightI (|>. ($i;LLOAD +2) low-half)
- high-rightI (|>. ($i;LLOAD +2) high-half)
- bottomI (|>. low-leftI low-rightI $i;LMUL)
- middleLI (|>. high-leftI low-rightI $i;LMUL)
- middleRI (|>. low-leftI high-rightI $i;LMUL)
- middleI (|>. middleLI middleRI $i;LADD)
- topI (|>. high-leftI high-rightI $i;LMUL)]
- (|>. bottomI shift-downI
- middleI $i;LADD shift-downI
- topI $i;LADD
- $i;LRETURN)))
- ($d;method #$;Public $;staticM "count_leading_zeros" clz-method
- (let [when-zeroI (function [@where] (|>. ($i;long 0) $i;LCMP ($i;IFEQ @where)))
- shift-rightI (function [amount] (|>. ($i;int amount) $i;LUSHR))
- decI (|>. ($i;int 1) $i;ISUB)]
- (<| $i;with-label (function [@start])
- $i;with-label (function [@done])
- (|>. ($i;int 64)
- ($i;label @start)
- ($i;LLOAD +0) (when-zeroI @done)
- ($i;LLOAD +0) (shift-rightI 1) ($i;LSTORE +0)
+ (let [shift-downI (|>> ($i.int 32) $i.LUSHR)
+ low-leftI (|>> ($i.LLOAD +0) low-half)
+ high-leftI (|>> ($i.LLOAD +0) high-half)
+ low-rightI (|>> ($i.LLOAD +2) low-half)
+ high-rightI (|>> ($i.LLOAD +2) high-half)
+ bottomI (|>> low-leftI low-rightI $i.LMUL)
+ middleLI (|>> high-leftI low-rightI $i.LMUL)
+ middleRI (|>> low-leftI high-rightI $i.LMUL)
+ middleI (|>> middleLI middleRI $i.LADD)
+ topI (|>> high-leftI high-rightI $i.LMUL)]
+ (|>> bottomI shift-downI
+ middleI $i.LADD shift-downI
+ topI $i.LADD
+ $i.LRETURN)))
+ ($d.method #$.Public $.staticM "count_leading_zeros" clz-method
+ (let [when-zeroI (function [@where] (|>> ($i.long 0) $i.LCMP ($i.IFEQ @where)))
+ shift-rightI (function [amount] (|>> ($i.int amount) $i.LUSHR))
+ decI (|>> ($i.int 1) $i.ISUB)]
+ (<| $i.with-label (function [@start])
+ $i.with-label (function [@done])
+ (|>> ($i.int 64)
+ ($i.label @start)
+ ($i.LLOAD +0) (when-zeroI @done)
+ ($i.LLOAD +0) (shift-rightI 1) ($i.LSTORE +0)
decI
- ($i;GOTO @start)
- ($i;label @done)
- $i;IRETURN))))
- ($d;method #$;Public $;staticM "div_deg" deg-method
- (<| $i;with-label (function [@same])
- (let [subjectI ($i;LLOAD +0)
- paramI ($i;LLOAD +2)
- equal?I (function [@where] (|>. $i;LCMP ($i;IFEQ @where)))
- count-leading-zerosI ($i;INVOKESTATIC hostL;runtime-class "count_leading_zeros" clz-method false)
- calc-max-shiftI (|>. subjectI count-leading-zerosI
+ ($i.GOTO @start)
+ ($i.label @done)
+ $i.IRETURN))))
+ ($d.method #$.Public $.staticM "div_deg" deg-method
+ (<| $i.with-label (function [@same])
+ (let [subjectI ($i.LLOAD +0)
+ paramI ($i.LLOAD +2)
+ equal?I (function [@where] (|>> $i.LCMP ($i.IFEQ @where)))
+ count-leading-zerosI ($i.INVOKESTATIC hostL.runtime-class "count_leading_zeros" clz-method false)
+ calc-max-shiftI (|>> subjectI count-leading-zerosI
paramI count-leading-zerosI
- ($i;INVOKESTATIC "java.lang.Math" "min" ($t;method (list $t;int $t;int) (#;Some $t;int) (list)) false)
- ($i;ISTORE +4))
- shiftI (|>. ($i;ILOAD +4) $i;LSHL)
- imprecise-divisionI (|>. subjectI shiftI
+ ($i.INVOKESTATIC "java.lang.Math" "min" ($t.method (list $t.int $t.int) (#.Some $t.int) (list)) false)
+ ($i.ISTORE +4))
+ shiftI (|>> ($i.ILOAD +4) $i.LSHL)
+ imprecise-divisionI (|>> subjectI shiftI
paramI shiftI high-half
- $i;LDIV)
- scale-downI (|>. ($i;int 32) $i;LSHL)]
- (|>. subjectI paramI
+ $i.LDIV)
+ scale-downI (|>> ($i.int 32) $i.LSHL)]
+ (|>> subjectI paramI
(equal?I @same)
## Based on: http://stackoverflow.com/a/8510587/6823464
## Shifting the operands as much as possible can help
@@ -373,255 +349,255 @@
calc-max-shiftI
imprecise-divisionI
scale-downI
- $i;LRETURN
- ($i;label @same)
- ($i;long -1) ## ~= 1.0 Degrees
- $i;LRETURN))))
- ($d;method #$;Public $;staticM "deg_to_frac" ($t;method (list $t;long) (#;Some $t;double) (list))
- (let [highI (|>. ($i;LLOAD +0) high-half $i;L2D)
- lowI (|>. ($i;LLOAD +0) low-half $i;L2D)
- scaleI (|>. frac-shiftI $i;DDIV)]
- (|>. highI scaleI
+ $i.LRETURN
+ ($i.label @same)
+ ($i.long -1) ## ~= 1.0 Degrees
+ $i.LRETURN))))
+ ($d.method #$.Public $.staticM "deg_to_frac" ($t.method (list $t.long) (#.Some $t.double) (list))
+ (let [highI (|>> ($i.LLOAD +0) high-half $i.L2D)
+ lowI (|>> ($i.LLOAD +0) low-half $i.L2D)
+ scaleI (|>> frac-shiftI $i.DDIV)]
+ (|>> highI scaleI
lowI scaleI scaleI
- $i;DADD
- $i;DRETURN)))
+ $i.DADD
+ $i.DRETURN)))
)))
(def: text-methods
- $;Def
- (|>. ($d;method #$;Public $;staticM "text_clip" ($t;method (list $String $t;int $t;int) (#;Some $Variant) (list))
+ $.Def
+ (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list))
(try-methodI
- (|>. ($i;ALOAD +0)
- ($i;ILOAD +1)
- ($i;ILOAD +2)
- ($i;INVOKEVIRTUAL "java.lang.String" "substring" ($t;method (list $t;int $t;int) (#;Some $String) (list)) false))))
- ($d;method #$;Public $;staticM "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list))
+ (|>> ($i.ALOAD +0)
+ ($i.ILOAD +1)
+ ($i.ILOAD +2)
+ ($i.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) false))))
+ ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list))
(try-methodI
- (|>. ($i;ALOAD +0)
- ($i;ILOAD +1)
- ($i;INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t;method (list $t;int) (#;Some $t;int) (list)) false)
- $i;I2L
- ($i;wrap #$;Long))))
+ (|>> ($i.ALOAD +0)
+ ($i.ILOAD +1)
+ ($i.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) false)
+ $i.I2L
+ ($i.wrap #$.Long))))
))
(def: pm-methods
- $;Def
- (let [tuple-sizeI (|>. ($i;ALOAD +0) $i;ARRAYLENGTH)
- tuple-elemI (|>. ($i;ALOAD +0) ($i;ILOAD +1) $i;AALOAD)
- expected-last-sizeI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD)
- tuple-tailI (|>. ($i;ALOAD +0) tuple-sizeI ($i;int 1) $i;ISUB $i;AALOAD ($i;CHECKCAST ($t;descriptor $Tuple)))]
- (|>. ($d;method #$;Public $;staticM "pm_fail" ($t;method (list) #;None (list))
- (|>. ($i;NEW "java.lang.IllegalStateException")
- $i;DUP
- ($i;string "Invalid expression for pattern-matching.")
- ($i;INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t;method (list $String) #;None (list)) false)
- $i;ATHROW))
- ($d;method #$;Public $;staticM "apply_fail" ($t;method (list) #;None (list))
- (|>. ($i;NEW "java.lang.IllegalStateException")
- $i;DUP
- ($i;string "Error while applying function.")
- ($i;INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t;method (list $String) #;None (list)) false)
- $i;ATHROW))
- ($d;method #$;Public $;staticM "pm_push" ($t;method (list $Stack $Object) (#;Some $Stack) (list))
- (|>. ($i;int 2)
- ($i;ANEWARRAY "java.lang.Object")
- $i;DUP
- ($i;int 0)
- ($i;ALOAD +0)
- $i;AASTORE
- $i;DUP
- ($i;int 1)
- ($i;ALOAD +1)
- $i;AASTORE
- $i;ARETURN))
- ($d;method #$;Public $;staticM "pm_pop" ($t;method (list $Stack) (#;Some $Stack) (list))
- (|>. ($i;ALOAD +0)
- ($i;int 0)
- $i;AALOAD
- ($i;CHECKCAST ($t;descriptor $Stack))
- $i;ARETURN))
- ($d;method #$;Public $;staticM "pm_peek" ($t;method (list $Stack) (#;Some $Object) (list))
- (|>. ($i;ALOAD +0)
- ($i;int 1)
- $i;AALOAD
- $i;ARETURN))
- ($d;method #$;Public $;staticM "pm_variant" ($t;method (list $Variant $Tag $Flag) (#;Some $Object) (list))
- (<| $i;with-label (function [@begin])
- $i;with-label (function [@just-return])
- $i;with-label (function [@then])
- $i;with-label (function [@further])
- $i;with-label (function [@shorten])
- $i;with-label (function [@wrong])
- (let [variant-partI (: (-> Nat $;Inst)
+ $.Def
+ (let [tuple-sizeI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH)
+ tuple-elemI (|>> ($i.ALOAD +0) ($i.ILOAD +1) $i.AALOAD)
+ expected-last-sizeI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD)
+ tuple-tailI (|>> ($i.ALOAD +0) tuple-sizeI ($i.int 1) $i.ISUB $i.AALOAD ($i.CHECKCAST ($t.descriptor $Tuple)))]
+ (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list))
+ (|>> ($i.NEW "java.lang.IllegalStateException")
+ $i.DUP
+ ($i.string "Invalid expression for pattern-matching.")
+ ($i.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) false)
+ $i.ATHROW))
+ ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list))
+ (|>> ($i.NEW "java.lang.IllegalStateException")
+ $i.DUP
+ ($i.string "Error while applying function.")
+ ($i.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) false)
+ $i.ATHROW))
+ ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list))
+ (|>> ($i.int 2)
+ ($i.ANEWARRAY "java.lang.Object")
+ $i.DUP
+ ($i.int 0)
+ ($i.ALOAD +0)
+ $i.AASTORE
+ $i.DUP
+ ($i.int 1)
+ ($i.ALOAD +1)
+ $i.AASTORE
+ $i.ARETURN))
+ ($d.method #$.Public $.staticM "pm_pop" ($t.method (list $Stack) (#.Some $Stack) (list))
+ (|>> ($i.ALOAD +0)
+ ($i.int 0)
+ $i.AALOAD
+ ($i.CHECKCAST ($t.descriptor $Stack))
+ $i.ARETURN))
+ ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list))
+ (|>> ($i.ALOAD +0)
+ ($i.int 1)
+ $i.AALOAD
+ $i.ARETURN))
+ ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list))
+ (<| $i.with-label (function [@begin])
+ $i.with-label (function [@just-return])
+ $i.with-label (function [@then])
+ $i.with-label (function [@further])
+ $i.with-label (function [@shorten])
+ $i.with-label (function [@wrong])
+ (let [variant-partI (: (-> Nat $.Inst)
(function [idx]
- (|>. ($i;int (nat-to-int idx)) $i;AALOAD)))
- tagI (: $;Inst
- (|>. (variant-partI +0) ($i;unwrap #$;Int)))
+ (|>> ($i.int (nat-to-int idx)) $i.AALOAD)))
+ tagI (: $.Inst
+ (|>> (variant-partI +0) ($i.unwrap #$.Int)))
flagI (variant-partI +1)
datumI (variant-partI +2)
- shortenI (|>. ($i;ALOAD +0) tagI ## Get tag
- ($i;ILOAD +1) $i;ISUB ## Shorten tag
- ($i;ALOAD +0) flagI ## Get flag
- ($i;ALOAD +0) datumI ## Get value
+ shortenI (|>> ($i.ALOAD +0) tagI ## Get tag
+ ($i.ILOAD +1) $i.ISUB ## Shorten tag
+ ($i.ALOAD +0) flagI ## Get flag
+ ($i.ALOAD +0) datumI ## Get value
variantI ## Build sum
- $i;ARETURN)
- update-tagI (|>. $i;ISUB ($i;ISTORE +1))
- update-variantI (|>. ($i;ALOAD +0) datumI ($i;CHECKCAST ($t;descriptor $Variant)) ($i;ASTORE +0))
- failureI (|>. $i;NULL $i;ARETURN)
- return-datumI (|>. ($i;ALOAD +0) datumI $i;ARETURN)])
- (|>. ($i;label @begin)
- ($i;ILOAD +1) ## tag
- ($i;ALOAD +0) tagI ## tag, sumT
- $i;DUP2 ($i;IF_ICMPEQ @then)
- $i;DUP2 ($i;IF_ICMPGT @further)
- $i;DUP2 ($i;IF_ICMPLT @shorten)
- ## $i;POP2
+ $i.ARETURN)
+ update-tagI (|>> $i.ISUB ($i.ISTORE +1))
+ update-variantI (|>> ($i.ALOAD +0) datumI ($i.CHECKCAST ($t.descriptor $Variant)) ($i.ASTORE +0))
+ failureI (|>> $i.NULL $i.ARETURN)
+ return-datumI (|>> ($i.ALOAD +0) datumI $i.ARETURN)])
+ (|>> ($i.label @begin)
+ ($i.ILOAD +1) ## tag
+ ($i.ALOAD +0) tagI ## tag, sumT
+ $i.DUP2 ($i.IF_ICMPEQ @then)
+ $i.DUP2 ($i.IF_ICMPGT @further)
+ $i.DUP2 ($i.IF_ICMPLT @shorten)
+ ## $i.POP2
failureI
- ($i;label @then) ## tag, sumT
- ($i;ALOAD +2) ## tag, sumT, wants-last?
- ($i;ALOAD +0) flagI ## tag, sumT, wants-last?, is-last?
- ($i;IF_ACMPEQ @just-return) ## tag, sumT
- ($i;label @further) ## tag, sumT
- ($i;ALOAD +0) flagI ## tag, sumT, last?
- ($i;IFNULL @wrong) ## tag, sumT
+ ($i.label @then) ## tag, sumT
+ ($i.ALOAD +2) ## tag, sumT, wants-last?
+ ($i.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last?
+ ($i.IF_ACMPEQ @just-return) ## tag, sumT
+ ($i.label @further) ## tag, sumT
+ ($i.ALOAD +0) flagI ## tag, sumT, last?
+ ($i.IFNULL @wrong) ## tag, sumT
update-tagI
update-variantI
- ($i;GOTO @begin)
- ($i;label @just-return) ## tag, sumT
- ## $i;POP2
+ ($i.GOTO @begin)
+ ($i.label @just-return) ## tag, sumT
+ ## $i.POP2
return-datumI
- ($i;label @shorten) ## tag, sumT
- ($i;ALOAD +2) ($i;IFNULL @wrong)
- ## $i;POP2
+ ($i.label @shorten) ## tag, sumT
+ ($i.ALOAD +2) ($i.IFNULL @wrong)
+ ## $i.POP2
shortenI
- ($i;label @wrong) ## tag, sumT
- ## $i;POP2
+ ($i.label @wrong) ## tag, sumT
+ ## $i.POP2
failureI)))
- ($d;method #$;Public $;staticM "pm_left" ($t;method (list $Tuple $t;int) (#;Some $Object) (list))
- (<| $i;with-label (function [@begin])
- $i;with-label (function [@not-recursive])
- (let [updated-idxI (|>. $i;SWAP $i;ISUB)])
- (|>. ($i;label @begin)
+ ($d.method #$.Public $.staticM "pm_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
+ (<| $i.with-label (function [@begin])
+ $i.with-label (function [@not-recursive])
+ (let [updated-idxI (|>> $i.SWAP $i.ISUB)])
+ (|>> ($i.label @begin)
tuple-sizeI
expected-last-sizeI
- $i;DUP2 ($i;IF_ICMPGT @not-recursive)
+ $i.DUP2 ($i.IF_ICMPGT @not-recursive)
## Recursive
- updated-idxI ($i;ISTORE +1)
- tuple-tailI ($i;ASTORE +0)
- ($i;GOTO @begin)
- ($i;label @not-recursive)
- ## $i;POP2
+ updated-idxI ($i.ISTORE +1)
+ tuple-tailI ($i.ASTORE +0)
+ ($i.GOTO @begin)
+ ($i.label @not-recursive)
+ ## $i.POP2
tuple-elemI
- $i;ARETURN)))
- ($d;method #$;Public $;staticM "pm_right" ($t;method (list $Tuple $t;int) (#;Some $Object) (list))
- (<| $i;with-label (function [@begin])
- $i;with-label (function [@tail])
- $i;with-label (function [@slice])
- (let [updated-idxI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD tuple-sizeI $i;ISUB)
- sliceI (|>. ($i;ALOAD +0) ($i;ILOAD +1) tuple-sizeI
- ($i;INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t;method (list $Object-Array $t;int $t;int) (#;Some $Object-Array) (list)) false))])
- (|>. ($i;label @begin)
+ $i.ARETURN)))
+ ($d.method #$.Public $.staticM "pm_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
+ (<| $i.with-label (function [@begin])
+ $i.with-label (function [@tail])
+ $i.with-label (function [@slice])
+ (let [updated-idxI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD tuple-sizeI $i.ISUB)
+ sliceI (|>> ($i.ALOAD +0) ($i.ILOAD +1) tuple-sizeI
+ ($i.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) false))])
+ (|>> ($i.label @begin)
tuple-sizeI
expected-last-sizeI
- $i;DUP2 ($i;IF_ICMPEQ @tail)
- ($i;IF_ICMPGT @slice)
+ $i.DUP2 ($i.IF_ICMPEQ @tail)
+ ($i.IF_ICMPGT @slice)
## Must recurse
- tuple-tailI ($i;ASTORE +0)
- updated-idxI ($i;ISTORE +1)
- ($i;GOTO @begin)
- ($i;label @slice)
+ tuple-tailI ($i.ASTORE +0)
+ updated-idxI ($i.ISTORE +1)
+ ($i.GOTO @begin)
+ ($i.label @slice)
sliceI
- $i;ARETURN
- ($i;label @tail)
- ## $i;POP2
+ $i.ARETURN
+ ($i.label @tail)
+ ## $i.POP2
tuple-elemI
- $i;ARETURN)))
+ $i.ARETURN)))
)))
(def: io-methods
- $;Def
- (let [string-writerI (|>. ($i;NEW "java.io.StringWriter")
- $i;DUP
- ($i;INVOKESPECIAL "java.io.StringWriter" "<init>" ($t;method (list) #;None (list)) false))
- print-writerI (|>. ($i;NEW "java.io.PrintWriter")
- $i;SWAP
- $i;DUP2
- $i;POP
- $i;SWAP
- ($i;boolean true)
- ($i;INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t;method (list ($t;class "java.io.Writer" (list)) $t;boolean) #;None (list)) false)
+ $.Def
+ (let [string-writerI (|>> ($i.NEW "java.io.StringWriter")
+ $i.DUP
+ ($i.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) false))
+ print-writerI (|>> ($i.NEW "java.io.PrintWriter")
+ $i.SWAP
+ $i.DUP2
+ $i.POP
+ $i.SWAP
+ ($i.boolean true)
+ ($i.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) false)
)]
- (|>. ($d;method #$;Public $;staticM "try" ($t;method (list $Function) (#;Some $Variant) (list))
- (<| $i;with-label (function [@from])
- $i;with-label (function [@to])
- $i;with-label (function [@handler])
- (|>. ($i;try @from @to @handler "java.lang.Throwable")
- ($i;label @from)
- ($i;ALOAD +0)
- $i;NULL
- ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature +1) false)
+ (|>> ($d.method #$.Public $.staticM "try" ($t.method (list $Function) (#.Some $Variant) (list))
+ (<| $i.with-label (function [@from])
+ $i.with-label (function [@to])
+ $i.with-label (function [@handler])
+ (|>> ($i.try @from @to @handler "java.lang.Throwable")
+ ($i.label @from)
+ ($i.ALOAD +0)
+ $i.NULL
+ ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) false)
rightI
- $i;ARETURN
- ($i;label @to)
- ($i;label @handler)
+ $i.ARETURN
+ ($i.label @to)
+ ($i.label @handler)
string-writerI ## TW
- $i;DUP2 ## TWTW
+ $i.DUP2 ## TWTW
print-writerI ## TWTP
- ($i;INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t;method (list ($t;class "java.io.PrintWriter" (list))) #;None (list)) false) ## TW
- ($i;INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t;method (list) (#;Some $String) (list)) false) ## TS
- $i;SWAP $i;POP leftI
- $i;ARETURN)))
+ ($i.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) false) ## TW
+ ($i.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) false) ## TS
+ $i.SWAP $i.POP leftI
+ $i.ARETURN)))
)))
(def: translate-runtime
- (Meta commonT;Bytecode)
- (do macro;Monad<Meta>
+ (Meta commonT.Bytecode)
+ (do macro.Monad<Meta>
[_ (wrap [])
- #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC hostL;runtime-class (list) ["java.lang.Object" (list)] (list)
- (|>. adt-methods
+ #let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list)
+ (|>> adt-methods
nat-methods
frac-methods
deg-methods
text-methods
pm-methods
io-methods))]
- _ (commonT;store-class hostL;runtime-class bytecode)]
+ _ (commonT.store-class hostL.runtime-class bytecode)]
(wrap bytecode)))
(def: translate-function
- (Meta commonT;Bytecode)
- (do macro;Monad<Meta>
+ (Meta commonT.Bytecode)
+ (do macro.Monad<Meta>
[_ (wrap [])
- #let [applyI (|> (list;n.range +2 num-apply-variants)
+ #let [applyI (|> (list.n/range +2 num-apply-variants)
(list/map (function [arity]
- ($d;method #$;Public $;noneM apply-method (apply-signature arity)
- (let [preI (|> (list;n.range +0 (n.dec arity))
- (list/map $i;ALOAD)
- $i;fuse)]
- (|>. preI
- ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature (n.dec arity)) false)
- ($i;CHECKCAST hostL;function-class)
- ($i;ALOAD arity)
- ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature +1) false)
- $i;ARETURN)))))
- (list& ($d;abstract-method #$;Public $;noneM apply-method (apply-signature +1)))
- $d;fuse)
- bytecode ($d;abstract #$;V1.6 #$;Public $;noneC hostL;function-class (list) ["java.lang.Object" (list)] (list)
- (|>. ($d;field #$;Public $;finalF partials-field $t;int)
- ($d;method #$;Public $;noneM "<init>" ($t;method (list $t;int) #;None (list))
- (|>. ($i;ALOAD +0)
- ($i;INVOKESPECIAL "java.lang.Object" "<init>" ($t;method (list) #;None (list)) false)
- ($i;ALOAD +0)
- ($i;ILOAD +1)
- ($i;PUTFIELD hostL;function-class partials-field $t;int)
- $i;RETURN))
+ ($d.method #$.Public $.noneM apply-method (apply-signature arity)
+ (let [preI (|> (list.n/range +0 (n/dec arity))
+ (list/map $i.ALOAD)
+ $i.fuse)]
+ (|>> preI
+ ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (n/dec arity)) false)
+ ($i.CHECKCAST hostL.function-class)
+ ($i.ALOAD arity)
+ ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) false)
+ $i.ARETURN)))))
+ (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1)))
+ $d.fuse)
+ bytecode ($d.abstract #$.V1_6 #$.Public $.noneC hostL.function-class (list) ["java.lang.Object" (list)] (list)
+ (|>> ($d.field #$.Public $.finalF partials-field $t.int)
+ ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list))
+ (|>> ($i.ALOAD +0)
+ ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) false)
+ ($i.ALOAD +0)
+ ($i.ILOAD +1)
+ ($i.PUTFIELD hostL.function-class partials-field $t.int)
+ $i.RETURN))
applyI))]
- _ (commonT;store-class hostL;function-class bytecode)]
+ _ (commonT.store-class hostL.function-class bytecode)]
(wrap bytecode)))
(def: #export translate
- (Meta [commonT;Bytecode commonT;Bytecode])
- (do macro;Monad<Meta>
+ (Meta [commonT.Bytecode commonT.Bytecode])
+ (do macro.Monad<Meta>
[runtime-bc translate-runtime
function-bc translate-function]
(wrap [runtime-bc function-bc])))
diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
index df7e26741..a734adfed 100644
--- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control monad
["ex" exception #+ exception:])
@@ -10,84 +10,81 @@
[macro]
[host])
(luxc ["&" lang]
- ["&;" io]
+ ["&." io]
(lang (host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
- ["&;" scope]
- ["&;" module]
- (translation [";T" eval]
- [";T" common]))))
+ ["&." scope]
+ ["&." module]
+ (translation [".T" eval]
+ [".T" common]))))
(exception: #export Invalid-Definition-Value)
(exception: #export Cannot-Evaluate-Definition)
-(host;import java.lang.Object
- (toString [] String))
-
-(host;import java.lang.reflect.Field
+(host.import java/lang/reflect/Field
(get [#? Object] #try #? Object))
-(host;import (java.lang.Class c)
+(host.import (java/lang/Class c)
(getField [String] #try Field))
(def: #export (translate-def def-name valueT valueI metaI metaV)
- (-> Text Type $;Inst $;Inst Code (Meta Unit))
- (do macro;Monad<Meta>
- [current-module macro;current-module-name
+ (-> Text Type $.Inst $.Inst Code (Meta Unit))
+ (do macro.Monad<Meta>
+ [current-module macro.current-module-name
#let [def-ident [current-module def-name]]]
- (case (macro;get-symbol-ann (ident-for #;alias) metaV)
- (#;Some real-def)
+ (case (macro.get-symbol-ann (ident-for #.alias) metaV)
+ (#.Some real-def)
(do @
- [[realT realA realV] (macro;find-def real-def)
- _ (&module;define def-ident [realT metaV realV])]
+ [[realT realA realV] (macro.find-def real-def)
+ _ (&module.define def-ident [realT metaV realV])]
(wrap []))
_
(do @
- [#let [normal-name (format (&;normalize-name def-name) (%n (text/hash def-name)))
+ [#let [normal-name (format (&.normalize-name def-name) (%n (text/hash def-name)))
bytecode-name (format current-module "/" normal-name)
- class-name (format (text;replace-all "/" "." current-module) "." normal-name)
- bytecode ($d;class #$;V1.6
- #$;Public $;finalC
+ class-name (format (text.replace-all "/" "." current-module) "." normal-name)
+ bytecode ($d.class #$.V1_6
+ #$.Public $.finalC
bytecode-name
(list) ["java.lang.Object" (list)]
(list)
- (|>. ($d;field #$;Public ($;++F $;finalF $;staticF) commonT;value-field commonT;$Object)
- ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list))
- (|>. valueI
- ($i;PUTSTATIC bytecode-name commonT;value-field commonT;$Object)
- $i;RETURN))))]
- _ (commonT;store-class class-name bytecode)
- class (commonT;load-class class-name)
+ (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) commonT.value-field commonT.$Object)
+ ($d.method #$.Public $.staticM "<clinit>" ($t.method (list) #.None (list))
+ (|>> valueI
+ ($i.PUTSTATIC bytecode-name commonT.value-field commonT.$Object)
+ $i.RETURN))))]
+ _ (commonT.store-class class-name bytecode)
+ class (commonT.load-class class-name)
valueV (: (Meta Top)
- (case (do e;Monad<Error>
- [field (Class.getField [commonT;value-field] class)]
- (Field.get [#;None] field))
- (#e;Success #;None)
- (&;throw Invalid-Definition-Value (%ident def-ident))
+ (case (do e.Monad<Error>
+ [field (Class::getField [commonT.value-field] class)]
+ (Field::get [#.None] field))
+ (#e.Success #.None)
+ (&.throw Invalid-Definition-Value (%ident def-ident))
- (#e;Success (#;Some valueV))
+ (#e.Success (#.Some valueV))
(wrap valueV)
- (#e;Error error)
- (&;throw Cannot-Evaluate-Definition
+ (#e.Error error)
+ (&.throw Cannot-Evaluate-Definition
(format "Definition: " (%ident def-ident) "\n"
"Error:\n"
error))))
- _ (&module;define def-ident [valueT metaV valueV])
- _ (if (macro;type? metaV)
- (case (macro;declared-tags metaV)
- #;Nil
+ _ (&module.define def-ident [valueT metaV valueV])
+ _ (if (macro.type? metaV)
+ (case (macro.declared-tags metaV)
+ #.Nil
(wrap [])
tags
- (&module;declare-tags tags (macro;export? metaV) (:! Type valueV)))
+ (&module.declare-tags tags (macro.export? metaV) (:! Type valueV)))
(wrap []))
#let [_ (log! (format "DEF " (%ident def-ident)))]]
- (commonT;record-artifact (format bytecode-name ".class") bytecode)))))
+ (commonT.record-artifact (format bytecode-name ".class") bytecode)))))
(def: #export (translate-program program-args programI)
- (-> Text $;Inst (Meta Unit))
- (&;fail "\"lux program\" is unimplemented."))
+ (-> Text $.Inst (Meta Unit))
+ (&.fail "\"lux program\" is unimplemented."))
diff --git a/new-luxc/source/luxc/lang/translation/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
index ddb48a31e..9a78be78e 100644
--- a/new-luxc/source/luxc/lang/translation/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
@@ -7,55 +7,55 @@
[macro]
[host #+ do-to])
(luxc ["&" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))
["la" analysis]
["ls" synthesis]
- (translation [";T" common]))))
+ (translation [".T" common]))))
(exception: #export Not-A-Tuple)
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
(def: #export (translate-tuple translate members)
- (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis) (Meta $;Inst))
- (do macro;Monad<Meta>
- [#let [size (list;size members)]
- _ (&;assert Not-A-Tuple (%code (` [(~@ members)]))
- (n.>= +2 size))
+ (-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis) (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [#let [size (list.size members)]
+ _ (&.assert Not-A-Tuple (%code (` [(~@ members)]))
+ (n/>= +2 size))
membersI (|> members
- list;enumerate
- (monad;map @ (function [[idx member]]
+ list.enumerate
+ (monad.map @ (function [[idx member]]
(do @
[memberI (translate member)]
- (wrap (|>. $i;DUP
- ($i;int (nat-to-int idx))
+ (wrap (|>> $i.DUP
+ ($i.int (nat-to-int idx))
memberI
- $i;AASTORE)))))
- (:: @ map $i;fuse))]
- (wrap (|>. ($i;int (nat-to-int size))
- ($i;array $Object)
+ $i.AASTORE)))))
+ (:: @ map $i.fuse))]
+ (wrap (|>> ($i.int (nat-to-int size))
+ ($i.array $Object)
membersI))))
(def: (flagI tail?)
- (-> Bool $;Inst)
+ (-> Bool $.Inst)
(if tail?
- ($i;string "")
- $i;NULL))
+ ($i.string "")
+ $i.NULL))
(def: #export (translate-variant translate tag tail? member)
- (-> (-> ls;Synthesis (Meta $;Inst)) Nat Bool ls;Synthesis (Meta $;Inst))
- (do macro;Monad<Meta>
+ (-> (-> ls.Synthesis (Meta $.Inst)) Nat Bool ls.Synthesis (Meta $.Inst))
+ (do macro.Monad<Meta>
[memberI (translate member)]
- (wrap (|>. ($i;int (nat-to-int tag))
+ (wrap (|>> ($i.int (nat-to-int tag))
(flagI tail?)
memberI
- ($i;INVOKESTATIC hostL;runtime-class
+ ($i.INVOKESTATIC hostL.runtime-class
"variant_make"
- ($t;method (list $t;int $Object $Object)
- (#;Some ($t;array +1 $Object))
+ ($t.method (list $t.int $Object $Object)
+ (#.Some ($t.array +1 $Object))
(list))
false)))))
diff --git a/new-luxc/source/luxc/lang/variable.lux b/new-luxc/source/luxc/lang/variable.lux
index f766ffdcf..55f6ac877 100644
--- a/new-luxc/source/luxc/lang/variable.lux
+++ b/new-luxc/source/luxc/lang/variable.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (data (coll [list "list/" Functor<List>]))))
@@ -7,7 +7,7 @@
(def: #export (captured register)
(-> Register Variable)
- (|> register n.inc nat-to-int (i.* -1)))
+ (|> register n/inc nat-to-int (i/* -1)))
(def: #export (local register)
(-> Register Variable)
@@ -19,29 +19,29 @@
(def: #export (captured-register variable)
(-> Variable Register)
- (|> variable (i.* -1) int-to-nat n.dec))
+ (|> variable (i/* -1) int-to-nat n/dec))
(do-template [<name> <comp>]
[(def: #export (<name> var)
(-> Variable Bool)
(<comp> 0 var))]
- [self? i.=]
- [local? i.>]
- [captured? i.<]
+ [self? i/=]
+ [local? i/>]
+ [captured? i/<]
)
(def: #export (from-ref ref)
(-> Ref Variable)
(case ref
- (#;Local register)
+ (#.Local register)
(local register)
- (#;Captured register)
+ (#.Captured register)
(captured register)))
(def: #export (environment scope)
(-> Scope (List Variable))
(|> scope
- (get@ [#;captured #;mappings])
+ (get@ [#.captured #.mappings])
(list/map (function [[_ [_ ref]]] (from-ref ref)))))