diff options
Diffstat (limited to 'new-luxc')
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/def.lux | 24 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/inst.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/type.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm.lux | 22 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux | 16 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux | 46 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux | 66 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux | 9 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux | 152 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux | 4 | ||||
| -rw-r--r-- | new-luxc/source/luxc/repl.lux | 73 | ||||
| -rw-r--r-- | new-luxc/source/program.lux | 38 |
13 files changed, 214 insertions, 243 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index f70543ff7..33ded893b 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -92,28 +92,28 @@ #$.Public Opcodes::ACC_PUBLIC #$.Protected Opcodes::ACC_PROTECTED #$.Private Opcodes::ACC_PRIVATE - #$.Default 0)) + #$.Default +0)) (def: (class-flags config) (-> $.Class-Config Int) ($_ i/+ - (if (get@ #$.finalC config) Opcodes::ACC_FINAL 0))) + (if (get@ #$.finalC config) Opcodes::ACC_FINAL +0))) (def: (method-flags config) (-> $.Method-Config Int) ($_ 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) - (if (get@ #$.strictM config) Opcodes::ACC_STRICT 0))) + (if (get@ #$.staticM config) Opcodes::ACC_STATIC +0) + (if (get@ #$.finalM config) Opcodes::ACC_FINAL +0) + (if (get@ #$.synchronizedM config) Opcodes::ACC_SYNCHRONIZED +0) + (if (get@ #$.strictM config) Opcodes::ACC_STRICT +0))) (def: (field-flags config) (-> $.Field-Config Int) ($_ 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) - (if (get@ #$.volatileF config) Opcodes::ACC_VOLATILE 0))) + (if (get@ #$.staticF config) Opcodes::ACC_STATIC +0) + (if (get@ #$.finalF config) Opcodes::ACC_FINAL +0) + (if (get@ #$.transientF config) Opcodes::ACC_TRANSIENT +0) + (if (get@ #$.volatileF config) Opcodes::ACC_VOLATILE +0))) (def: class-to-type (-> $.Class $.Type) @@ -176,7 +176,7 @@ _ (ClassWriter::visitEnd [] writer)] (ClassWriter::toByteArray [] writer)))] - [class 0] + [class +0] [abstract Opcodes::ACC_ABSTRACT] ) @@ -217,7 +217,7 @@ writer) _ (MethodVisitor::visitCode [] =method) _ (then =method) - _ (MethodVisitor::visitMaxs [0 0] =method) + _ (MethodVisitor::visitMaxs [+0 +0] =method) _ (MethodVisitor::visitEnd [] =method)] writer))) diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index d63ca3795..cb8d47960 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -294,7 +294,7 @@ (function (_ visitor) (let [num-labels (list.size labels) labels-array (host.array Label num-labels) - _ (loop [idx +0] + _ (loop [idx 0] (if (n/< num-labels idx) (exec (host.array-write idx (maybe.assume (list.nth idx labels)) diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux index 866ef1cef..57374337d 100644 --- a/new-luxc/source/luxc/lang/host/jvm/type.lux +++ b/new-luxc/source/luxc/lang/host/jvm/type.lux @@ -36,7 +36,7 @@ (def: #export (array depth elemT) (-> Nat //.Type //.Type) (case depth - +0 elemT + 0 elemT _ (#//.Array (array (dec depth) elemT)))) (def: #export binary-name diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index 3e239798b..52b104149 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -57,11 +57,11 @@ (def: ClassLoader::defineClass Method (case (Class::getDeclaredMethod ["defineClass" - (|> (host.array (Class Object) +4) - (host.array-write +0 (:coerce (Class Object) (host.class-for String))) - (host.array-write +1 (Object::getClass [] (host.array byte +0))) - (host.array-write +2 (:coerce (Class Object) Integer::TYPE)) - (host.array-write +3 (:coerce (Class Object) Integer::TYPE)))] + (|> (host.array (Class Object) 4) + (host.array-write 0 (:coerce (Class Object) (host.class-for String))) + (host.array-write 1 (Object::getClass [] (host.array byte 0))) + (host.array-write 2 (:coerce (Class Object) Integer::TYPE)) + (host.array-write 3 (:coerce (Class Object) Integer::TYPE)))] (host.class-for java/lang/ClassLoader)) (#error.Success method) (do-to method @@ -77,7 +77,7 @@ (Method::invoke [loader (array.from-list (list (:coerce Object class-name) (:coerce Object bytecode) - (:coerce Object (host.long-to-int 0)) + (:coerce Object (host.long-to-int +0)) (:coerce Object (host.long-to-int (.int (host.array-length bytecode))))))] ClassLoader::defineClass)) @@ -160,10 +160,10 @@ (#error.Error error) (ex.throw invalid-field [class-name ..value-field]))) -(def: (eval store loader valueI) - (-> Store ClassLoader Inst (Error Any)) +(def: (eval store loader temp-label valueI) + (-> Store ClassLoader Text Inst (Error Any)) (do error.Monad<Error> - [#let [eval-class "eval" + [#let [eval-class (|> temp-label name.normalize (text.replace-all " " "$")) bytecode (def.class #jvm.V1_6 #jvm.Public jvm.noneC eval-class @@ -181,8 +181,8 @@ class (..load! eval-class loader)] (class-value eval-class class))) -(def: (define store loader [class-name class-bytecode]) - (-> Store ClassLoader Definition (Error Any)) +(def: (define store loader temp-label [class-name class-bytecode]) + (-> Store ClassLoader Text Definition (Error Any)) (do error.Monad<Error> [_ (..store! class-name class-bytecode store) class (..load! class-name loader)] diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux index 016edf3d2..0eb815458 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -22,12 +22,12 @@ (def: (pop-altI stack-depth) (-> Nat Inst) (.case stack-depth - +0 id - +1 _.POP - +2 _.POP2 - _ ## (n/> +2) + 0 id + 1 _.POP + 2 _.POP2 + _ ## (n/> 2) (|>> _.POP2 - (pop-altI (n/- +2 stack-depth))))) + (pop-altI (n/- 2 stack-depth))))) (def: peekI Inst @@ -110,10 +110,10 @@ (^template [<pattern> <method> <mod>] (^ (<pattern> idx)) (operation/wrap (.case (<mod> idx) - +0 + 0 (|>> peekI (_.CHECKCAST ($t.descriptor runtime.$Tuple)) - (_.int 0) + (_.int +0) _.AALOAD pushI) @@ -179,7 +179,7 @@ (-> Phase Path Label (Operation Inst)) (do phase.Monad<Operation> [@else _.make-label - pathI (..path' translate +1 @else @end path)] + pathI (..path' translate 1 @else @end path)] (wrap (|>> pathI (_.label @else) _.POP diff --git a/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux deleted file mode 100644 index 49fbd0385..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux +++ /dev/null @@ -1,46 +0,0 @@ -(.module: - lux - (lux (control monad) - (data [text] - text/format) - [macro] - [host #+ do-to]) - (luxc ["&" lang] - (lang (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["_" inst])) - ["la" analysis] - ["ls" synthesis])) - (// [".T" common])) - -(host.import: java/lang/reflect/Field - (get [Object] Object)) - -(host.import: (java/lang/Class a) - (getField [String] Field)) - -(def: #export (eval valueI) - (-> $.Inst (Meta Any)) - (do macro.Monad<Meta> - [current-module macro.current-module-name - class-name (:: @ map %code (macro.gensym (format current-module "/eval"))) - #let [store-name (text.replace-all "/" "." class-name) - bytecode ($d.class #$.V1_6 - #$.Public $.noneC - class-name - (list) ["java.lang.Object" (list)] - (list) - (|>> ($d.field #$.Public ($_ $.++F $.finalF $.staticF) - commonT.value-field commonT.$Object) - ($d.method #$.Public ($_ $.++M $.staticM $.strictM) - "<clinit>" - ($t.method (list) #.None (list)) - (|>> valueI - (_.PUTSTATIC store-name commonT.value-field commonT.$Object) - _.RETURN))))] - _ (commonT.store-class store-name bytecode) - class (commonT.load-class store-name)] - (wrap (|> class - (Class::getField [commonT.value-field]) - (Field::get (host.null)))))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux index 17585b63c..4e2b71f39 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -31,7 +31,7 @@ (def: (poly-arg? arity) (-> Arity Bit) - (n/> +1 arity)) + (n/> 1 arity)) (def: (reset-method class) (-> Text $.Method) @@ -56,12 +56,12 @@ (def: get-amount-of-partialsI Inst - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.GETFIELD //.function-class runtime.partials-field type.int))) (def: (load-fieldI class field) (-> Text Text Inst) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.GETFIELD class field $Object))) (def: (inputsI start amount) @@ -102,7 +102,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) @@ -114,7 +114,7 @@ [captureI+ (monad.map @ reference.variable env) #let [argsI (if (poly-arg? arity) (|> (nullsI (dec arity)) - (list (_.int 0)) + (list (_.int +0)) _.fuse) id)]] (wrap (|>> (_.NEW class) @@ -129,14 +129,14 @@ (if (poly-arg? arity) (let [env-size (list.size env) captureI (|> (case env-size - +0 (list) - _ (list.n/range +0 (dec env-size))) + 0 (list) + _ (list.n/range 0 (dec env-size))) (list/map (.function (_ source) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.GETFIELD class (reference.foreign-name source) $Object)))) _.fuse) argsI (|> (nullsI (dec arity)) - (list (_.int 0)) + (list (_.int +0)) _.fuse)] (|>> (_.NEW class) _.DUP @@ -144,7 +144,7 @@ argsI (_.INVOKESPECIAL class "<init>" (init-method env arity) #0) _.ARETURN)) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) _.ARETURN)))) (def: (with-implementation arity @begin bodyI) @@ -160,8 +160,8 @@ (def: (function-init arity env-size) (-> Arity Nat Inst) - (if (n/= +1 arity) - (|>> (_.int 0) + (if (n/= 1 arity) + (|>> (_.int +0) (_.INVOKESPECIAL //.function-class "<init>" function-init-method #0)) (|>> (_.ILOAD (inc env-size)) (_.INVOKESPECIAL //.function-class "<init>" function-init-method #0)))) @@ -172,24 +172,24 @@ offset-partial (: (-> Nat Nat) (|>> inc (n/+ env-size))) store-capturedI (|> (case env-size - +0 (list) - _ (list.n/range +0 (dec env-size))) + 0 (list) + _ (list.n/range 0 (dec env-size))) (list/map (.function (_ register) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.ALOAD (inc register)) (_.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) + (|>> (_.ALOAD 0) (_.ALOAD (inc register)) (_.PUTFIELD class (reference.partial-name idx) $Object))))) _.fuse) id)] (def.method #$.Public $.noneM "<init>" (init-method env arity) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (function-init arity env-size) store-capturedI store-partialI @@ -203,20 +203,20 @@ @labels (list/map $.new-label (list.repeat num-partials [])) 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.zip2 (list.n/range 0 num-partials)) (list/map (.function (_ [stage @label]) - (let [load-partialsI (if (n/> +0 stage) - (|> (list.n/range +0 (dec stage)) + (let [load-partialsI (if (n/> 0 stage) + (|> (list.n/range 0 (dec stage)) (list/map (|>> reference.partial-name (load-fieldI class))) _.fuse) id)] (cond (i/= arity-over-extent (.int stage)) (|>> (_.label @label) - (_.ALOAD +0) - (when (n/> +0 stage) + (_.ALOAD 0) + (when (n/> 0 stage) (_.INVOKEVIRTUAL class "reset" (reset-method class) #0)) load-partialsI - (inputsI +1 apply-arity) + (inputsI 1 apply-arity) (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity) #0) _.ARETURN) @@ -224,10 +224,10 @@ (let [args-to-completion (|> function-arity (n/- stage)) args-left (|> apply-arity (n/- args-to-completion))] (|>> (_.label @label) - (_.ALOAD +0) + (_.ALOAD 0) (_.INVOKEVIRTUAL class "reset" (reset-method class) #0) load-partialsI - (inputsI +1 args-to-completion) + (inputsI 1 args-to-completion) (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity) #0) (applysI (inc args-to-completion) args-left) _.ARETURN)) @@ -235,8 +235,8 @@ ## (i/< arity-over-extent (.int stage)) (let [env-size (list.size env) load-capturedI (|> (case env-size - +0 (list) - _ (list.n/range +0 (dec env-size))) + 0 (list) + _ (list.n/range 0 (dec env-size))) (list/map (|>> reference.foreign-name (load-fieldI class))) _.fuse)] (|>> (_.label @label) @@ -246,7 +246,7 @@ get-amount-of-partialsI (inc-intI apply-arity) load-partialsI - (inputsI +1 apply-arity) + (inputsI 1 apply-arity) (nullsI (|> num-partials (n/- apply-arity) (n/- stage))) (_.INVOKESPECIAL class "<init>" (init-method env function-arity) #0) _.ARETURN)) @@ -254,7 +254,7 @@ _.fuse)] (def.method #$.Public $.noneM runtime.apply-method (runtime.apply-signature apply-arity) (|>> get-amount-of-partialsI - (_.TABLESWITCH 0 (|> num-partials dec .int) + (_.TABLESWITCH +0 (|> num-partials dec .int) @default @labels) casesI (_.INVOKESTATIC //.runtime-class "apply_fail" (type.method (list) #.None (list)) #0) @@ -269,11 +269,11 @@ applyD (: Def (if (poly-arg? arity) (|> (n/min arity runtime.num-apply-variants) - (list.n/range +1) + (list.n/range 1) (list/map (with-apply class env arity @begin bodyI)) (list& (with-implementation arity @begin bodyI)) def.fuse) - (def.method #$.Public $.strictM runtime.apply-method (runtime.apply-signature +1) + (def.method #$.Public $.strictM runtime.apply-method (runtime.apply-signature 1) (|>> (_.label @begin) bodyI _.ARETURN)))) @@ -294,7 +294,7 @@ (do phase.Monad<Operation> [@begin _.make-label [function-class bodyI] (translation.with-context - (translation.with-anchor [@begin +1] + (translation.with-anchor [@begin 1] (translate bodyS))) [functionD instanceI] (with-function @begin function-class env arity bodyI) _ (translation.save! ["" function-class] diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux index ba606a437..2268b3ba2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux @@ -3,7 +3,7 @@ [control [monad (#+ do)]] [data - [text ("text/." Hash<Text>) + [text format]] [compiler [default @@ -32,7 +32,7 @@ (-> Register (Operation Inst)) (do phase.Monad<Operation> [function-class translation.context] - (wrap (|>> (_.ALOAD +0) + (wrap (|>> (_.ALOAD 0) (_.GETFIELD function-class (|> variable .nat foreign-name) //.$Object))))) @@ -50,7 +50,8 @@ (#reference.Foreign variable) (foreign variable))) -(def: #export (constant [module short]) +(def: #export (constant name) (-> Name (Operation Inst)) - (let [bytecode-name (format module "/" (name.normalize short) (%n (text/hash short)))] + (do phase.Monad<Operation> + [bytecode-name (translation.remember name)] (operation/wrap (_.GETSTATIC bytecode-name //.value-field //.$Object)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 86efad1ab..28bce7d28 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -23,9 +23,9 @@ ["." // (#+ ByteCode)]) (def: $Object $.Type ($t.class "java.lang.Object" (list))) -(def: $Object-Array $.Type ($t.array +1 $Object)) +(def: $Object-Array $.Type ($t.array 1 $Object)) (def: $String $.Type ($t.class "java.lang.String" (list))) -(def: #export $Stack $.Type ($t.array +1 $Object)) +(def: #export $Stack $.Type ($t.array 1 $Object)) (def: #export $Tuple $.Type $Object-Array) (def: #export $Variant $.Type $Object-Array) (def: #export $Tag $.Type $t.int) @@ -53,7 +53,7 @@ (def: #export leftI Inst - (|>> (_.int 0) + (|>> (_.int +0) _.NULL _.DUP2_X1 _.POP2 @@ -61,7 +61,7 @@ (def: #export rightI Inst - (|>> (_.int 1) + (|>> (_.int +1) (_.string "") _.DUP2_X1 _.POP2 @@ -71,7 +71,7 @@ (def: #export noneI Inst - (|>> (_.int 0) + (|>> (_.int +0) _.NULL (_.string //.unit) variantI)) @@ -97,7 +97,7 @@ (def: #export partials-field Text "partials") (def: #export apply-method Text "apply") -(def: #export num-apply-variants Nat +8) +(def: #export num-apply-variants Nat 8) (def: #export (apply-signature arity) (-> Arity Method) @@ -105,9 +105,9 @@ (def: adt-methods Def - (let [store-tagI (|>> _.DUP (_.int 0) (_.ILOAD +0) (_.wrap #$.Int) _.AASTORE) - store-flagI (|>> _.DUP (_.int 1) (_.ALOAD +1) _.AASTORE) - store-valueI (|>> _.DUP (_.int 2) (_.ALOAD +2) _.AASTORE) + (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$.Int) _.AASTORE) + store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE) + store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE) force-textMT ($t.method (list $Object) (#.Some $String) (list))] (|>> ($d.method #$.Public $.staticM "force_text" force-textMT (<| _.with-label (function (_ @is-null)) @@ -117,10 +117,10 @@ _.with-label (function (_ @is-first)) _.with-label (function (_ @elem-end)) _.with-label (function (_ @fold-end)) - (let [on-normal-objectI (|>> (_.ALOAD +0) + (let [on-normal-objectI (|>> (_.ALOAD 0) (_.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0)) on-null-objectI (_.string "NULL") - arrayI (|>> (_.ALOAD +0) + arrayI (|>> (_.ALOAD 0) (_.CHECKCAST ($t.descriptor $Object-Array))) recurseI (_.INVOKESTATIC //.runtime-class "force_text" force-textMT #0) force-elemI (|>> _.DUP arrayI _.SWAP _.AALOAD recurseI) @@ -140,10 +140,10 @@ force-elemI merge-with-totalI (_.label @elem-end) ## TSI ) - inc-idxI (|>> (_.int 1) _.IADD) + inc-idxI (|>> (_.int +1) _.IADD) on-array-objectI (|>> (_.string "[") ## T arrayI _.ARRAYLENGTH ## TS - (_.int 0) ## TSI + (_.int +0) ## TSI (_.label @array-loop) ## TSI _.DUP2 (_.IF_ICMPGT @within-bounds) ## TSI @@ -151,9 +151,9 @@ (_.label @within-bounds) foldI inc-idxI (_.GOTO @array-loop) (_.label @fold-end))]) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.IFNULL @is-null) - (_.ALOAD +0) + (_.ALOAD 0) (_.INSTANCEOF ($t.descriptor $Object-Array)) (_.IFEQ @normal-object) on-array-objectI _.ARETURN @@ -163,7 +163,7 @@ ($t.method (list $t.int $Object $Object) (#.Some $Variant) (list)) - (|>> (_.int 3) + (|>> (_.int +3) (_.array $Object) store-tagI store-flagI @@ -174,13 +174,13 @@ Inst (_.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0)) -(def: frac-shiftI Inst (_.double (math.pow 32.0 2.0))) +(def: frac-shiftI Inst (_.double (math.pow +32.0 +2.0))) (def: frac-methods Def (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) (try-methodI - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) (_.wrap #$.Double)))) )) @@ -191,14 +191,14 @@ Def (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) (try-methodI - (|>> (_.ALOAD +0) - (_.ILOAD +1) - (_.ILOAD +2) + (|>> (_.ALOAD 0) + (_.ILOAD 1) + (_.ILOAD 2) (_.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) (try-methodI - (|>> (_.ALOAD +0) - (_.ILOAD +1) + (|>> (_.ALOAD 0) + (_.ILOAD 1) (_.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) _.I2L (_.wrap #$.Long)))) @@ -206,10 +206,10 @@ (def: pm-methods Def - (let [tuple-sizeI (|>> (_.ALOAD +0) _.ARRAYLENGTH) - tuple-elemI (|>> (_.ALOAD +0) (_.ILOAD +1) _.AALOAD) - expected-last-sizeI (|>> (_.ILOAD +1) (_.int 1) _.IADD) - tuple-tailI (|>> (_.ALOAD +0) tuple-sizeI (_.int 1) _.ISUB _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))] + (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) + tuple-elemI (|>> (_.ALOAD 0) (_.ILOAD 1) _.AALOAD) + expected-last-sizeI (|>> (_.ILOAD 1) (_.int +1) _.IADD) + tuple-tailI (|>> (_.ALOAD 0) tuple-sizeI (_.int +1) _.ISUB _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))] (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list)) (|>> (_.NEW "java.lang.IllegalStateException") _.DUP @@ -223,26 +223,26 @@ (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) _.ATHROW)) ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list)) - (|>> (_.int 2) + (|>> (_.int +2) (_.ANEWARRAY "java.lang.Object") _.DUP - (_.int 0) - (_.ALOAD +0) + (_.int +0) + (_.ALOAD 0) _.AASTORE _.DUP - (_.int 1) - (_.ALOAD +1) + (_.int +1) + (_.ALOAD 1) _.AASTORE _.ARETURN)) ($d.method #$.Public $.staticM "pm_pop" ($t.method (list $Stack) (#.Some $Stack) (list)) - (|>> (_.ALOAD +0) - (_.int 0) + (|>> (_.ALOAD 0) + (_.int +0) _.AALOAD (_.CHECKCAST ($t.descriptor $Stack)) _.ARETURN)) ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list)) - (|>> (_.ALOAD +0) - (_.int 1) + (|>> (_.ALOAD 0) + (_.int +1) _.AALOAD _.ARETURN)) ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list)) @@ -256,33 +256,33 @@ (function (_ idx) (|>> (_.int (.int idx)) _.AALOAD))) tagI (: Inst - (|>> (variant-partI +0) (_.unwrap #$.Int))) - flagI (variant-partI +1) - datumI (variant-partI +2) - shortenI (|>> (_.ALOAD +0) tagI ## Get tag - (_.ILOAD +1) _.ISUB ## Shorten tag - (_.ALOAD +0) flagI ## Get flag - (_.ALOAD +0) datumI ## Get value + (|>> (variant-partI 0) (_.unwrap #$.Int))) + flagI (variant-partI 1) + datumI (variant-partI 2) + shortenI (|>> (_.ALOAD 0) tagI ## Get tag + (_.ILOAD 1) _.ISUB ## Shorten tag + (_.ALOAD 0) flagI ## Get flag + (_.ALOAD 0) datumI ## Get value variantI ## Build sum _.ARETURN) - update-tagI (|>> _.ISUB (_.ISTORE +1)) - update-variantI (|>> (_.ALOAD +0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE +0)) + update-tagI (|>> _.ISUB (_.ISTORE 1)) + update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE 0)) failureI (|>> _.NULL _.ARETURN) - return-datumI (|>> (_.ALOAD +0) datumI _.ARETURN)]) + return-datumI (|>> (_.ALOAD 0) datumI _.ARETURN)]) (|>> (_.label @begin) - (_.ILOAD +1) ## tag - (_.ALOAD +0) tagI ## tag, sumT + (_.ILOAD 1) ## tag + (_.ALOAD 0) tagI ## tag, sumT _.DUP2 (_.IF_ICMPEQ @then) _.DUP2 (_.IF_ICMPGT @further) _.DUP2 (_.IF_ICMPLT @shorten) ## _.POP2 failureI (_.label @then) ## tag, sumT - (_.ALOAD +2) ## tag, sumT, wants-last? - (_.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? + (_.ALOAD 2) ## tag, sumT, wants-last? + (_.ALOAD 0) flagI ## tag, sumT, wants-last?, is-last? (_.IF_ACMPEQ @just-return) ## tag, sumT (_.label @further) ## tag, sumT - (_.ALOAD +0) flagI ## tag, sumT, last? + (_.ALOAD 0) flagI ## tag, sumT, last? (_.IFNULL @wrong) ## tag, sumT update-tagI update-variantI @@ -291,7 +291,7 @@ ## _.POP2 return-datumI (_.label @shorten) ## tag, sumT - (_.ALOAD +2) (_.IFNULL @wrong) + (_.ALOAD 2) (_.IFNULL @wrong) ## _.POP2 shortenI (_.label @wrong) ## tag, sumT @@ -306,8 +306,8 @@ expected-last-sizeI _.DUP2 (_.IF_ICMPGT @not-recursive) ## Recursive - updated-idxI (_.ISTORE +1) - tuple-tailI (_.ASTORE +0) + updated-idxI (_.ISTORE 1) + tuple-tailI (_.ASTORE 0) (_.GOTO @begin) (_.label @not-recursive) ## _.POP2 @@ -317,8 +317,8 @@ (<| _.with-label (function (_ @begin)) _.with-label (function (_ @tail)) _.with-label (function (_ @slice)) - (let [updated-idxI (|>> (_.ILOAD +1) (_.int 1) _.IADD tuple-sizeI _.ISUB) - sliceI (|>> (_.ALOAD +0) (_.ILOAD +1) tuple-sizeI + (let [updated-idxI (|>> (_.ILOAD 1) (_.int +1) _.IADD tuple-sizeI _.ISUB) + sliceI (|>> (_.ALOAD 0) (_.ILOAD 1) tuple-sizeI (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) #0))]) (|>> (_.label @begin) tuple-sizeI @@ -326,8 +326,8 @@ _.DUP2 (_.IF_ICMPEQ @tail) (_.IF_ICMPGT @slice) ## Must recurse - tuple-tailI (_.ASTORE +0) - updated-idxI (_.ISTORE +1) + tuple-tailI (_.ASTORE 0) + updated-idxI (_.ISTORE 1) (_.GOTO @begin) (_.label @slice) sliceI @@ -357,9 +357,9 @@ _.with-label (function (_ @handler)) (|>> (_.try @from @to @handler "java.lang.Throwable") (_.label @from) - (_.ALOAD +0) + (_.ALOAD 0) _.NULL - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) rightI _.ARETURN (_.label @to) @@ -405,21 +405,21 @@ _.RETURN))) ($d.method #$.Public $.staticM "schedule" ($t.method (list $t.long $Function) (#.Some $Object) (list)) - (let [delayI (_.LLOAD +0) + (let [delayI (_.LLOAD 0) immediacy-checkI (|>> delayI - (_.long 0) + (_.long +0) _.LCMP) time-unit-class "java.util.concurrent.TimeUnit" time-unitT ($t.class time-unit-class (list)) futureT ($t.class "java.util.concurrent.ScheduledFuture" (list)) executorI (_.GETSTATIC //.runtime-class executor-field executorT) schedule-laterI (|>> executorI - (runnableI (_.ALOAD +2)) + (runnableI (_.ALOAD 2)) delayI (_.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) (_.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) schedule-immediatelyI (|>> executorI - (runnableI (_.ALOAD +2)) + (runnableI (_.ALOAD 2)) (_.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] (<| _.with-label (function (_ @immediately)) (|>> immediacy-checkI @@ -446,27 +446,27 @@ (def: translate-function (Operation ByteCode) - (let [applyI (|> (list.n/range +2 num-apply-variants) + (let [applyI (|> (list.n/range 2 num-apply-variants) (list/map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) - (let [preI (|> (list.n/range +0 (dec arity)) + (let [preI (|> (list.n/range 0 (dec arity)) (list/map _.ALOAD) _.fuse)] (|>> preI (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) (_.CHECKCAST //.function-class) (_.ALOAD arity) - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) _.ARETURN))))) - (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1))) + (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1))) $d.fuse) bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list) (|>> ($d.field #$.Public $.finalF partials-field $t.int) ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list)) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) - (_.ALOAD +0) - (_.ILOAD +1) + (_.ALOAD 0) + (_.ILOAD 1) (_.PUTFIELD //.function-class partials-field $t.int) _.RETURN)) applyI))] @@ -480,17 +480,17 @@ bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runnable-class (list) ["java.lang.Object" (list)] (list ["java.lang.Runnable" (list)]) (|>> ($d.field #$.Public $.finalF procedure-field $Function) ($d.method #$.Public $.noneM "<init>" ($t.method (list $Function) #.None (list)) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) - (_.ALOAD +0) - (_.ALOAD +1) + (_.ALOAD 0) + (_.ALOAD 1) (_.PUTFIELD //.runnable-class procedure-field $Function) _.RETURN)) ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list)) - (|>> (_.ALOAD +0) + (|>> (_.ALOAD 0) (_.GETFIELD //.runnable-class procedure-field $Function) _.NULL - (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature 1) #0) _.RETURN)) ))] (do phase.Monad<Operation> diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux index 5abf85c05..14208903c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux @@ -18,8 +18,7 @@ ["&." scope] ["&." module] [".L" host])) - (// [".T" eval] - [".T" common] + (// [".T" common] [".T" runtime])) (do-template [<name>] diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux index 4c29260f5..040c4dd59 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -31,7 +31,7 @@ (do phase.Monad<Operation> [#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]) @@ -62,6 +62,6 @@ (_.INVOKESTATIC //.runtime-class "variant_make" ($t.method (list $t.int $Object $Object) - (#.Some ($t.array +1 $Object)) + (#.Some ($t.array 1 $Object)) (list)) #0))))) diff --git a/new-luxc/source/luxc/repl.lux b/new-luxc/source/luxc/repl.lux index df046700c..e8da16ae1 100644 --- a/new-luxc/source/luxc/repl.lux +++ b/new-luxc/source/luxc/repl.lux @@ -1,33 +1,42 @@ (.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - ["e" error #+ Error] - [text "text/" Equivalence<Text>] - text/format - (coll (dictionary ["dict" unordered]))) - [macro] - (lang [syntax #+ Aliases] - (type [check]) - [".L" init] - [".L" module] - [".L" scope] - [".L" extension] - (extension [".E" analysis])) - (concurrency [promise] - [task #+ Task]) - [io] - (world [file #+ File] - [console #+ Console])) - (luxc [lang] - (lang [".L" host] - [".L" translation] - [".L" eval] - (translation (jvm [".T" runtime])) - (extension [".E" synthesis] - [".E" translation] - [".E" statement])))) + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." maybe] + ["e" error (#+ Error)] + [text ("text/" Equivalence<Text>) + format] + [collection + ["." dictionary]]] + ["." macro] + [type + ["." check]] + [language + [syntax (#+ Aliases)] + [".L" init] + [".L" module] + [".L" scope] + [".L" extension + [".E" analysis]]] + [concurrency + ["." promise] + [task (#+ Task)]] + ["." io] + [world + [file (#+ File)] + [console (#+ Console)]]] + [// + ["." lang + [".L" host] + [".L" translation + [jvm + [".T" runtime]]] + [extension + [".E" synthesis] + [".E" translation] + [".E" statement]]]]) (do-template [<name>] [(exception: #export (<name> {message Text}) @@ -39,7 +48,7 @@ (def: repl-module "<REPL>") -(def: no-aliases Aliases (dict.new text.Hash<Text>)) +(def: no-aliases Aliases (dictionary.new text.Hash<Text>)) (def: (initialize source-dirs target-dir console) (-> (List File) File Console (Task Lux)) @@ -48,7 +57,7 @@ (do io.Monad<IO> [host hostL.init-host] (case (macro.run' (initL.compiler host) - (moduleL.with-module +0 repl-module + (moduleL.with-module 0 repl-module runtimeT.translate)) (#e.Success [compiler _]) (|> compiler @@ -99,7 +108,7 @@ compiler) (#e.Error error))))) -(def: fresh-source Source [[repl-module +1 +0] +0 ""]) +(def: fresh-source Source [[repl-module 1 0] 0 ""]) (def: #export (run source-dirs target-dir) (-> (List File) File (Task Any)) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index bc5f65e5d..62c3ad03d 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -1,17 +1,25 @@ (.module: - lux - (lux (control [monad #+ do] - ["p" parser]) - (concurrency [promise #+ Promise] - [task #+ Task]) - (data ["e" error] - text/format) - [io #- run] - (time [instant]) - [cli #+ program: CLI] - (world [file #+ File])) - (luxc [repl] - (lang [".L" translation]))) + [lux #* + [control + [monad (#+ do)] + ["p" parser]] + [concurrency + ["." promise (#+ Promise)] + [task (#+ Task)]] + [data + ["e" error] + [text + format]] + ["." io (#- run)] + [time + ["." instant]] + ["." cli (#+ CLI program:)] + [world + [file (#+ File)]]] + [luxc + ["." repl] + [lang + [".L" translation]]]) (type: Build {#build-sources (List File) @@ -46,8 +54,8 @@ (def: service (CLI Service) - (p.alt (p.after (cli.this "build") build) - (p.after (cli.this "repl") repl))) + (p.or (p.after (cli.this "build") build) + (p.after (cli.this "repl") repl))) (def: (or-crash! failure-describer action) (All [a] (-> Text (Task a) (Promise a))) |