diff options
Diffstat (limited to 'new-luxc')
15 files changed, 80 insertions, 91 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index 4966038c6..7216a1708 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -7,13 +7,12 @@ ["p" parser ["s" code]]] [data + [binary (#+ Binary)] [collection ["." list ("#/." functor)]]] [macro ["." code] [syntax (#+ syntax:)]] - [world - [binary (#+ Binary)]] [target [jvm [type (#+ Class)]]] diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index 4d1b99da0..138098929 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -4,9 +4,11 @@ [control ["." function]] [data - ["." text - format] ["." product] + [number + ["i" int]] + ["." text + ["%" format (#+ format)]] [collection ["." array (#+ Array)] ["." list ("#/." functor)]]] @@ -126,12 +128,12 @@ (def: (class-flags config) (-> //.Class-Config Int) - ($_ i/+ + ($_ i.+ (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0))) (def: (method-flags config) (-> //.Method-Config Int) - ($_ i/+ + ($_ 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) @@ -139,7 +141,7 @@ (def: (field-flags config) (-> //.Field-Config Int) - ($_ i/+ + ($_ 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) @@ -179,7 +181,7 @@ (def: class-computes Int - ($_ i/+ + ($_ i.+ (ClassWriter::COMPUTE_MAXS) ## (ClassWriter::COMPUTE_FRAMES) )) @@ -191,7 +193,7 @@ (host.type [byte])) (let [writer (|> (do-to (ClassWriter::new class-computes) (ClassWriter::visit (version-flag version) - ($_ i/+ + ($_ i.+ (Opcodes::ACC_SUPER) <flag> (visibility-flag visibility) @@ -218,7 +220,7 @@ (host.type [byte])) (let [writer (|> (do-to (ClassWriter::new class-computes) (ClassWriter::visit (version-flag version) - ($_ i/+ + ($_ i.+ (Opcodes::ACC_SUPER) (Opcodes::ACC_INTERFACE) (visibility-flag visibility) @@ -237,7 +239,7 @@ (-> //.Visibility //.Method-Config Text Method //.Inst //.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod ($_ i/+ + (let [=method (ClassWriter::visitMethod ($_ i.+ (visibility-flag visibility) (method-flags config)) ($t.binary-name name) @@ -255,7 +257,7 @@ (-> //.Visibility //.Method-Config Text Method //.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod ($_ i/+ + (let [=method (ClassWriter::visitMethod ($_ i.+ (visibility-flag visibility) (method-flags config) (Opcodes::ACC_ABSTRACT)) @@ -270,7 +272,7 @@ (def: #export (field visibility config name type) (-> //.Visibility //.Field-Config Text Type //.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField ($_ i/+ + (let [=field (do-to (ClassWriter::visitField ($_ i.+ (visibility-flag visibility) (field-flags config)) ($t.binary-name name) @@ -285,7 +287,7 @@ [(def: #export (<name> visibility config name value) (-> //.Visibility //.Field-Config Text <lux-type> //.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField ($_ i/+ + (let [=field (do-to (ClassWriter::visitField ($_ i.+ (visibility-flag visibility) (field-flags config)) ($t.binary-name name) diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index 35f779799..fcf28d4a7 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -11,8 +11,9 @@ ["." product] ["." maybe] ["." error] - [text - format] + [number + ["n" nat] + ["i" int]] [collection ["." list ("#@." functor)]]] [macro @@ -305,13 +306,13 @@ (-> //.Label (List [Int //.Label]) Inst) (function (_ visitor) (let [keys+labels (list.sort (function (_ left right) - (i/< (product.left left) (product.left right))) + (i.< (product.left left) (product.left right))) keys+labels) array-size (list.size keys+labels) keys-array (host.array int array-size) labels-array (host.array org/objectweb/asm/Label array-size) _ (loop [idx 0] - (if (n/< array-size idx) + (if (n.< array-size idx) (let [[key label] (maybe.assume (list.nth idx keys+labels))] (exec (host.array-write idx (host.long-to-int key) keys-array) @@ -327,7 +328,7 @@ (let [num-labels (list.size labels) labels-array (host.array org/objectweb/asm/Label num-labels) _ (loop [idx 0] - (if (n/< num-labels idx) + (if (n.< num-labels idx) (exec (host.array-write idx (maybe.assume (list.nth idx labels)) labels-array) diff --git a/new-luxc/source/luxc/lang/statement/jvm.lux b/new-luxc/source/luxc/lang/statement/jvm.lux index 0de84d65b..9ded2083b 100644 --- a/new-luxc/source/luxc/lang/statement/jvm.lux +++ b/new-luxc/source/luxc/lang/statement/jvm.lux @@ -8,7 +8,7 @@ [data ["." product] [text - format] + ["%" format (#+ format)]] [collection ["." list ("#@." functor fold)] ["." dictionary]]] diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index b2822726c..b5d53aa4f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -10,20 +10,18 @@ [concurrency ["." atom (#+ Atom atom)]]] [data + [binary (#+ Binary)] ["." product] ["." error (#+ Error)] - ["." text ("#/." hash) - format] + ["." text ("#@." hash) + ["%" format (#+ format)]] [collection ["." array] - [list ("#/." functor)] ["." dictionary (#+ Dictionary)]]] [target [jvm ["." loader (#+ Library)] ["." type (#+ Type)]]] - [world - [binary (#+ Binary)]] [tool [compiler ["." name]]]] @@ -127,7 +125,7 @@ (-> Library ClassLoader Name Inst (Error [Text Any Definition])) (let [class-name (format (text.replace-all .module-separator class-path-separator module) class-path-separator (name.normalize name) - "___" (%n (text/hash name)))] + "___" (%.nat (text@hash name)))] (do error.monad [[value definition] (evaluate! library loader class-name valueI)] (wrap [class-name value definition])))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux index 898c211f4..7cea61f14 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.lux @@ -6,8 +6,8 @@ ["." function] ["ex" exception (#+ exception:)]] [data - [text - format]] + [number + ["n" nat]]] [target [jvm ["$t" type]]] @@ -29,9 +29,9 @@ 0 function.identity 1 _.POP 2 _.POP2 - _ ## (n/> 2) + _ ## (n.> 2) (|>> _.POP2 - (pop-altI (n/- 2 stack-depth))))) + (pop-altI (n.- 2 stack-depth))))) (def: peekI Inst diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.lux b/new-luxc/source/luxc/lang/translation/jvm/common.lux index ea6665dc5..26dbcfbc8 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.lux @@ -6,6 +6,7 @@ ["ex" exception (#+ exception:)] ["." io]] [data + [binary (#+ Binary)] ["." error (#+ Error)] ["." text ("#/." hash) format] @@ -13,8 +14,6 @@ ["." dictionary (#+ Dictionary)]]] ["." macro] [host (#+ import:)] - [world - [binary (#+ Binary)]] [tool [compiler [reference (#+ Register)] diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index cc618ca0d..ea9c4ef84 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -6,8 +6,9 @@ [pipe (#+ when> new>)] ["." function]] [data - ["." text - format] + [number + ["n" nat] + ["i" int]] [collection ["." list ("#@." functor monoid)]]] [target @@ -15,7 +16,8 @@ ["#" type (#+ Type Method)]]] [tool [compiler - [analysis (#+ Arity Environment)] + [arity (#+ Arity)] + [analysis (#+ Environment)] [synthesis (#+ Synthesis Abstraction Apply)] [reference (#+ Register)] ["." phase @@ -35,7 +37,7 @@ (def: (poly-arg? arity) (-> Arity Bit) - (n/> 1 arity)) + (n.> 1 arity)) (def: (reset-method class) (-> Text Method) @@ -70,15 +72,15 @@ (def: (inputsI start amount) (-> Register Nat Inst) - (|> (list.n/range start (n/+ start (dec amount))) + (|> (list.n/range start (n.+ start (dec amount))) (list@map _.ALOAD) _.fuse)) (def: (applysI start amount) (-> Register Nat Inst) - (let [max-args (n/min amount runtime.num-apply-variants) - later-applysI (if (n/> runtime.num-apply-variants amount) - (applysI (n/+ runtime.num-apply-variants start) (n/- runtime.num-apply-variants amount)) + (let [max-args (n.min amount runtime.num-apply-variants) + later-applysI (if (n.> runtime.num-apply-variants amount) + (applysI (n.+ runtime.num-apply-variants start) (n.- runtime.num-apply-variants amount)) function.identity)] (|>> (_.CHECKCAST //.function-class) (inputsI start max-args) @@ -106,7 +108,7 @@ (def: (with-partial arity) (-> Arity Def) (if (poly-arg? arity) - (|> (list.n/range 0 (n/- 2 arity)) + (|> (list.n/range 0 (n.- 2 arity)) (list@map (.function (_ idx) (def.field #$.Private $.finalF (reference.partial-name idx) $Object))) def.fuse) @@ -164,7 +166,7 @@ (def: (function-init arity env-size) (-> Arity Nat Inst) - (if (n/= 1 arity) + (if (n.= 1 arity) (|>> (_.int +0) (_.INVOKESPECIAL //.function-class "<init>" function-init-method #0)) (|>> (_.ILOAD (inc env-size)) @@ -174,7 +176,7 @@ (-> Text Environment Arity Def) (let [env-size (list.size env) offset-partial (: (-> Nat Nat) - (|>> inc (n/+ env-size))) + (|>> inc (n.+ env-size))) store-capturedI (|> (case env-size 0 (list) _ (list.n/range 0 (dec env-size))) @@ -184,7 +186,7 @@ (_.PUTFIELD class (reference.foreign-name register) $Object)))) _.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)] (|>> (_.ALOAD 0) @@ -205,28 +207,28 @@ (let [num-partials (dec function-arity) @default ($.new-label []) @labels (list@map $.new-label (list.repeat num-partials [])) - arity-over-extent (|> (.int function-arity) (i/- (.int apply-arity))) + arity-over-extent (|> (.int function-arity) (i.- (.int apply-arity))) casesI (|> (list@compose @labels (list @default)) (list.zip2 (list.n/range 0 num-partials)) (list@map (.function (_ [stage @label]) - (let [load-partialsI (if (n/> 0 stage) + (let [load-partialsI (if (n.> 0 stage) (|> (list.n/range 0 (dec stage)) (list@map (|>> reference.partial-name (load-fieldI class))) _.fuse) function.identity)] - (cond (i/= arity-over-extent (.int stage)) + (cond (i.= arity-over-extent (.int stage)) (|>> (_.label @label) (_.ALOAD 0) - (when> [(new> (n/> 0 stage) [])] + (when> [(new> (n.> 0 stage) [])] [(_.INVOKEVIRTUAL class "reset" (reset-method class) #0)]) load-partialsI (inputsI 1 apply-arity) (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity) #0) _.ARETURN) - (i/> arity-over-extent (.int stage)) - (let [args-to-completion (|> function-arity (n/- stage)) - args-left (|> apply-arity (n/- args-to-completion))] + (i.> arity-over-extent (.int stage)) + (let [args-to-completion (|> function-arity (n.- stage)) + args-left (|> apply-arity (n.- args-to-completion))] (|>> (_.label @label) (_.ALOAD 0) (_.INVOKEVIRTUAL class "reset" (reset-method class) #0) @@ -236,7 +238,7 @@ (applysI (inc args-to-completion) args-left) _.ARETURN)) - ## (i/< arity-over-extent (.int stage)) + ## (i.< arity-over-extent (.int stage)) (let [env-size (list.size env) load-capturedI (|> (case env-size 0 (list) @@ -251,7 +253,7 @@ (inc-intI apply-arity) load-partialsI (inputsI 1 apply-arity) - (nullsI (|> num-partials (n/- apply-arity) (n/- stage))) + (nullsI (|> num-partials (n.- apply-arity) (n.- stage))) (_.INVOKESPECIAL class "<init>" (init-method env function-arity) #0) _.ARETURN)) )))) @@ -272,7 +274,7 @@ (let [env-size (list.size env) applyD (: Def (if (poly-arg? arity) - (|> (n/min arity runtime.num-apply-variants) + (|> (n.min arity runtime.num-apply-variants) (list.n/range 1) (list@map (with-apply class env arity @begin bodyI)) (list& (with-implementation arity @begin bodyI)) @@ -293,13 +295,13 @@ [instanceI (instance class arity env)] (wrap [functionD instanceI])))) -(def: #export (function translate [env arity bodyS]) +(def: #export (function generate [env arity bodyS]) (-> Phase Abstraction (Operation Inst)) (do phase.monad [@begin _.make-label [function-class bodyI] (generation.with-context (generation.with-anchor [@begin 1] - (translate bodyS))) + (generate bodyS))) [functionD instanceI] (with-function @begin function-class env arity bodyI) _ (generation.save! true ["" function-class] [function-class @@ -309,19 +311,13 @@ 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) - (list pre) - (list& pre (segment size post))))) - -(def: #export (call translate [functionS argsS]) +(def: #export (call generate [functionS argsS]) (-> Phase Apply (Operation Inst)) (do phase.monad - [functionI (translate functionS) - argsI (monad.map @ translate argsS) - #let [applyI (|> (segment runtime.num-apply-variants argsI) + [functionI (generate functionS) + argsI (monad.map @ generate argsS) + #let [applyI (|> argsI + (list.split-all runtime.num-apply-variants) (list@map (.function (_ chunkI+) (|>> (_.CHECKCAST //.function-class) (_.fuse chunkI+) diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.lux index d7e706aaf..5b4f981f6 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.lux @@ -5,8 +5,8 @@ [control ["." function]] [data - ["." text - format] + [number + ["n" nat]] [collection ["." list ("#/." functor monoid)]]] [tool @@ -26,7 +26,7 @@ (-> Register Synthesis Bit) (case changeS (^ (synthesis.variable/local var)) - (n/= register var) + (n.= register var) _ #0)) @@ -35,7 +35,7 @@ (-> Phase (List Synthesis) (Operation Inst)) (do phase.monad [[@begin start] generation.anchor - #let [end (|> argsS list.size dec (n/+ start)) + #let [end (|> argsS list.size dec (n.+ start)) pairs (list.zip2 (list.n/range start end) argsS)] ## It may look weird that first I compile the values separately, @@ -72,7 +72,7 @@ #let [initializationI (|> (list.enumerate initsI+) (list/map (function (_ [register initI]) (|>> initI - (_.ASTORE (n/+ start register))))) + (_.ASTORE (n.+ start register))))) _.fuse)]] (wrap (|>> initializationI (_.label @begin) diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux index b97e50419..85fed0a8e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux @@ -1,10 +1,5 @@ (.module: [lux (#- i64) - [abstract - monad] - [data - [text - format]] [target [jvm ["$t" type]]] diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux index 34462d9ba..93d4b6c0b 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux @@ -9,8 +9,8 @@ [data ["." product] ["." error] - ["." text - format] + [number + ["f" frac]] [collection ["." list ("#@." monad)] ["." dictionary]]] @@ -161,7 +161,7 @@ (|>> <const> (_.wrap <type>)))] [frac::smallest (_.double (Double::MIN_VALUE)) #_t.Double] - [frac::min (_.double (f/* -1.0 (Double::MAX_VALUE))) #_t.Double] + [frac::min (_.double (f.* -1.0 (Double::MAX_VALUE))) #_t.Double] [frac::max (_.double (Double::MAX_VALUE)) #_t.Double] ) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux index 173bb9066..1b3d3c345 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux @@ -14,8 +14,7 @@ ["." error] [number ["." nat]] - ["." text - format] + ["." text] [collection ["." list ("#@." monad)] ["." dictionary (#+ Dictionary)] diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux index 886f461ce..5fb0e0d63 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.lux @@ -4,7 +4,7 @@ [monad (#+ do)]] [data [text - format]] + ["%" format (#+ format)]]] [tool [compiler ["." name] @@ -19,9 +19,9 @@ ["." //]) (template [<name> <prefix>] - [(def: #export (<name> idx) + [(def: #export <name> (-> Nat Text) - (|> idx %n (format <prefix>)))] + (|>> %.nat (format <prefix>)))] [foreign-name "f"] [partial-name "p"] diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux index 26d98771b..05d43a367 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux @@ -3,8 +3,6 @@ [abstract [monad (#+ do)]] [data - [text - format] [collection ["." list ("#/." functor)]]] ["." math] @@ -13,7 +11,7 @@ ["$t" type (#+ Type Method)]]] [tool [compiler - [analysis (#+ Arity)] + [arity (#+ Arity)] ["." synthesis] ["." phase ["." generation]]]]] diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux index fe5d6bd6d..5e721f65a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux @@ -5,8 +5,10 @@ [control ["ex" exception (#+ exception:)]] [data + [number + ["n" nat]] [text - format] + ["%" format (#+ format)]] [collection ["." list]]] [target @@ -25,7 +27,7 @@ (exception: #export (not-a-tuple {size Nat}) (ex.report ["Expected size" ">= 2"] - ["Actual size" (%n size)])) + ["Actual size" (%.nat size)])) (def: $Object ($t.class "java.lang.Object" (list))) @@ -34,7 +36,7 @@ (do phase.monad [#let [size (list.size members)] _ (phase.assert not-a-tuple size - (n/>= 2 size)) + (n.>= 2 size)) membersI (|> members list.enumerate (monad.map @ (function (_ [idx member]) |