From 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Nov 2017 22:49:56 -0400 Subject: - Adapted main codebase to the latest syntatic changes. --- .../source/luxc/lang/translation/function.jvm.lux | 376 ++++++++++----------- 1 file changed, 188 insertions(+), 188 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/function.jvm.lux') 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 Monoid])) [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 - [captureI+ (monad;map @ referenceT;translate-variable env) + (-> Text ls.Arity (List Variable) (Meta $.Inst)) + (do macro.Monad + [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-method env arity) false))))) + ($i.INVOKESPECIAL class "" (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-method env arity) false) - $i;ARETURN)) - (|>. ($i;ALOAD +0) - $i;ARETURN)))) + ($i.INVOKESPECIAL class "" (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 "" function-init-method false)) - (|>. ($i;ILOAD (n.inc env-size)) - ($i;INVOKESPECIAL hostL;function-class "" function-init-method false)))) + (-> ls.Arity Nat $.Inst) + (if (n/= +1 arity) + (|>> ($i.int 0) + ($i.INVOKESPECIAL hostL.function-class "" function-init-method false)) + (|>> ($i.ILOAD (n/inc env-size)) + ($i.INVOKESPECIAL hostL.function-class "" 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-method env arity) - (|>. ($i;ALOAD +0) + ($d.method #$.Public $.noneM "" (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-method env function-arity) false) - $i;ARETURN)) + (nullsI (|> num-partials (n/- apply-arity) (n/- stage))) + ($i.INVOKESPECIAL class "" (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 + (do macro.Monad [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 - [@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 + [@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 + (-> (-> ls.Synthesis (Meta $.Inst)) + ls.Synthesis (List ls.Synthesis) + (Meta $.Inst)) + (do macro.Monad [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)))) -- cgit v1.2.3