aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/analysis/case.lux2
-rw-r--r--new-luxc/source/luxc/lang/analysis/expression.lux32
-rw-r--r--new-luxc/source/luxc/lang/synthesis/case.lux17
-rw-r--r--new-luxc/source/luxc/lang/synthesis/expression.lux58
-rw-r--r--new-luxc/source/luxc/lang/translation.lux60
-rw-r--r--new-luxc/source/luxc/lang/translation/case.jvm.lux32
-rw-r--r--new-luxc/source/luxc/lang/translation/expression.jvm.lux38
-rw-r--r--new-luxc/source/luxc/lang/translation/function.jvm.lux14
-rw-r--r--new-luxc/source/luxc/lang/translation/primitive.jvm.lux14
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux6
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux66
-rw-r--r--new-luxc/source/luxc/lang/translation/reference.jvm.lux6
-rw-r--r--new-luxc/source/luxc/lang/translation/runtime.jvm.lux16
-rw-r--r--new-luxc/source/luxc/lang/translation/statement.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/structure.jvm.lux10
16 files changed, 184 insertions, 195 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index 1e40e38f1..f68733d7f 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -165,7 +165,7 @@
(do @
[nextA next]
(wrap [(list) nextA]))
- matches)]
+ (list;reverse matches))]
(wrap [(` ("lux case tuple" [(~@ memberP+)]))
thenA])))
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index de0e49dbc..12256a4bf 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -11,6 +11,7 @@
[host])
(luxc ["&" base]
[";L" host]
+ (host [";H" macro])
(lang ["la" analysis]
(translation [";T" common]))
["&;" module])
@@ -21,35 +22,6 @@
[";A" structure]
[";A" procedure]))
-(for {"JVM" (as-is (host;import java.lang.reflect.Method
- (invoke [Object (Array Object)] #try Object))
- (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))
- (def: _apply-args
- (Array (Class Object))
- (|> (host;array (Class Object) +2)
- (host;array-write +0 _object-class)
- (host;array-write +1 _object-class)))
- (def: (call-macro macro inputs)
- (-> Macro (List Code) (Meta (List Code)))
- (do meta;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)])
- output))))))
- })
-
(exception: #export Macro-Expression-Must-Have-Single-Expansion)
(exception: #export Unrecognized-Syntax)
@@ -119,7 +91,7 @@
(if (meta;macro? def-anns)
(do @
[expansion (function [compiler]
- (case (call-macro (:! Macro def-value) args compiler)
+ (case (macroH;expand (:! Macro def-value) args compiler)
(#e;Success [compiler' output])
(#e;Success [compiler' output])
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index 15cb6eca3..e66bbf3a8 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -2,6 +2,7 @@
lux
(lux (data [bool "bool/" Eq<Bool>]
[text "text/" Eq<Text>]
+ text/format
[number]
(coll [list "list/" Fold<List>]))
(meta [code "code/" Eq<Code>]))
@@ -11,7 +12,7 @@
(def: #export (path pattern)
(-> la;Pattern ls;Path)
(case pattern
- (^code [(~@ membersP)])
+ (^code ("lux case tuple" [(~@ membersP)]))
(case (list;reverse membersP)
#;Nil
(' ("lux case pop"))
@@ -30,12 +31,16 @@
[(n.dec last-idx)
(` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
prevsP)]
- tuple-path))
+ (` ("lux case seq"
+ (~ tuple-path)
+ ("lux case pop")))))
- (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
- (if (n.= (n.dec num-tags) tag)
- (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP))))
- (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))
+ (^code ("lux case variant" (~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
+ (` ("lux case seq"
+ (~ (if (n.= (n.dec num-tags) tag)
+ (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP))))
+ (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP))))))
+ ("lux case pop")))
_
pattern))
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index 05b99923b..531606ba7 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -85,11 +85,11 @@
(|> (synthesize expr)
(~) ("lux case exec")
("lux case seq" (~ (caseS;path pattern)))
- (`))))]
- (` ("lux case" (~ inputS)
- (~ (list/fold caseS;weave
- (transform-branch lastP lastA)
- (list/map (product;uncurry transform-branch) prevsPA))))))
+ (`))))
+ pathS (list/fold caseS;weave
+ (transform-branch lastP lastA)
+ (list/map (product;uncurry transform-branch) prevsPA))]
+ (` ("lux case" (~ inputS) (~ pathS))))
_
(undefined)
@@ -117,46 +117,42 @@
_
(call$ funcS argsS))))
-(def: #export (synthesize analysis)
+(def: #export (synthesize expressionA)
(-> la;Analysis ls;Synthesis)
(loop [outer-arity +0
resolver init-resolver
num-locals +0
- exprA analysis]
- (case exprA
+ expressionA expressionA]
+ (case expressionA
(^code [(~ _left) (~ _right)])
- (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
+ (` [(~@ (list/map (recur outer-arity resolver num-locals) (la;unfold-tuple expressionA)))])
(^or (^code ("lux sum left" (~ _)))
(^code ("lux sum right" (~ _))))
- (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))]
- (variant$ tag last? (recur +0 resolver num-locals value)))
+ (let [[tag last? value] (maybe;assume (la;unfold-variant expressionA))]
+ (variant$ tag last? (recur outer-arity resolver num-locals value)))
(^code ((~ [_ (#;Int var)])))
(if (variableL;local? var)
- (let [register (variableL;local-register var)]
- (if (functionS;nested? outer-arity)
- (if (n.= +0 register)
- (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
- (list/map (|>. variableL;local code;int (~) () (`)))))
- (var$ (functionS;adjust-var outer-arity (variableL;local register))))
- (var$ (variableL;local register))))
- (let [register (variableL;captured-register var)]
- (var$ (let [var (variableL;captured register)]
- (maybe;default var (dict;get var resolver))))))
+ (if (functionS;nested? outer-arity)
+ (if (variableL;self? var)
+ (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
+ (list/map (|>. variableL;local code;int (~) () (`)))))
+ (var$ (functionS;adjust-var outer-arity var)))
+ (var$ var))
+ (var$ (maybe;default var (dict;get var resolver))))
(^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
- (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
+ (synthesize-case (recur outer-arity resolver num-locals) inputA branchesA)
(^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
[(s;run scope (p;some s;int)) (#e;Success raw-env)])
(let [inner-arity (n.inc outer-arity)
env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
- env-vars (let [env-size (list;size raw-env)]
- (: (List Variable)
- (case env-size
- +0 (list)
- _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
+ 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 (functionS;nested? inner-arity)
(list/fold (function [[from to] resolver']
(dict;put from to resolver'))
@@ -166,7 +162,7 @@
(dict;put var var resolver'))
init-resolver
env-vars))]
- (case (recur inner-arity resolver' +0 bodyA)
+ (case (recur inner-arity resolver' num-locals bodyA)
(^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
(let [arity (n.inc arity')]
(function$ arity env (prepare-body inner-arity arity bodyS')))
@@ -175,10 +171,10 @@
(function$ +1 env (prepare-body inner-arity +1 bodyS))))
(^code ("lux apply" (~@ _)))
- (synthesize-apply synthesize outer-arity num-locals exprA)
+ (synthesize-apply (recur outer-arity resolver num-locals) outer-arity num-locals expressionA)
(^code ((~ [_ (#;Text name)]) (~@ args)))
- (procedure$ name (list/map (recur +0 resolver num-locals) args))
+ (procedure$ name (list/map (recur outer-arity resolver num-locals) args))
_
- exprA)))
+ expressionA)))
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 4fcc3ccb2..60fbde6c8 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -1,6 +1,7 @@
(;module:
lux
- (lux (control [monad #+ do])
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:])
(concurrency ["T" task])
(data ["e" error]
[text "text/" Hash<Text>]
@@ -12,6 +13,7 @@
(world [file #+ File]))
(luxc ["&" base]
[";L" host]
+ (host [";H" macro])
["&;" io]
["&;" module]
["&;" eval]
@@ -30,18 +32,17 @@
(&;Analyser)
(expressionA;analyser &eval;eval))
-(def: (generate code)
+(exception: #export Unrecognized-Statement)
+
+(def: (translate code)
(-> Code (Meta Unit))
(case code
- (^ [_ (#;Form (list [_ (#;Text "lux def")]
- [_ (#;Symbol ["" def-name])]
- valueC
- metaC))])
+ (^code ("lux def" (~ [_ (#;Symbol ["" def-name])]) (~ valueC) (~ metaC)))
(do meta;Monad<Meta>
[[_ metaA] (&;with-scope
(&;with-expected-type Code
(analyse metaC)))
- metaI (expressionT;generate (expressionS;synthesize metaA))
+ metaI (expressionT;translate (expressionS;synthesize metaA))
metaV (evalT;eval metaI)
[_ valueT valueA] (&;with-scope
(if (meta;type? (:! Code metaV))
@@ -51,23 +52,38 @@
(wrap [Type valueA])))
(commonA;with-unknown-type
(analyse valueC))))
- valueI (expressionT;generate (expressionS;synthesize valueA))
+ valueI (expressionT;translate (expressionS;synthesize valueA))
_ (&;with-scope
- (statementT;generate-def def-name valueT valueI metaI (:! Code metaV)))]
+ (statementT;translate-def def-name valueT valueI metaI (:! Code metaV)))]
(wrap []))
- (^ [_ (#;Form (list [_ (#;Text "lux program")]
- [_ (#;Symbol ["" program-args])]
- programC))])
+ (^code ("lux program" (~ [_ (#;Symbol ["" program-args])]) (~ programC)))
(do meta;Monad<Meta>
[[_ programA] (&;with-scope
(&;with-expected-type (type (io;IO Unit))
(analyse programC)))
- programI (expressionT;generate (expressionS;synthesize programA))]
- (statementT;generate-program program-args programI))
+ programI (expressionT;translate (expressionS;synthesize programA))]
+ (statementT;translate-program program-args programI))
+
+ (^code ((~ [_ (#;Symbol macro-name)]) (~@ args)))
+ (do meta;Monad<Meta>
+ [macro-name (meta;normalize macro-name)
+ [def-type def-anns def-value] (meta;find-def macro-name)]
+ (if (meta;macro? def-anns)
+ (do @
+ [expansion (function [compiler]
+ (case (macroH;expand (:! Macro def-value) args compiler)
+ (#e;Success [compiler' output])
+ (#e;Success [compiler' output])
+
+ (#e;Error error)
+ ((&;fail error) compiler)))
+ _ (monad;map @ translate expansion)]
+ (wrap []))
+ (&;throw Unrecognized-Statement (%code code))))
_
- (&;fail (format "Unrecognized statement: " (%code code)))))
+ (&;throw Unrecognized-Statement (%code code))))
(def: (exhaust action)
(All [a] (-> (Meta a) (Meta Unit)))
@@ -97,7 +113,7 @@
(#e;Success [(set@ #;source source' compiler)
output]))))
-(def: (generate-module source-dirs module-name target-dir compiler)
+(def: (translate-module source-dirs module-name target-dir compiler)
(-> (List File) Text File Compiler (T;Task Compiler))
(do T;Monad<Task>
[_ (&io;prepare-module target-dir module-name)
@@ -115,9 +131,9 @@
[code parse
#let [[cursor _] code]]
(&;with-cursor cursor
- (generate code)))))))]
+ (translate code)))))))]
(wrap artifacts)
- ## (&module;generate-descriptor module-name)
+ ## (&module;translate-descriptor module-name)
))
(#e;Success [compiler artifacts ## module-descriptor
])
@@ -159,10 +175,10 @@
#;scope-type-vars (list)
#;host (:! Void host)})
-(def: #export (generate-program program target sources)
+(def: #export (translate-program program target sources)
(-> Text File (List File) (T;Task Unit))
(do T;Monad<Task>
- [compiler (|> (case (runtimeT;generate (init-compiler (io;run hostL;init-host)))
+ [compiler (|> (case (runtimeT;translate (init-compiler (io;run hostL;init-host)))
(#e;Error error)
(T;fail error)
@@ -173,7 +189,7 @@
_ (&io;write-file target hostL;function-class function-bc)]
(wrap compiler)))
(: (T;Task Compiler))
- (:: @ map (generate-module sources prelude target)) (:: @ join)
- (:: @ map (generate-module sources program target)) (:: @ join))
+ (:: @ map (translate-module sources prelude target)) (:: @ join)
+ (:: @ map (translate-module sources program target)) (:: @ 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 a9ea4482a..3858627ff 100644
--- a/new-luxc/source/luxc/lang/translation/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/case.jvm.lux
@@ -54,13 +54,13 @@
(exception: #export Unrecognized-Path)
-(def: (generate-path' generate stack-depth @else @end path)
+(def: (translate-path' translate stack-depth @else @end path)
(-> (-> ls;Synthesis (Meta $;Inst))
Nat $;Label $;Label ls;Path (Meta $;Inst))
(case path
(^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
(do meta;Monad<Meta>
- [bodyI (generate bodyS)]
+ [bodyI (translate bodyS)]
(wrap (|>. (pop-altI stack-depth)
bodyI
($i;GOTO @end))))
@@ -111,7 +111,7 @@
(^template [<special> <method>]
(^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
(do meta;Monad<Meta>
- [subI (generate-path' generate stack-depth @else @end subP)]
+ [subI (translate-path' translate stack-depth @else @end subP)]
(wrap (case idx
+0
(|>. peekI
@@ -139,7 +139,7 @@
(^template [<special> <flag>]
(^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
(do meta;Monad<Meta>
- [subI (generate-path' generate stack-depth @else @end subP)]
+ [subI (translate-path' translate stack-depth @else @end subP)]
(wrap (<| $i;with-label (function [@success])
$i;with-label (function [@fail])
(|>. peekI
@@ -165,16 +165,16 @@
(^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftP rightP))])
(do meta;Monad<Meta>
- [leftI (generate-path' generate stack-depth @else @end leftP)
- rightI (generate-path' generate stack-depth @else @end rightP)]
+ [leftI (translate-path' translate stack-depth @else @end leftP)
+ rightI (translate-path' translate stack-depth @else @end rightP)]
(wrap (|>. leftI
rightI)))
(^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftP rightP))])
(do meta;Monad<Meta>
[@alt-else $i;make-label
- leftI (generate-path' generate (n.inc stack-depth) @alt-else @end leftP)
- rightI (generate-path' generate stack-depth @else @end rightP)]
+ leftI (translate-path' translate (n.inc stack-depth) @alt-else @end leftP)
+ rightI (translate-path' translate stack-depth @else @end rightP)]
(wrap (|>. $i;DUP
leftI
($i;label @alt-else)
@@ -184,12 +184,12 @@
_
(_;throw Unrecognized-Path (%code path))))
-(def: (generate-path generate path @end)
+(def: (translate-path translate path @end)
(-> (-> ls;Synthesis (Meta $;Inst))
ls;Path $;Label (Meta $;Inst))
(do meta;Monad<Meta>
[@else $i;make-label
- pathI (generate-path' generate +1 @else @end path)]
+ pathI (translate-path' translate +1 @else @end path)]
(wrap (|>. pathI
($i;label @else)
$i;POP
@@ -200,13 +200,13 @@
$i;NULL
($i;GOTO @end)))))
-(def: #export (generate-case generate valueS path)
+(def: #export (translate-case translate valueS path)
(-> (-> ls;Synthesis (Meta $;Inst))
ls;Synthesis ls;Path (Meta $;Inst))
(do meta;Monad<Meta>
[@end $i;make-label
- valueI (generate valueS)
- pathI (generate-path generate path @end)]
+ valueI (translate valueS)
+ pathI (translate-path translate path @end)]
(wrap (|>. valueI
$i;NULL
$i;SWAP
@@ -214,12 +214,12 @@
pathI
($i;label @end)))))
-(def: #export (generate-let generate register inputS exprS)
+(def: #export (translate-let translate register inputS exprS)
(-> (-> ls;Synthesis (Meta $;Inst))
Nat ls;Synthesis ls;Synthesis (Meta $;Inst))
(do meta;Monad<Meta>
- [inputI (generate inputS)
- exprI (generate exprS)]
+ [inputI (translate inputS)
+ exprI (translate exprS)]
(wrap (|>. inputI
($i;ASTORE register)
exprI))))
diff --git a/new-luxc/source/luxc/lang/translation/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
index af66d4994..81cdc1261 100644
--- a/new-luxc/source/luxc/lang/translation/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
@@ -22,54 +22,54 @@
(exception: #export Unrecognized-Synthesis)
-(def: #export (generate synthesis)
+(def: #export (translate synthesis)
(-> ls;Synthesis (Meta $;Inst))
(case synthesis
(^code [])
- primitiveT;generate-unit
+ primitiveT;translate-unit
(^code [(~ singleton)])
- (generate singleton)
+ (translate singleton)
(^template [<tag> <generator>]
[_ (<tag> value)]
(<generator> value))
- ([#;Bool primitiveT;generate-bool]
- [#;Nat primitiveT;generate-nat]
- [#;Int primitiveT;generate-int]
- [#;Deg primitiveT;generate-deg]
- [#;Frac primitiveT;generate-frac]
- [#;Text primitiveT;generate-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;generate-variant generate tag last? valueS)
+ (structureT;translate-variant translate tag last? valueS)
(^code [(~@ members)])
- (structureT;generate-tuple generate members)
+ (structureT;translate-tuple translate members)
(^ [_ (#;Form (list [_ (#;Int var)]))])
(if (variableL;captured? var)
- (referenceT;generate-captured var)
- (referenceT;generate-variable var))
+ (referenceT;translate-captured var)
+ (referenceT;translate-variable var))
[_ (#;Symbol definition)]
- (referenceT;generate-definition definition)
+ (referenceT;translate-definition definition)
(^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ exprS)))
- (caseT;generate-let generate register inputS exprS)
+ (caseT;translate-let translate register inputS exprS)
(^code ("lux case" (~ inputS) (~ pathPS)))
- (caseT;generate-case generate 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;generate-function generate environment arity bodyS)
+ (functionT;translate-function translate environment arity bodyS)
(^code ("lux call" (~ functionS) (~@ argsS)))
- (functionT;generate-call generate functionS argsS)
+ (functionT;translate-call translate functionS argsS)
(^code ((~ [_ (#;Text procedure)]) (~@ argsS)))
- (procedureT;generate-procedure generate procedure argsS)
+ (procedureT;translate-procedure translate procedure argsS)
_
(&;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 35c88e4ed..ebdb28853 100644
--- a/new-luxc/source/luxc/lang/translation/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux
@@ -266,13 +266,13 @@
$i;ARETURN
))))
-(def: #export (with-function generate class env arity body)
+(def: #export (with-function translate class env arity body)
(-> (-> ls;Synthesis (Meta $;Inst))
Text (List Variable) ls;Arity ls;Synthesis
(Meta [$;Def $;Inst]))
(do meta;Monad<Meta>
[@begin $i;make-label
- bodyI (commonT;with-function class (generate body))
+ bodyI (commonT;with-function class (translate body))
#let [env-size (list;size env)
applyD (: $;Def
(if (poly-arg? arity)
@@ -295,13 +295,13 @@
instanceI (instance class arity env)]]
(wrap [functionD instanceI])))
-(def: #export (generate-function generate env arity body)
+(def: #export (translate-function translate env arity body)
(-> (-> ls;Synthesis (Meta $;Inst))
(List Variable) ls;Arity ls;Synthesis
(Meta $;Inst))
(do meta;Monad<Meta>
[function-class (:: @ map %code (meta;gensym "function"))
- [functionD instanceI] (with-function generate function-class env arity body)
+ [functionD instanceI] (with-function translate function-class env arity body)
_ (commonT;store-class function-class
($d;class #$;V1.6 #$;Public $;finalC
function-class (list)
@@ -316,13 +316,13 @@
(list pre)
(list& pre (segment size post)))))
-(def: #export (generate-call generate functionS argsS)
+(def: #export (translate-call translate functionS argsS)
(-> (-> ls;Synthesis (Meta $;Inst))
ls;Synthesis (List ls;Synthesis)
(Meta $;Inst))
(do meta;Monad<Meta>
- [functionI (generate functionS)
- argsI (monad;map @ generate argsS)
+ [functionI (translate functionS)
+ argsI (monad;map @ translate argsS)
#let [applyI (|> (segment runtimeT;num-apply-variants argsI)
(list/map (function [chunkI+]
(|>. ($i;CHECKCAST hostL;function-class)
diff --git a/new-luxc/source/luxc/lang/translation/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
index 72b5f4e9d..f795a2980 100644
--- a/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
@@ -13,11 +13,11 @@
(translation [";T" common])))
[../runtime])
-(def: #export generate-unit
+(def: #export translate-unit
(Meta $;Inst)
(meta/wrap ($i;string hostL;unit)))
-(def: #export (generate-bool value)
+(def: #export (translate-bool value)
(-> Bool (Meta $;Inst))
(meta/wrap ($i;GETSTATIC "java.lang.Boolean"
(if value "TRUE" "FALSE")
@@ -28,9 +28,9 @@
(-> <type> (Meta $;Inst))
(meta/wrap (|>. (<load> value) <wrap>)))]
- [generate-nat Nat (|>. (:! Int) $i;long) ($i;wrap #$;Long)]
- [generate-int Int $i;long ($i;wrap #$;Long)]
- [generate-deg Deg (|>. (:! Int) $i;long) ($i;wrap #$;Long)]
- [generate-frac Frac $i;double ($i;wrap #$;Double)]
- [generate-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 973f0e968..d74b559cf 100644
--- a/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
@@ -15,10 +15,10 @@
(|> ./common;procedures
(dict;merge ./host;procedures)))
-(def: #export (generate-procedure generate name args)
+(def: #export (translate-procedure translate name args)
(-> (-> ls;Synthesis (Meta $;Inst)) Text (List ls;Synthesis)
(Meta $;Inst))
(<| (maybe;default (&;fail (format "Unknown procedure: " (%t name))))
(do maybe;Monad<Maybe>
[proc (dict;get name procedures)]
- (wrap (proc generate args)))))
+ (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 80becb058..8c7668383 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -74,20 +74,20 @@
" Actual: " (|> actual nat-to-int %i)))
(syntax: (arity: [name s;local-symbol] [arity s;nat])
- (with-gensyms [g!proc g!name g!generate g!inputs]
+ (with-gensyms [g!proc g!name g!translate g!inputs]
(do @
[g!input+ (monad;seq @ (list;repeat arity (meta;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!generate) (~ g!inputs)]
+ (function [(~ g!translate) (~ g!inputs)]
(case (~ g!inputs)
(^ (list (~@ g!input+)))
(do meta;Monad<Meta>
[(~@ (|> g!input+
(list/map (function [g!input]
- (list g!input (` ((~ g!generate) (~ g!input))))))
+ (list g!input (` ((~ g!translate) (~ g!input))))))
list;concat))]
((~' wrap) ((~ g!proc) [(~@ g!input+)])))
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 c222e42cf..7168514c1 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
@@ -273,12 +273,12 @@
$i;I2L
($i;wrap #$;Long)))
-(def: (array//new proc generate inputs)
+(def: (array//new proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Nat level)] [_ (#;Text class)] lengthS))
(do meta;Monad<Meta>
- [lengthI (generate lengthS)
+ [lengthI (translate lengthS)
#let [arrayJT ($t;array level (case class
"boolean" $t;boolean
"byte" $t;byte
@@ -297,13 +297,13 @@
_
(&;fail (format "Wrong syntax for '" proc "'."))))
-(def: (array//read proc generate inputs)
+(def: (array//read proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)] idxS arrayS))
(do meta;Monad<Meta>
- [arrayI (generate arrayS)
- idxI (generate idxS)
+ [arrayI (translate arrayS)
+ idxI (translate idxS)
#let [loadI (case class
"boolean" (|>. $i;BALOAD ($i;wrap #$;Boolean))
"byte" (|>. $i;BALOAD ($i;wrap #$;Byte))
@@ -323,14 +323,14 @@
_
(&;fail (format "Wrong syntax for '" proc "'."))))
-(def: (array//write proc generate inputs)
+(def: (array//write proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)] idxS valueS arrayS))
(do meta;Monad<Meta>
- [arrayI (generate arrayS)
- idxI (generate idxS)
- valueI (generate valueS)
+ [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)
@@ -392,7 +392,7 @@
(|>. exceptionI
$i;ATHROW))
-(def: (object//class proc generate inputs)
+(def: (object//class proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)]))
@@ -408,12 +408,12 @@
_
(&;fail (format "Wrong syntax for '" proc "'."))))
-(def: (object//instance? proc generate inputs)
+(def: (object//instance? proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)] objectS))
(do meta;Monad<Meta>
- [objectI (generate objectS)]
+ [objectI (translate objectS)]
(wrap (|>. objectI
($i;INSTANCEOF class)
($i;wrap #$;Boolean))))
@@ -445,7 +445,7 @@
["char" #$;Char])
(dict;from-list text;Hash<Text>)))
-(def: (static//get proc generate inputs)
+(def: (static//get proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)]))
@@ -472,12 +472,12 @@
_
(&;fail (format "Wrong syntax for '" proc "'."))))
-(def: (static//put proc generate inputs)
+(def: (static//put proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS))
(do meta;Monad<Meta>
- [valueI (generate valueS)]
+ [valueI (translate valueS)]
(case (dict;get unboxed primitives)
(#;Some primitive)
(let [primitive (case unboxed
@@ -504,12 +504,12 @@
_
(&;fail (format "Wrong syntax for '" proc "'."))))
-(def: (virtual//get proc generate inputs)
+(def: (virtual//get proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] objectS))
(do meta;Monad<Meta>
- [objectI (generate objectS)]
+ [objectI (translate objectS)]
(case (dict;get unboxed primitives)
(#;Some primitive)
(let [primitive (case unboxed
@@ -535,13 +535,13 @@
_
(&;fail (format "Wrong syntax for '" proc "'."))))
-(def: (virtual//put proc generate inputs)
+(def: (virtual//put proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS objectS))
(do meta;Monad<Meta>
- [valueI (generate valueS)
- objectI (generate objectS)]
+ [valueI (translate valueS)
+ objectI (translate objectS)]
(case (dict;get unboxed primitives)
(#;Some primitive)
(let [primitive (case unboxed
@@ -597,7 +597,7 @@
nesting (p;some (l;this "[]"))]
(wrap ($t;array (list;size nesting) raw))))
-(def: (generate-type argD)
+(def: (translate-type argD)
(-> Text (Meta $;Type))
(case (l;run argD java-type)
(#e;Error error)
@@ -623,7 +623,7 @@
_
(|>. inputI ($i;CHECKCAST ($t;descriptor inputT)))))
-(def: (generate-args generate argsS)
+(def: (translate-args translate argsS)
(-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis)
(Meta (List [$;Type $;Inst])))
(case argsS
@@ -632,9 +632,9 @@
(^ (list& [_ (#;Tuple (list [_ (#;Text argD)] argS))] tail))
(do meta;Monad<Meta>
- [argT (generate-type argD)
- argI (:: @ map (prepare-input argT) (generate argS))
- =tail (generate-args generate tail)]
+ [argT (translate-type argD)
+ argI (:: @ map (prepare-input argT) (translate argS))
+ =tail (translate-args translate tail)]
(wrap (list& [argT argI] =tail)))
_
@@ -647,7 +647,7 @@
(meta/wrap #;None)
_
- (:: meta;Monad<Meta> map (|>. #;Some) (generate-type description))))
+ (:: meta;Monad<Meta> map (|>. #;Some) (translate-type description))))
(def: (prepare-return returnT returnI)
(-> (Maybe $;Type) $;Inst $;Inst)
@@ -664,13 +664,13 @@
_
returnI)))
-(def: (invoke//static proc generate inputs)
+(def: (invoke//static proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list& [_ (#;Text class)] [_ (#;Text method)]
[_ (#;Text unboxed)] argsS))
(do meta;Monad<Meta>
- [argsTI (generate-args generate argsS)
+ [argsTI (translate-args translate argsS)
returnT (method-return-type unboxed)
#let [callI (|>. ($i;fuse (list/map product;right argsTI))
($i;INVOKESTATIC class method
@@ -682,14 +682,14 @@
(&;fail (format "Wrong syntax for '" proc "'."))))
(do-template [<name> <invoke> <interface?>]
- [(def: (<name> proc generate inputs)
+ [(def: (<name> proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list& [_ (#;Text class)] [_ (#;Text method)]
[_ (#;Text unboxed)] objectS argsS))
(do meta;Monad<Meta>
- [objectI (generate objectS)
- argsTI (generate-args generate argsS)
+ [objectI (translate objectS)
+ argsTI (translate-args translate argsS)
returnT (method-return-type unboxed)
#let [callI (|>. objectI
($i;CHECKCAST class)
@@ -707,12 +707,12 @@
[invoke//interface $i;INVOKEINTERFACE true]
)
-(def: (invoke//constructor proc generate inputs)
+(def: (invoke//constructor proc translate inputs)
(-> Text @;Proc)
(case inputs
(^ (list& [_ (#;Text class)] argsS))
(do meta;Monad<Meta>
- [argsTI (generate-args generate argsS)]
+ [argsTI (translate-args translate argsS)]
(wrap (|>. ($i;NEW class)
$i;DUP
($i;fuse (list/map product;right argsTI))
diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
index 7c42f9f08..da86dd5b9 100644
--- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -12,7 +12,7 @@
(translation [";T" common]
[";T" function]))))
-(def: #export (generate-captured variable)
+(def: #export (translate-captured variable)
(-> Variable (Meta $;Inst))
(do meta;Monad<Meta>
[function-class commonT;function]
@@ -21,11 +21,11 @@
(|> variable i.inc (i.* -1) int-to-nat functionT;captured)
commonT;$Object)))))
-(def: #export (generate-variable variable)
+(def: #export (translate-variable variable)
(-> Variable (Meta $;Inst))
(meta/wrap ($i;ALOAD (int-to-nat variable))))
-(def: #export (generate-definition [def-module def-name])
+(def: #export (translate-definition [def-module def-name])
(-> Ident (Meta $;Inst))
(let [bytecode-name (format def-module "/" (&;normalize-name def-name))]
(meta/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 e5d237fc7..0a330ab73 100644
--- a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
@@ -449,7 +449,7 @@
$i;ARETURN)
update-tagI (|>. $i;ISUB ($i;ISTORE +1))
update-variantI (|>. ($i;ALOAD +0) datumI ($i;CHECKCAST ($t;descriptor $Variant)) ($i;ASTORE +0))
- wrongI (|>. $i;NULL $i;ARETURN)
+ failureI (|>. $i;NULL $i;ARETURN)
return-datumI (|>. ($i;ALOAD +0) datumI $i;ARETURN)])
(|>. ($i;label @begin)
($i;ILOAD +1) ## tag
@@ -458,7 +458,7 @@
$i;DUP2 ($i;IF_ICMPGT @further)
$i;DUP2 ($i;IF_ICMPLT @shorten)
## $i;POP2
- wrongI
+ failureI
($i;label @then) ## tag, sumT
($i;ALOAD +2) ## tag, sumT, wants-last?
($i;ALOAD +0) flagI ## tag, sumT, wants-last?, is-last?
@@ -478,7 +478,7 @@
shortenI
($i;label @wrong) ## tag, sumT
## $i;POP2
- wrongI)))
+ 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])
@@ -555,7 +555,7 @@
$i;ARETURN)))
)))
-(def: generate-runtime
+(def: translate-runtime
(Meta commonT;Bytecode)
(do meta;Monad<Meta>
[_ (wrap [])
@@ -569,7 +569,7 @@
_ (commonT;store-class hostL;runtime-class bytecode)]
(wrap bytecode)))
-(def: generate-function
+(def: translate-function
(Meta commonT;Bytecode)
(do meta;Monad<Meta>
[_ (wrap [])
@@ -600,9 +600,9 @@
_ (commonT;store-class hostL;function-class bytecode)]
(wrap bytecode)))
-(def: #export generate
+(def: #export translate
(Meta [commonT;Bytecode commonT;Bytecode])
(do meta;Monad<Meta>
- [runtime-bc generate-runtime
- function-bc generate-function]
+ [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 0234d738c..feb64c293 100644
--- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -31,7 +31,7 @@
(host;import (java.lang.Class c)
(getField [String] #try Field))
-(def: #export (generate-def def-name valueT valueI metaI metaV)
+(def: #export (translate-def def-name valueT valueI metaI metaV)
(-> Text Type $;Inst $;Inst Code (Meta Unit))
(do meta;Monad<Meta>
[current-module meta;current-module-name
@@ -75,7 +75,7 @@
#let [_ (log! (format "DEF " current-module ";" def-name))]]
(commonT;record-artifact bytecode-name bytecode)))
-(def: #export (generate-program program-args programI)
+(def: #export (translate-program program-args programI)
(-> Text $;Inst (Meta Unit))
(do meta;Monad<Meta>
[]
diff --git a/new-luxc/source/luxc/lang/translation/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
index c3e07fd55..3ef03ac2c 100644
--- a/new-luxc/source/luxc/lang/translation/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
@@ -18,17 +18,17 @@
(def: $Object $;Type ($t;class "java.lang.Object" (list)))
-(def: #export (generate-tuple generate members)
+(def: #export (translate-tuple translate members)
(-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis) (Meta $;Inst))
(do meta;Monad<Meta>
[#let [size (list;size members)]
- _ (&;assert "Cannot generate tuples with less than 2 elements."
+ _ (&;assert "Cannot translate tuples with less than 2 elements."
(n.>= +2 size))
membersI (|> members
list;enumerate
(monad;map @ (function [[idx member]]
(do @
- [memberI (generate member)]
+ [memberI (translate member)]
(wrap (|>. $i;DUP
($i;int (nat-to-int idx))
memberI
@@ -44,10 +44,10 @@
($i;string "")
$i;NULL))
-(def: #export (generate-variant generate tag tail? member)
+(def: #export (translate-variant translate tag tail? member)
(-> (-> ls;Synthesis (Meta $;Inst)) Nat Bool ls;Synthesis (Meta $;Inst))
(do meta;Monad<Meta>
- [memberI (generate member)]
+ [memberI (translate member)]
(wrap (|>. ($i;int (nat-to-int tag))
(flagI tail?)
memberI