diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
4 files changed, 16 insertions, 46 deletions
diff --git a/new-luxc/source/luxc/lang/translation/case.jvm.lux b/new-luxc/source/luxc/lang/translation/case.jvm.lux index 3858627ff..09ffae328 100644 --- a/new-luxc/source/luxc/lang/translation/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/case.jvm.lux @@ -70,8 +70,7 @@ (^ [_ (#;Form (list [_ (#;Text "lux case bind")] [_ (#;Nat register)]))]) (meta/wrap (|>. peekI - ($i;ASTORE register) - popI)) + ($i;ASTORE register))) [_ (#;Bool value)] (meta/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)] diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux index 1870530c2..f9825614a 100644 --- a/new-luxc/source/luxc/lang/translation/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux @@ -33,8 +33,8 @@ (type: #export Host {#loader ClassLoader #store Class-Store - #function-class (Maybe Text) - #artifacts Artifacts}) + #artifacts Artifacts + #context [Text Nat]}) (exception: Unknown-Class) (exception: Class-Already-Stored) @@ -93,38 +93,6 @@ (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))]) (ex;throw Unknown-Class name))))) -(def: #export (with-function class expr) - (All [a] (-> Text (Meta a) (Meta a))) - (;function [compiler] - (let [host (:! Host (get@ #;host compiler)) - old-function-class (get@ #function-class host)] - (case (expr (set@ #;host - (:! Void (set@ #function-class - (#;Some class) - host)) - compiler)) - (#e;Success [compiler' output]) - (#e;Success [(update@ #;host - (|>. (:! Host) - (set@ #function-class old-function-class) - (:! Void)) - compiler') - output]) - - (#e;Error error) - (#e;Error error))))) - -(def: #export function - (Meta Text) - (;function [compiler] - (let [host (:! Host (get@ #;host compiler))] - (case (get@ #function-class host) - #;None - (ex;throw No-Function-Being-Compiled "") - - (#;Some function-class) - (#e;Success [compiler function-class]))))) - (def: #export bytecode-version Int Opcodes.V1_6) (def: #export value-field Text "_value") diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux index ebdb28853..1b7f6267b 100644 --- a/new-luxc/source/luxc/lang/translation/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux @@ -1,7 +1,8 @@ (;module: lux (lux (control [monad #+ do]) - (data text/format + (data [text] + text/format (coll [list "list/" Functor<List> Monoid<List>])) [meta]) (luxc ["&" base] @@ -266,13 +267,11 @@ $i;ARETURN )))) -(def: #export (with-function translate class env arity body) - (-> (-> ls;Synthesis (Meta $;Inst)) - Text (List Variable) ls;Arity ls;Synthesis +(def: #export (with-function class env arity bodyI) + (-> Text (List Variable) ls;Arity $;Inst (Meta [$;Def $;Inst])) (do meta;Monad<Meta> [@begin $i;make-label - bodyI (commonT;with-function class (translate body)) #let [env-size (list;size env) applyD (: $;Def (if (poly-arg? arity) @@ -300,8 +299,10 @@ (List Variable) ls;Arity ls;Synthesis (Meta $;Inst)) (do meta;Monad<Meta> - [function-class (:: @ map %code (meta;gensym "function")) - [functionD instanceI] (with-function translate function-class env arity body) + [[context bodyI] (hostL;with-sub-context + (translate body)) + #let [function-class (text;replace-all "/+" "$" context)] + [functionD instanceI] (with-function function-class env arity bodyI) _ (commonT;store-class function-class ($d;class #$;V1.6 #$;Public $;finalC function-class (list) diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux index da86dd5b9..57336f27c 100644 --- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux @@ -1,9 +1,11 @@ (;module: lux (lux (control [monad #+ do]) - (data text/format) + (data [text] + text/format) [meta "meta/" Monad<Meta>]) (luxc ["&" base] + [";L" host] (host ["$" jvm] (jvm ["$t" type] ["$i" inst])) @@ -15,9 +17,9 @@ (def: #export (translate-captured variable) (-> Variable (Meta $;Inst)) (do meta;Monad<Meta> - [function-class commonT;function] + [function-class hostL;context] (wrap (|>. ($i;ALOAD +0) - ($i;GETFIELD function-class + ($i;GETFIELD (text;replace-all "/+" "$" function-class) (|> variable i.inc (i.* -1) int-to-nat functionT;captured) commonT;$Object))))) |