From 2a3946e713821880ecc47580e754315349f2fe73 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 13 Nov 2017 20:02:18 -0400 Subject: - Type-vars no longer get deleted. - Fixed some bugs. --- .../luxc/lang/translation/expression.jvm.lux | 2 +- .../source/luxc/lang/translation/function.jvm.lux | 67 +++++++++------------- .../source/luxc/lang/translation/reference.jvm.lux | 22 +++++-- 3 files changed, 47 insertions(+), 44 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation') diff --git a/new-luxc/source/luxc/lang/translation/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux index 81cdc1261..fa5f54647 100644 --- a/new-luxc/source/luxc/lang/translation/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux @@ -50,7 +50,7 @@ (^ [_ (#;Form (list [_ (#;Int var)]))]) (if (variableL;captured? var) (referenceT;translate-captured var) - (referenceT;translate-variable var)) + (referenceT;translate-local var)) [_ (#;Symbol definition)] (referenceT;translate-definition definition) diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux index bbf295d18..ea6d371fa 100644 --- a/new-luxc/source/luxc/lang/translation/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux @@ -14,22 +14,14 @@ (lang ["la" analysis] ["ls" synthesis] (translation [";T" common] - [";T" runtime]) + [";T" runtime] + [";T" reference]) [";L" variable #+ Variable]))) (def: arity-field Text "arity") (def: $Object $;Type ($t;class "java.lang.Object" (list))) -(do-template [ ] - [(def: #export ( idx) - (-> Nat Text) - (|> idx nat-to-int %i (format )))] - - [captured "c"] - [partial "p"] - ) - (def: (poly-arg? arity) (-> ls;Arity Bool) (n.> +1 arity)) @@ -97,7 +89,7 @@ (-> (List Variable) $;Def) (|> (list;enumerate env) (list/map (function [[env-idx env-source]] - ($d;field #$;Private $;finalF (captured env-idx) $Object))) + ($d;field #$;Private $;finalF (referenceT;captured env-idx) $Object))) $d;fuse)) (def: (with-partial arity) @@ -105,28 +97,24 @@ (if (poly-arg? arity) (|> (list;n.range +0 (n.- +2 arity)) (list/map (function [idx] - ($d;field #$;Private $;finalF (partial idx) $Object))) + ($d;field #$;Private $;finalF (referenceT;partial idx) $Object))) $d;fuse) id)) (def: (instance class arity env) - (-> Text ls;Arity (List Variable) $;Inst) - (let [captureI (|> env - (list/map (function [source] - (if (variableL;captured? source) - ($i;GETFIELD class (captured (variableL;captured-register source)) $Object) - ($i;ALOAD (int-to-nat source))))) - $i;fuse) - argsI (if (poly-arg? arity) - (|> (nullsI (n.dec arity)) - (list ($i;int 0)) - $i;fuse) - id)] - (|>. ($i;NEW class) - $i;DUP - captureI - argsI - ($i;INVOKESPECIAL class "" (init-method env arity) false)))) + (-> Text ls;Arity (List Variable) (Meta $;Inst)) + (do meta;Monad + [captureI+ (monad;map @ referenceT;translate-variable env) + #let [argsI (if (poly-arg? arity) + (|> (nullsI (n.dec arity)) + (list ($i;int 0)) + $i;fuse) + id)]] + (wrap (|>. ($i;NEW class) + $i;DUP + ($i;fuse captureI+) + argsI + ($i;INVOKESPECIAL class "" (init-method env arity) false))))) (def: (with-reset class arity env) (-> Text ls;Arity (List Variable) $;Def) @@ -138,7 +126,7 @@ _ (list;n.range +0 (n.dec env-size))) (list/map (function [source] (|>. ($i;ALOAD +0) - ($i;GETFIELD class (captured source) $Object)))) + ($i;GETFIELD class (referenceT;captured source) $Object)))) $i;fuse) argsI (|> (nullsI (n.dec arity)) (list ($i;int 0)) @@ -182,7 +170,7 @@ (list/map (function [register] (|>. ($i;ALOAD +0) ($i;ALOAD (n.inc register)) - ($i;PUTFIELD class (captured register) $Object)))) + ($i;PUTFIELD class (referenceT;captured register) $Object)))) $i;fuse) store-partialI (if (poly-arg? arity) (|> (list;n.range +0 (n.- +2 arity)) @@ -190,7 +178,7 @@ (let [register (offset-partial idx)] (|>. ($i;ALOAD +0) ($i;ALOAD (n.inc register)) - ($i;PUTFIELD class (partial idx) $Object))))) + ($i;PUTFIELD class (referenceT;partial idx) $Object))))) $i;fuse) id)] ($d;method #$;Public $;noneM "" (init-method env arity) @@ -212,7 +200,7 @@ (list/map (function [[stage @label]] (let [load-partialsI (if (n.> +0 stage) (|> (list;n.range +0 (n.dec stage)) - (list/map (|>. partial (load-fieldI class))) + (list/map (|>. referenceT;partial (load-fieldI class))) $i;fuse) id)] (cond (i.= arity-over-extent (nat-to-int stage)) @@ -242,7 +230,7 @@ load-capturedI (|> (case env-size +0 (list) _ (list;n.range +0 (n.dec env-size))) - (list/map (|>. captured (load-fieldI class))) + (list/map (|>. referenceT;captured (load-fieldI class))) $i;fuse)] (|>. ($i;label @label) ($i;NEW class) @@ -269,7 +257,7 @@ (def: #export (with-function @begin class env arity bodyI) (-> $;Label Text (List Variable) ls;Arity $;Inst - [$;Def $;Inst]) + (Meta [$;Def $;Inst])) (let [env-size (list;size env) applyD (: $;Def (if (poly-arg? arity) @@ -289,9 +277,10 @@ (with-init class env arity) (with-reset class arity env) applyD - )) - instanceI (instance class arity env)] - [functionD instanceI])) + ))] + (do meta;Monad + [instanceI (instance class arity env)] + (wrap [functionD instanceI])))) (def: #export (translate-function translate env arity bodyS) (-> (-> ls;Synthesis (Meta $;Inst)) @@ -302,7 +291,7 @@ [function-class bodyI] (hostL;with-sub-context (hostL;with-anchor [@begin +1] (translate bodyS))) - #let [[functionD instanceI] (with-function @begin function-class env arity bodyI)] + [functionD instanceI] (with-function @begin 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 3e835f8e1..8e229af9c 100644 --- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux @@ -11,8 +11,16 @@ ["$i" inst])) (lang ["ls" synthesis] [";L" variable #+ Variable] - (translation [";T" common] - [";T" function])))) + (translation [";T" common])))) + +(do-template [ ] + [(def: #export ( idx) + (-> Nat Text) + (|> idx nat-to-int %i (format )))] + + [captured "c"] + [partial "p"] + ) (def: #export (translate-captured variable) (-> Variable (Meta $;Inst)) @@ -20,13 +28,19 @@ [function-class hostL;context] (wrap (|>. ($i;ALOAD +0) ($i;GETFIELD function-class - (|> variable i.inc (i.* -1) int-to-nat functionT;captured) + (|> variable i.inc (i.* -1) int-to-nat captured) commonT;$Object))))) -(def: #export (translate-variable variable) +(def: #export (translate-local variable) (-> Variable (Meta $;Inst)) (meta/wrap ($i;ALOAD (int-to-nat variable)))) +(def: #export (translate-variable 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))] -- cgit v1.2.3