aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.lux239
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.lux72
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/expression.lux72
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension.lux16
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension/common.lux388
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/extension/host.lux1047
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.lux331
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/loop.lux81
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.lux30
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/program.lux82
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/reference.lux65
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.lux387
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.lux79
13 files changed, 0 insertions, 2889 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux
deleted file mode 100644
index 0d8aaa91e..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/case.lux
+++ /dev/null
@@ -1,239 +0,0 @@
-(.module:
- [lux (#- Type if let case)
- [abstract
- [monad (#+ do)]]
- [control
- ["." function]
- ["ex" exception (#+ exception:)]]
- [data
- [number
- ["n" nat]]]
- [target
- [jvm
- ["." type (#+ Type)
- ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
- ["." descriptor (#+ Descriptor)]
- ["." signature (#+ Signature)]]]]
- [tool
- [compiler
- ["." phase ("operation@." monad)]
- [meta
- [archive (#+ Archive)]]
- [language
- [lux
- ["." synthesis (#+ Path Synthesis)]]]]]]
- [luxc
- [lang
- [host
- ["$" jvm (#+ Label Inst Operation Phase Generator)
- ["_" inst]]]]]
- ["." //
- ["." runtime]])
-
-(def: (pop-altI stack-depth)
- (-> Nat Inst)
- (.case stack-depth
- 0 function.identity
- 1 _.POP
- 2 _.POP2
- _ ## (n.> 2)
- (|>> _.POP2
- (pop-altI (n.- 2 stack-depth)))))
-
-(def: peekI
- Inst
- (|>> _.DUP
- (_.int +0)
- _.AALOAD))
-
-(def: pushI
- Inst
- (_.INVOKESTATIC //.$Runtime "pm_push" (type.method [(list runtime.$Stack //.$Value) runtime.$Stack (list)])))
-
-(def: popI
- (|>> (_.int +1)
- _.AALOAD
- (_.CHECKCAST runtime.$Stack)))
-
-(def: (path' stack-depth @else @end phase archive path)
- (-> Nat Label Label Phase Archive Path (Operation Inst))
- (.case path
- #synthesis.Pop
- (operation@wrap ..popI)
-
- (#synthesis.Bind register)
- (operation@wrap (|>> peekI
- (_.ASTORE register)))
-
- (^ (synthesis.path/bit value))
- (operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)]
- (|>> peekI
- (_.unwrap type.boolean)
- (jumpI @else))))
-
- (^ (synthesis.path/i64 value))
- (operation@wrap (|>> peekI
- (_.unwrap type.long)
- (_.long (.int value))
- _.LCMP
- (_.IFNE @else)))
-
- (^ (synthesis.path/f64 value))
- (operation@wrap (|>> peekI
- (_.unwrap type.double)
- (_.double value)
- _.DCMPL
- (_.IFNE @else)))
-
- (^ (synthesis.path/text value))
- (operation@wrap (|>> peekI
- (_.string value)
- (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list))
- "equals"
- (type.method [(list //.$Value) type.boolean (list)]))
- (_.IFEQ @else)))
-
- (#synthesis.Then bodyS)
- (do phase.monad
- [bodyI (phase archive bodyS)]
- (wrap (|>> (pop-altI stack-depth)
- bodyI
- (_.GOTO @end))))
-
- (^template [<pattern> <flag> <prepare>]
- (^ (<pattern> idx))
- (operation@wrap (<| _.with-label (function (_ @success))
- _.with-label (function (_ @fail))
- (|>> peekI
- (_.CHECKCAST //.$Variant)
- (_.int (.int (<prepare> idx)))
- <flag>
- (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)]))
- _.DUP
- (_.IFNULL @fail)
- (_.GOTO @success)
- (_.label @fail)
- _.POP
- (_.GOTO @else)
- (_.label @success)
- pushI))))
- ([synthesis.side/left _.NULL function.identity]
- [synthesis.side/right (_.string "") .inc])
-
- (^ (synthesis.member/left lefts))
- (operation@wrap (.let [accessI (.case lefts
- 0
- _.AALOAD
-
- lefts
- (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))]
- (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
- accessI
- pushI)))
-
- (^ (synthesis.member/right lefts))
- (operation@wrap (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
- (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))
- pushI))
-
- ## Extra optimization
- (^ (synthesis.path/seq
- (synthesis.member/left 0)
- (synthesis.!bind-top register thenP)))
- (do phase.monad
- [then! (path' stack-depth @else @end phase archive thenP)]
- (wrap (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int +0)
- _.AALOAD
- (_.ASTORE register)
- then!)))
-
- ## Extra optimization
- (^template [<pm> <getter>]
- (^ (synthesis.path/seq
- (<pm> lefts)
- (synthesis.!bind-top register thenP)))
- (do phase.monad
- [then! (path' stack-depth @else @end phase archive thenP)]
- (wrap (|>> peekI
- (_.CHECKCAST //.$Tuple)
- (_.int (.int lefts))
- (_.INVOKESTATIC //.$Runtime <getter> (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))
- (_.ASTORE register)
- then!))))
- ([synthesis.member/left "tuple_left"]
- [synthesis.member/right "tuple_right"])
-
- (#synthesis.Alt leftP rightP)
- (do phase.monad
- [@alt-else _.make-label
- leftI (path' (inc stack-depth) @alt-else @end phase archive leftP)
- rightI (path' stack-depth @else @end phase archive rightP)]
- (wrap (|>> _.DUP
- leftI
- (_.label @alt-else)
- _.POP
- rightI)))
-
- (#synthesis.Seq leftP rightP)
- (do phase.monad
- [leftI (path' stack-depth @else @end phase archive leftP)
- rightI (path' stack-depth @else @end phase archive rightP)]
- (wrap (|>> leftI
- rightI)))
- ))
-
-(def: (path @end phase archive path)
- (-> Label Phase Archive Path (Operation Inst))
- (do phase.monad
- [@else _.make-label
- pathI (..path' 1 @else @end phase archive path)]
- (wrap (|>> pathI
- (_.label @else)
- _.POP
- (_.INVOKESTATIC //.$Runtime "pm_fail" (type.method [(list) type.void (list)]))
- _.NULL
- (_.GOTO @end)))))
-
-(def: #export (if phase archive [testS thenS elseS])
- (Generator [Synthesis Synthesis Synthesis])
- (do phase.monad
- [testI (phase archive testS)
- thenI (phase archive thenS)
- elseI (phase archive elseS)]
- (wrap (<| _.with-label (function (_ @else))
- _.with-label (function (_ @end))
- (|>> testI
- (_.unwrap type.boolean)
- (_.IFEQ @else)
- thenI
- (_.GOTO @end)
- (_.label @else)
- elseI
- (_.label @end))))))
-
-(def: #export (let phase archive [inputS register exprS])
- (Generator [Synthesis Nat Synthesis])
- (do phase.monad
- [inputI (phase archive inputS)
- exprI (phase archive exprS)]
- (wrap (|>> inputI
- (_.ASTORE register)
- exprI))))
-
-(def: #export (case phase archive [valueS path])
- (Generator [Synthesis Path])
- (do phase.monad
- [@end _.make-label
- valueI (phase archive valueS)
- pathI (..path @end phase archive path)]
- (wrap (|>> _.NULL
- valueI
- pushI
- pathI
- (_.label @end)))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.lux b/new-luxc/source/luxc/lang/translation/jvm/common.lux
deleted file mode 100644
index 6cd7f4f2f..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/common.lux
+++ /dev/null
@@ -1,72 +0,0 @@
-(.module:
- [lux #*
- ## [abstract
- ## [monad (#+ do)]]
- ## [control
- ## ["." try (#+ Try)]
- ## ["ex" exception (#+ exception:)]
- ## ["." io]]
- ## [data
- ## [binary (#+ Binary)]
- ## ["." text ("#/." hash)
- ## format]
- ## [collection
- ## ["." dictionary (#+ Dictionary)]]]
- ## ["." macro]
- ## [host (#+ import:)]
- ## [tool
- ## [compiler
- ## [reference (#+ Register)]
- ## ["." name]
- ## ["." phase]]]
- ]
- ## [luxc
- ## [lang
- ## [host
- ## ["." jvm
- ## [type]]]]]
- )
-
-## (def: #export (with-artifacts action)
-## (All [a] (-> (Meta a) (Meta [Artifacts a])))
-## (function (_ state)
-## (case (action (update@ #.host
-## (|>> (:coerce Host)
-## (set@ #artifacts (dictionary.new text.hash))
-## (:coerce Nothing))
-## state))
-## (#try.Success [state' output])
-## (#try.Success [(update@ #.host
-## (|>> (:coerce Host)
-## (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts)))
-## (:coerce Nothing))
-## state')
-## [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts))
-## output]])
-
-## (#try.Failure error)
-## (#try.Failure error))))
-
-## (def: #export (load-definition state)
-## (-> Lux (-> Name Binary (Try Any)))
-## (function (_ (^@ def-name [def-module def-name]) def-bytecode)
-## (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name)))
-## class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
-## (<| (macro.run state)
-## (do macro.monad
-## [_ (..store-class class-name def-bytecode)
-## class (..load-class class-name)]
-## (case (do try.monad
-## [field (Class::getField [..value-field] class)]
-## (Field::get [#.None] field))
-## (#try.Success (#.Some def-value))
-## (wrap def-value)
-
-## (#try.Success #.None)
-## (phase.throw invalid-definition-value (%name def-name))
-
-## (#try.Failure error)
-## (phase.throw cannot-load-definition
-## (format "Definition: " (%name def-name) "\n"
-## "Error:\n"
-## error))))))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.lux
deleted file mode 100644
index 144e35f9b..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/expression.lux
+++ /dev/null
@@ -1,72 +0,0 @@
-(.module:
- [lux #*
- [tool
- [compiler
- [language
- [lux
- ["." synthesis]
- [phase
- ["." extension]]]]]]]
- [luxc
- [lang
- [host
- [jvm (#+ Phase)]]]]
- [//
- ["." common]
- ["." primitive]
- ["." structure]
- ["." reference]
- ["." case]
- ["." loop]
- ["." function]])
-
-(def: #export (translate archive synthesis)
- Phase
- (case synthesis
- (^ (synthesis.bit value))
- (primitive.bit value)
-
- (^ (synthesis.i64 value))
- (primitive.i64 value)
-
- (^ (synthesis.f64 value))
- (primitive.f64 value)
-
- (^ (synthesis.text value))
- (primitive.text value)
-
- (^ (synthesis.variant data))
- (structure.variant translate archive data)
-
- (^ (synthesis.tuple members))
- (structure.tuple translate archive members)
-
- (^ (synthesis.variable variable))
- (reference.variable archive variable)
-
- (^ (synthesis.constant constant))
- (reference.constant archive constant)
-
- (^ (synthesis.branch/let data))
- (case.let translate archive data)
-
- (^ (synthesis.branch/if data))
- (case.if translate archive data)
-
- (^ (synthesis.branch/case data))
- (case.case translate archive data)
-
- (^ (synthesis.loop/recur data))
- (loop.recur translate archive data)
-
- (^ (synthesis.loop/scope data))
- (loop.scope translate archive data)
-
- (^ (synthesis.function/apply data))
- (function.call translate archive data)
-
- (^ (synthesis.function/abstraction data))
- (function.function translate archive data)
-
- (#synthesis.Extension extension)
- (extension.apply archive translate extension)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension.lux b/new-luxc/source/luxc/lang/translation/jvm/extension.lux
deleted file mode 100644
index 9066dd156..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension.lux
+++ /dev/null
@@ -1,16 +0,0 @@
-(.module:
- [lux #*
- [data
- [collection
- ["." dictionary]]]]
- [////
- [host
- [jvm (#+ Bundle)]]]
- ["." / #_
- ["#." common]
- ["#." host]])
-
-(def: #export bundle
- Bundle
- (dictionary.merge /common.bundle
- /host.bundle))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
deleted file mode 100644
index 383415c0a..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
+++ /dev/null
@@ -1,388 +0,0 @@
-(.module:
- [lux (#- Type)
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." try]
- ["<>" parser
- ["<s>" synthesis (#+ Parser)]]]
- [data
- ["." product]
- [number
- ["f" frac]]
- [collection
- ["." list ("#@." monad)]
- ["." dictionary]]]
- [target
- [jvm
- ["." type]]]
- [tool
- [compiler
- ["." phase]
- [meta
- [archive (#+ Archive)]]
- [language
- [lux
- ["." synthesis (#+ Synthesis %synthesis)]
- [phase
- [generation
- [extension (#+ Nullary Unary Binary Trinary Variadic
- nullary unary binary trinary variadic)]]
- ["." extension
- ["." bundle]]]]]]]
- [host (#+ import:)]]
- [luxc
- [lang
- [host
- ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
- ["_" inst]]]]]
- ["." ///
- ["." runtime]])
-
-(def: #export (custom [parser handler])
- (All [s]
- (-> [(Parser s)
- (-> Text Phase Archive s (Operation Inst))]
- Handler))
- (function (_ extension-name phase archive input)
- (case (<s>.run parser input)
- (#try.Success input')
- (handler extension-name phase archive input')
-
- (#try.Failure error)
- (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
-
-(import: java/lang/Double
- (#static MIN_VALUE Double)
- (#static MAX_VALUE Double))
-
-(def: $String (type.class "java.lang.String" (list)))
-(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
-(def: $System (type.class "java.lang.System" (list)))
-(def: $Object (type.class "java.lang.Object" (list)))
-
-(def: lux-intI Inst (|>> _.I2L (_.wrap type.long)))
-(def: jvm-intI Inst (|>> (_.unwrap type.long) _.L2I))
-(def: check-stringI Inst (_.CHECKCAST $String))
-
-(def: (predicateI tester)
- (-> (-> Label Inst)
- Inst)
- (let [$Boolean (type.class "java.lang.Boolean" (list))]
- (<| _.with-label (function (_ @then))
- _.with-label (function (_ @end))
- (|>> (tester @then)
- (_.GETSTATIC $Boolean "FALSE" $Boolean)
- (_.GOTO @end)
- (_.label @then)
- (_.GETSTATIC $Boolean "TRUE" $Boolean)
- (_.label @end)
- ))))
-
-(def: unitI Inst (_.string synthesis.unit))
-
-## TODO: Get rid of this ASAP
-(def: lux::syntax-char-case!
- (..custom [($_ <>.and
- <s>.any
- <s>.any
- (<>.some (<s>.tuple ($_ <>.and
- (<s>.tuple (<>.many <s>.i64))
- <s>.any))))
- (function (_ extension-name phase archive [input else conditionals])
- (<| _.with-label (function (_ @end))
- _.with-label (function (_ @else))
- (do {@ phase.monad}
- [inputG (phase archive input)
- elseG (phase archive else)
- conditionalsG+ (: (Operation (List [(List [Int Label])
- Inst]))
- (monad.map @ (function (_ [chars branch])
- (do @
- [branchG (phase archive branch)]
- (wrap (<| _.with-label (function (_ @branch))
- [(list@map (function (_ char)
- [(.int char) @branch])
- chars)
- (|>> (_.label @branch)
- branchG
- (_.GOTO @end))]))))
- conditionals))
- #let [table (|> conditionalsG+
- (list@map product.left)
- list@join)
- conditionalsG (|> conditionalsG+
- (list@map product.right)
- _.fuse)]]
- (wrap (|>> inputG (_.unwrap type.long) _.L2I
- (_.LOOKUPSWITCH @else table)
- conditionalsG
- (_.label @else)
- elseG
- (_.label @end)
- )))))]))
-
-(def: (lux::is [referenceI sampleI])
- (Binary Inst)
- (|>> referenceI
- sampleI
- (predicateI _.IF_ACMPEQ)))
-
-(def: (lux::try riskyI)
- (Unary Inst)
- (|>> riskyI
- (_.CHECKCAST ///.$Function)
- (_.INVOKESTATIC ///.$Runtime "try" runtime.try)))
-
-(template [<name> <op>]
- [(def: (<name> [maskI inputI])
- (Binary Inst)
- (|>> inputI (_.unwrap type.long)
- maskI (_.unwrap type.long)
- <op> (_.wrap type.long)))]
-
- [i64::and _.LAND]
- [i64::or _.LOR]
- [i64::xor _.LXOR]
- )
-
-(template [<name> <op>]
- [(def: (<name> [shiftI inputI])
- (Binary Inst)
- (|>> inputI (_.unwrap type.long)
- shiftI jvm-intI
- <op>
- (_.wrap type.long)))]
-
- [i64::left-shift _.LSHL]
- [i64::arithmetic-right-shift _.LSHR]
- [i64::logical-right-shift _.LUSHR]
- )
-
-(template [<name> <const> <type>]
- [(def: (<name> _)
- (Nullary Inst)
- (|>> <const> (_.wrap <type>)))]
-
- [f64::smallest (_.double (Double::MIN_VALUE)) type.double]
- [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double]
- [f64::max (_.double (Double::MAX_VALUE)) type.double]
- )
-
-(template [<name> <type> <op>]
- [(def: (<name> [paramI subjectI])
- (Binary Inst)
- (|>> subjectI (_.unwrap <type>)
- paramI (_.unwrap <type>)
- <op>
- (_.wrap <type>)))]
-
- [i64::+ type.long _.LADD]
- [i64::- type.long _.LSUB]
- [i64::* type.long _.LMUL]
- [i64::/ type.long _.LDIV]
- [i64::% type.long _.LREM]
-
- [f64::+ type.double _.DADD]
- [f64::- type.double _.DSUB]
- [f64::* type.double _.DMUL]
- [f64::/ type.double _.DDIV]
- [f64::% type.double _.DREM]
- )
-
-(template [<eq> <lt> <type> <cmp>]
- [(template [<name> <reference>]
- [(def: (<name> [paramI subjectI])
- (Binary Inst)
- (|>> subjectI (_.unwrap <type>)
- paramI (_.unwrap <type>)
- <cmp>
- (_.int <reference>)
- (predicateI _.IF_ICMPEQ)))]
-
- [<eq> +0]
- [<lt> -1])]
-
- [i64::= i64::< type.long _.LCMP]
- [f64::= f64::< type.double _.DCMPG]
- )
-
-(template [<name> <prepare> <transform>]
- [(def: (<name> inputI)
- (Unary Inst)
- (|>> inputI <prepare> <transform>))]
-
- [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)]
- [i64::char (_.unwrap type.long)
- ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list type.char) $String (list)]))))]
-
- [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)]
- [f64::encode (_.unwrap type.double)
- (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]))]
- [f64::decode ..check-stringI
- (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))]
- )
-
-(def: (text::size inputI)
- (Unary Inst)
- (|>> inputI
- ..check-stringI
- (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)]))
- lux-intI))
-
-(template [<name> <pre-subject> <pre-param> <op> <post>]
- [(def: (<name> [paramI subjectI])
- (Binary Inst)
- (|>> subjectI <pre-subject>
- paramI <pre-param>
- <op> <post>))]
-
- [text::= (<|) (<|)
- (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)]))
- (_.wrap type.boolean)]
- [text::< ..check-stringI ..check-stringI
- (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)]))
- (predicateI _.IFLT)]
- [text::char ..check-stringI jvm-intI
- (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)]))
- lux-intI]
- )
-
-(def: (text::concat [leftI rightI])
- (Binary Inst)
- (|>> leftI ..check-stringI
- rightI ..check-stringI
- (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)]))))
-
-(def: (text::clip [startI endI subjectI])
- (Trinary Inst)
- (|>> subjectI ..check-stringI
- startI jvm-intI
- endI jvm-intI
- (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)]))))
-
-(def: index-method (type.method [(list $String type.int) type.int (list)]))
-(def: (text::index [startI partI textI])
- (Trinary Inst)
- (<| _.with-label (function (_ @not-found))
- _.with-label (function (_ @end))
- (|>> textI ..check-stringI
- partI ..check-stringI
- startI jvm-intI
- (_.INVOKEVIRTUAL $String "indexOf" index-method)
- _.DUP
- (_.int -1)
- (_.IF_ICMPEQ @not-found)
- lux-intI
- runtime.someI
- (_.GOTO @end)
- (_.label @not-found)
- _.POP
- runtime.noneI
- (_.label @end))))
-
-(def: string-method (type.method [(list $String) type.void (list)]))
-(def: (io::log messageI)
- (Unary Inst)
- (let [$PrintStream (type.class "java.io.PrintStream" (list))]
- (|>> (_.GETSTATIC $System "out" $PrintStream)
- messageI
- ..check-stringI
- (_.INVOKEVIRTUAL $PrintStream "println" string-method)
- unitI)))
-
-(def: (io::error messageI)
- (Unary Inst)
- (let [$Error (type.class "java.lang.Error" (list))]
- (|>> (_.NEW $Error)
- _.DUP
- messageI
- ..check-stringI
- (_.INVOKESPECIAL $Error "<init>" string-method)
- _.ATHROW)))
-
-(def: (io::exit codeI)
- (Unary Inst)
- (|>> codeI jvm-intI
- (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)]))
- _.NULL))
-
-(def: (io::current-time _)
- (Nullary Inst)
- (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)]))
- (_.wrap type.long)))
-
-(def: bundle::lux
- Bundle
- (|> (: Bundle bundle.empty)
- (bundle.install "syntax char case!" lux::syntax-char-case!)
- (bundle.install "is" (binary lux::is))
- (bundle.install "try" (unary lux::try))))
-
-(def: bundle::i64
- Bundle
- (<| (bundle.prefix "i64")
- (|> (: Bundle bundle.empty)
- (bundle.install "and" (binary i64::and))
- (bundle.install "or" (binary i64::or))
- (bundle.install "xor" (binary i64::xor))
- (bundle.install "left-shift" (binary i64::left-shift))
- (bundle.install "logical-right-shift" (binary i64::logical-right-shift))
- (bundle.install "arithmetic-right-shift" (binary i64::arithmetic-right-shift))
- (bundle.install "=" (binary i64::=))
- (bundle.install "<" (binary i64::<))
- (bundle.install "+" (binary i64::+))
- (bundle.install "-" (binary i64::-))
- (bundle.install "*" (binary i64::*))
- (bundle.install "/" (binary i64::/))
- (bundle.install "%" (binary i64::%))
- (bundle.install "f64" (unary i64::f64))
- (bundle.install "char" (unary i64::char)))))
-
-(def: bundle::f64
- Bundle
- (<| (bundle.prefix "f64")
- (|> (: Bundle bundle.empty)
- (bundle.install "+" (binary f64::+))
- (bundle.install "-" (binary f64::-))
- (bundle.install "*" (binary f64::*))
- (bundle.install "/" (binary f64::/))
- (bundle.install "%" (binary f64::%))
- (bundle.install "=" (binary f64::=))
- (bundle.install "<" (binary f64::<))
- (bundle.install "smallest" (nullary f64::smallest))
- (bundle.install "min" (nullary f64::min))
- (bundle.install "max" (nullary f64::max))
- (bundle.install "i64" (unary f64::i64))
- (bundle.install "encode" (unary f64::encode))
- (bundle.install "decode" (unary f64::decode)))))
-
-(def: bundle::text
- Bundle
- (<| (bundle.prefix "text")
- (|> (: Bundle bundle.empty)
- (bundle.install "=" (binary text::=))
- (bundle.install "<" (binary text::<))
- (bundle.install "concat" (binary text::concat))
- (bundle.install "index" (trinary text::index))
- (bundle.install "size" (unary text::size))
- (bundle.install "char" (binary text::char))
- (bundle.install "clip" (trinary text::clip)))))
-
-(def: bundle::io
- Bundle
- (<| (bundle.prefix "io")
- (|> (: Bundle bundle.empty)
- (bundle.install "log" (unary io::log))
- (bundle.install "error" (unary io::error))
- (bundle.install "exit" (unary io::exit))
- (bundle.install "current-time" (nullary io::current-time)))))
-
-(def: #export bundle
- Bundle
- (<| (bundle.prefix "lux")
- (|> bundle::lux
- (dictionary.merge bundle::i64)
- (dictionary.merge bundle::f64)
- (dictionary.merge bundle::text)
- (dictionary.merge bundle::io))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux
deleted file mode 100644
index 7b90a8e4f..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux
+++ /dev/null
@@ -1,1047 +0,0 @@
-(.module:
- [lux (#- Type primitive int char type)
- [host (#+ import:)]
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." exception (#+ exception:)]
- ["." function]
- ["<>" parser ("#@." monad)
- ["<t>" text]
- ["<s>" synthesis (#+ Parser)]]]
- [data
- ["." product]
- ["." maybe]
- ["." text ("#@." equivalence)
- ["%" format (#+ format)]]
- [number
- ["." nat]]
- [collection
- ["." list ("#@." monad)]
- ["." dictionary (#+ Dictionary)]
- ["." set]]]
- [target
- [jvm
- ["." type (#+ Type Typed Argument)
- ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
- ["." box]
- ["." reflection]
- ["." signature]
- ["." parser]]]]
- [tool
- [compiler
- ["." reference (#+ Variable)]
- ["." phase ("#@." monad)]
- [meta
- [archive (#+ Archive)]]
- [language
- [lux
- [analysis (#+ Environment)]
- ["." synthesis (#+ Synthesis Path %synthesis)]
- ["." generation]
- [phase
- [generation
- [extension (#+ Nullary Unary Binary
- nullary unary binary)]]
- [analysis
- [".A" reference]]
- ["." extension
- ["." bundle]
- [analysis
- ["/" jvm]]]]]]]]]
- [luxc
- [lang
- [host
- ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
- ["_" inst]
- ["_." def]]]]]
- ["." // #_
- [common (#+ custom)]
- ["/#" //
- ["#." reference]
- ["#." function]]])
-
-(template [<name> <category> <parser>]
- [(def: #export <name>
- (Parser (Type <category>))
- (<t>.embed <parser> <s>.text))]
-
- [var Var parser.var]
- [class Class parser.class]
- [object Object parser.object]
- [value Value parser.value]
- [return Return parser.return]
- )
-
-(exception: #export (not-an-object-array {arrayJT (Type Array)})
- (exception.report
- ["JVM Type" (|> arrayJT type.signature signature.signature)]))
-
-(def: #export object-array
- (Parser (Type Object))
- (do <>.monad
- [arrayJT (<t>.embed parser.array <s>.text)]
- (case (parser.array? arrayJT)
- (#.Some elementJT)
- (case (parser.object? elementJT)
- (#.Some elementJT)
- (wrap elementJT)
-
- #.None
- (<>.fail (exception.construct ..not-an-object-array arrayJT)))
-
- #.None
- (undefined))))
-
-(template [<name> <inst>]
- [(def: <name>
- Inst
- <inst>)]
-
- [L2S (|>> _.L2I _.I2S)]
- [L2B (|>> _.L2I _.I2B)]
- [L2C (|>> _.L2I _.I2C)]
- )
-
-(template [<conversion> <name>]
- [(def: (<name> inputI)
- (Unary Inst)
- (if (is? _.NOP <conversion>)
- inputI
- (|>> inputI
- <conversion>)))]
-
- [_.D2F conversion::double-to-float]
- [_.D2I conversion::double-to-int]
- [_.D2L conversion::double-to-long]
- [_.F2D conversion::float-to-double]
- [_.F2I conversion::float-to-int]
- [_.F2L conversion::float-to-long]
- [_.I2B conversion::int-to-byte]
- [_.I2C conversion::int-to-char]
- [_.I2D conversion::int-to-double]
- [_.I2F conversion::int-to-float]
- [_.I2L conversion::int-to-long]
- [_.I2S conversion::int-to-short]
- [_.L2D conversion::long-to-double]
- [_.L2F conversion::long-to-float]
- [_.L2I conversion::long-to-int]
- [..L2S conversion::long-to-short]
- [..L2B conversion::long-to-byte]
- [..L2C conversion::long-to-char]
- [_.I2B conversion::char-to-byte]
- [_.I2S conversion::char-to-short]
- [_.NOP conversion::char-to-int]
- [_.I2L conversion::char-to-long]
- [_.I2L conversion::byte-to-long]
- [_.I2L conversion::short-to-long]
- )
-
-(def: conversion
- Bundle
- (<| (bundle.prefix "conversion")
- (|> (: Bundle bundle.empty)
- (bundle.install "double-to-float" (unary conversion::double-to-float))
- (bundle.install "double-to-int" (unary conversion::double-to-int))
- (bundle.install "double-to-long" (unary conversion::double-to-long))
- (bundle.install "float-to-double" (unary conversion::float-to-double))
- (bundle.install "float-to-int" (unary conversion::float-to-int))
- (bundle.install "float-to-long" (unary conversion::float-to-long))
- (bundle.install "int-to-byte" (unary conversion::int-to-byte))
- (bundle.install "int-to-char" (unary conversion::int-to-char))
- (bundle.install "int-to-double" (unary conversion::int-to-double))
- (bundle.install "int-to-float" (unary conversion::int-to-float))
- (bundle.install "int-to-long" (unary conversion::int-to-long))
- (bundle.install "int-to-short" (unary conversion::int-to-short))
- (bundle.install "long-to-double" (unary conversion::long-to-double))
- (bundle.install "long-to-float" (unary conversion::long-to-float))
- (bundle.install "long-to-int" (unary conversion::long-to-int))
- (bundle.install "long-to-short" (unary conversion::long-to-short))
- (bundle.install "long-to-byte" (unary conversion::long-to-byte))
- (bundle.install "long-to-char" (unary conversion::long-to-char))
- (bundle.install "char-to-byte" (unary conversion::char-to-byte))
- (bundle.install "char-to-short" (unary conversion::char-to-short))
- (bundle.install "char-to-int" (unary conversion::char-to-int))
- (bundle.install "char-to-long" (unary conversion::char-to-long))
- (bundle.install "byte-to-long" (unary conversion::byte-to-long))
- (bundle.install "short-to-long" (unary conversion::short-to-long))
- )))
-
-(template [<name> <op>]
- [(def: (<name> [xI yI])
- (Binary Inst)
- (|>> xI
- yI
- <op>))]
-
- [int::+ _.IADD]
- [int::- _.ISUB]
- [int::* _.IMUL]
- [int::/ _.IDIV]
- [int::% _.IREM]
- [int::and _.IAND]
- [int::or _.IOR]
- [int::xor _.IXOR]
- [int::shl _.ISHL]
- [int::shr _.ISHR]
- [int::ushr _.IUSHR]
-
- [long::+ _.LADD]
- [long::- _.LSUB]
- [long::* _.LMUL]
- [long::/ _.LDIV]
- [long::% _.LREM]
- [long::and _.LAND]
- [long::or _.LOR]
- [long::xor _.LXOR]
- [long::shl _.LSHL]
- [long::shr _.LSHR]
- [long::ushr _.LUSHR]
-
- [float::+ _.FADD]
- [float::- _.FSUB]
- [float::* _.FMUL]
- [float::/ _.FDIV]
- [float::% _.FREM]
-
- [double::+ _.DADD]
- [double::- _.DSUB]
- [double::* _.DMUL]
- [double::/ _.DDIV]
- [double::% _.DREM]
- )
-
-(def: $Boolean (type.class box.boolean (list)))
-(def: falseI (_.GETSTATIC $Boolean "FALSE" $Boolean))
-(def: trueI (_.GETSTATIC $Boolean "TRUE" $Boolean))
-
-(template [<name> <op>]
- [(def: (<name> [xI yI])
- (Binary Inst)
- (<| _.with-label (function (_ @then))
- _.with-label (function (_ @end))
- (|>> xI
- yI
- (<op> @then)
- falseI
- (_.GOTO @end)
- (_.label @then)
- trueI
- (_.label @end))))]
-
- [int::= _.IF_ICMPEQ]
- [int::< _.IF_ICMPLT]
-
- [char::= _.IF_ICMPEQ]
- [char::< _.IF_ICMPLT]
- )
-
-(template [<name> <op> <reference>]
- [(def: (<name> [xI yI])
- (Binary Inst)
- (<| _.with-label (function (_ @then))
- _.with-label (function (_ @end))
- (|>> xI
- yI
- <op>
- (_.int <reference>)
- (_.IF_ICMPEQ @then)
- falseI
- (_.GOTO @end)
- (_.label @then)
- trueI
- (_.label @end))))]
-
- [long::= _.LCMP +0]
- [long::< _.LCMP -1]
-
- [float::= _.FCMPG +0]
- [float::< _.FCMPG -1]
-
- [double::= _.DCMPG +0]
- [double::< _.DCMPG -1]
- )
-
-(def: int
- Bundle
- (<| (bundle.prefix (reflection.reflection reflection.int))
- (|> (: Bundle bundle.empty)
- (bundle.install "+" (binary int::+))
- (bundle.install "-" (binary int::-))
- (bundle.install "*" (binary int::*))
- (bundle.install "/" (binary int::/))
- (bundle.install "%" (binary int::%))
- (bundle.install "=" (binary int::=))
- (bundle.install "<" (binary int::<))
- (bundle.install "and" (binary int::and))
- (bundle.install "or" (binary int::or))
- (bundle.install "xor" (binary int::xor))
- (bundle.install "shl" (binary int::shl))
- (bundle.install "shr" (binary int::shr))
- (bundle.install "ushr" (binary int::ushr))
- )))
-
-(def: long
- Bundle
- (<| (bundle.prefix (reflection.reflection reflection.long))
- (|> (: Bundle bundle.empty)
- (bundle.install "+" (binary long::+))
- (bundle.install "-" (binary long::-))
- (bundle.install "*" (binary long::*))
- (bundle.install "/" (binary long::/))
- (bundle.install "%" (binary long::%))
- (bundle.install "=" (binary long::=))
- (bundle.install "<" (binary long::<))
- (bundle.install "and" (binary long::and))
- (bundle.install "or" (binary long::or))
- (bundle.install "xor" (binary long::xor))
- (bundle.install "shl" (binary long::shl))
- (bundle.install "shr" (binary long::shr))
- (bundle.install "ushr" (binary long::ushr))
- )))
-
-(def: float
- Bundle
- (<| (bundle.prefix (reflection.reflection reflection.float))
- (|> (: Bundle bundle.empty)
- (bundle.install "+" (binary float::+))
- (bundle.install "-" (binary float::-))
- (bundle.install "*" (binary float::*))
- (bundle.install "/" (binary float::/))
- (bundle.install "%" (binary float::%))
- (bundle.install "=" (binary float::=))
- (bundle.install "<" (binary float::<))
- )))
-
-(def: double
- Bundle
- (<| (bundle.prefix (reflection.reflection reflection.double))
- (|> (: Bundle bundle.empty)
- (bundle.install "+" (binary double::+))
- (bundle.install "-" (binary double::-))
- (bundle.install "*" (binary double::*))
- (bundle.install "/" (binary double::/))
- (bundle.install "%" (binary double::%))
- (bundle.install "=" (binary double::=))
- (bundle.install "<" (binary double::<))
- )))
-
-(def: char
- Bundle
- (<| (bundle.prefix (reflection.reflection reflection.char))
- (|> (: Bundle bundle.empty)
- (bundle.install "=" (binary char::=))
- (bundle.install "<" (binary char::<))
- )))
-
-(def: (primitive-array-length-handler jvm-primitive)
- (-> (Type Primitive) Handler)
- (..custom
- [<s>.any
- (function (_ extension-name generate archive arrayS)
- (do phase.monad
- [arrayI (generate archive arrayS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array jvm-primitive))
- _.ARRAYLENGTH))))]))
-
-(def: array::length::object
- Handler
- (..custom
- [($_ <>.and ..object-array <s>.any)
- (function (_ extension-name generate archive [elementJT arrayS])
- (do phase.monad
- [arrayI (generate archive arrayS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array elementJT))
- _.ARRAYLENGTH))))]))
-
-(def: (new-primitive-array-handler jvm-primitive)
- (-> (Type Primitive) Handler)
- (function (_ extension-name generate archive inputs)
- (case inputs
- (^ (list lengthS))
- (do phase.monad
- [lengthI (generate archive lengthS)]
- (wrap (|>> lengthI
- (_.array jvm-primitive))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
-
-(def: array::new::object
- Handler
- (..custom
- [($_ <>.and ..object <s>.any)
- (function (_ extension-name generate archive [objectJT lengthS])
- (do phase.monad
- [lengthI (generate archive lengthS)]
- (wrap (|>> lengthI
- (_.ANEWARRAY objectJT)))))]))
-
-(def: (read-primitive-array-handler jvm-primitive loadI)
- (-> (Type Primitive) Inst Handler)
- (function (_ extension-name generate archive inputs)
- (case inputs
- (^ (list idxS arrayS))
- (do phase.monad
- [arrayI (generate archive arrayS)
- idxI (generate archive idxS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array jvm-primitive))
- idxI
- loadI)))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
-
-(def: array::read::object
- Handler
- (..custom
- [($_ <>.and ..object-array <s>.any <s>.any)
- (function (_ extension-name generate archive [elementJT idxS arrayS])
- (do phase.monad
- [arrayI (generate archive arrayS)
- idxI (generate archive idxS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array elementJT))
- idxI
- _.AALOAD))))]))
-
-(def: (write-primitive-array-handler jvm-primitive storeI)
- (-> (Type Primitive) Inst Handler)
- (function (_ extension-name generate archive inputs)
- (case inputs
- (^ (list idxS valueS arrayS))
- (do phase.monad
- [arrayI (generate archive arrayS)
- idxI (generate archive idxS)
- valueI (generate archive valueS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array jvm-primitive))
- _.DUP
- idxI
- valueI
- storeI)))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
-
-(def: array::write::object
- Handler
- (..custom
- [($_ <>.and ..object-array <s>.any <s>.any <s>.any)
- (function (_ extension-name generate archive [elementJT idxS valueS arrayS])
- (do phase.monad
- [arrayI (generate archive arrayS)
- idxI (generate archive idxS)
- valueI (generate archive valueS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array elementJT))
- _.DUP
- idxI
- valueI
- _.AASTORE))))]))
-
-(def: array
- Bundle
- (<| (bundle.prefix "array")
- (|> bundle.empty
- (dictionary.merge (<| (bundle.prefix "length")
- (|> bundle.empty
- (bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean))
- (bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte))
- (bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short))
- (bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int))
- (bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long))
- (bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float))
- (bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double))
- (bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char))
- (bundle.install "object" array::length::object))))
- (dictionary.merge (<| (bundle.prefix "new")
- (|> bundle.empty
- (bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler type.boolean))
- (bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler type.byte))
- (bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler type.short))
- (bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler type.int))
- (bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler type.long))
- (bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler type.float))
- (bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler type.double))
- (bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler type.char))
- (bundle.install "object" array::new::object))))
- (dictionary.merge (<| (bundle.prefix "read")
- (|> bundle.empty
- (bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.BALOAD))
- (bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.BALOAD))
- (bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.SALOAD))
- (bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.IALOAD))
- (bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.LALOAD))
- (bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.FALOAD))
- (bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.DALOAD))
- (bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.CALOAD))
- (bundle.install "object" array::read::object))))
- (dictionary.merge (<| (bundle.prefix "write")
- (|> bundle.empty
- (bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.BASTORE))
- (bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.BASTORE))
- (bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.SASTORE))
- (bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.IASTORE))
- (bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.LASTORE))
- (bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.FASTORE))
- (bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.DASTORE))
- (bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.CASTORE))
- (bundle.install "object" array::write::object))))
- )))
-
-(def: (object::null _)
- (Nullary Inst)
- _.NULL)
-
-(def: (object::null? objectI)
- (Unary Inst)
- (<| _.with-label (function (_ @then))
- _.with-label (function (_ @end))
- (|>> objectI
- (_.IFNULL @then)
- falseI
- (_.GOTO @end)
- (_.label @then)
- trueI
- (_.label @end))))
-
-(def: (object::synchronized [monitorI exprI])
- (Binary Inst)
- (|>> monitorI
- _.DUP
- _.MONITORENTER
- exprI
- _.SWAP
- _.MONITOREXIT))
-
-(def: (object::throw exceptionI)
- (Unary Inst)
- (|>> exceptionI
- _.ATHROW))
-
-(def: $Class (type.class "java.lang.Class" (list)))
-
-(def: (object::class extension-name generate archive inputs)
- Handler
- (case inputs
- (^ (list (synthesis.text class)))
- (do phase.monad
- []
- (wrap (|>> (_.string class)
- (_.INVOKESTATIC $Class "forName" (type.method [(list (type.class "java.lang.String" (list))) $Class (list)])))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-
-(def: object::instance?
- Handler
- (..custom
- [($_ <>.and <s>.text <s>.any)
- (function (_ extension-name generate archive [class objectS])
- (do phase.monad
- [objectI (generate archive objectS)]
- (wrap (|>> objectI
- (_.INSTANCEOF (type.class class (list)))
- (_.wrap type.boolean)))))]))
-
-(def: (object::cast extension-name generate archive inputs)
- Handler
- (case inputs
- (^ (list (synthesis.text from) (synthesis.text to) valueS))
- (do phase.monad
- [valueI (generate archive valueS)]
- (`` (cond (~~ (template [<object> <type>]
- [(and (text@= (reflection.reflection (type.reflection <type>))
- from)
- (text@= <object>
- to))
- (wrap (|>> valueI (_.wrap <type>)))
-
- (and (text@= <object>
- from)
- (text@= (reflection.reflection (type.reflection <type>))
- to))
- (wrap (|>> valueI (_.unwrap <type>)))]
-
- [box.boolean type.boolean]
- [box.byte type.byte]
- [box.short type.short]
- [box.int type.int]
- [box.long type.long]
- [box.float type.float]
- [box.double type.double]
- [box.char type.char]))
- ## else
- (wrap valueI))))
-
- _
- (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-
-(def: object-bundle
- Bundle
- (<| (bundle.prefix "object")
- (|> (: Bundle bundle.empty)
- (bundle.install "null" (nullary object::null))
- (bundle.install "null?" (unary object::null?))
- (bundle.install "synchronized" (binary object::synchronized))
- (bundle.install "throw" (unary object::throw))
- (bundle.install "class" object::class)
- (bundle.install "instance?" object::instance?)
- (bundle.install "cast" object::cast)
- )))
-
-(def: primitives
- (Dictionary Text (Type Primitive))
- (|> (list [(reflection.reflection reflection.boolean) type.boolean]
- [(reflection.reflection reflection.byte) type.byte]
- [(reflection.reflection reflection.short) type.short]
- [(reflection.reflection reflection.int) type.int]
- [(reflection.reflection reflection.long) type.long]
- [(reflection.reflection reflection.float) type.float]
- [(reflection.reflection reflection.double) type.double]
- [(reflection.reflection reflection.char) type.char])
- (dictionary.from-list text.hash)))
-
-(def: get::static
- Handler
- (..custom
- [($_ <>.and <s>.text <s>.text <s>.text)
- (function (_ extension-name generate archive [class field unboxed])
- (do phase.monad
- []
- (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (wrap (_.GETSTATIC (type.class class (list)) field primitive))
-
- #.None
- (wrap (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))]))
-
-(def: put::static
- Handler
- (..custom
- [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
- (function (_ extension-name generate archive [class field unboxed valueS])
- (do phase.monad
- [valueI (generate archive valueS)
- #let [$class (type.class class (list))]]
- (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (wrap (|>> valueI
- (_.PUTSTATIC $class field primitive)
- (_.string synthesis.unit)))
-
- #.None
- (wrap (|>> valueI
- (_.CHECKCAST $class)
- (_.PUTSTATIC $class field $class)
- (_.string synthesis.unit))))))]))
-
-(def: get::virtual
- Handler
- (..custom
- [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
- (function (_ extension-name generate archive [class field unboxed objectS])
- (do phase.monad
- [objectI (generate archive objectS)
- #let [$class (type.class class (list))
- getI (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (_.GETFIELD $class field primitive)
-
- #.None
- (_.GETFIELD $class field (type.class unboxed (list))))]]
- (wrap (|>> objectI
- (_.CHECKCAST $class)
- getI))))]))
-
-(def: put::virtual
- Handler
- (..custom
- [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any)
- (function (_ extension-name generate archive [class field unboxed valueS objectS])
- (do phase.monad
- [valueI (generate archive valueS)
- objectI (generate archive objectS)
- #let [$class (type.class class (list))
- putI (case (dictionary.get unboxed ..primitives)
- (#.Some primitive)
- (_.PUTFIELD $class field primitive)
-
- #.None
- (let [$unboxed (type.class unboxed (list))]
- (|>> (_.CHECKCAST $unboxed)
- (_.PUTFIELD $class field $unboxed))))]]
- (wrap (|>> objectI
- (_.CHECKCAST $class)
- _.DUP
- valueI
- putI))))]))
-
-(type: Input (Typed Synthesis))
-
-(def: input
- (Parser Input)
- (<s>.tuple (<>.and ..value <s>.any)))
-
-(def: (generate-input generate archive [valueT valueS])
- (-> Phase Archive Input
- (Operation (Typed Inst)))
- (do phase.monad
- [valueI (generate archive valueS)]
- (case (type.primitive? valueT)
- (#.Right valueT)
- (wrap [valueT valueI])
-
- (#.Left valueT)
- (wrap [valueT (|>> valueI
- (_.CHECKCAST valueT))]))))
-
-(def: voidI (_.string synthesis.unit))
-
-(def: (prepare-output outputT)
- (-> (Type Return) Inst)
- (case (type.void? outputT)
- (#.Right outputT)
- ..voidI
-
- (#.Left outputT)
- function.identity))
-
-(def: invoke::static
- Handler
- (..custom
- [($_ <>.and ..class <s>.text ..return (<>.some ..input))
- (function (_ extension-name generate archive [class method outputT inputsTS])
- (do {@ phase.monad}
- [inputsTI (monad.map @ (generate-input generate archive) inputsTS)]
- (wrap (|>> (_.fuse (list@map product.right inputsTI))
- (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)]))
- (prepare-output outputT)))))]))
-
-(template [<name> <invoke>]
- [(def: <name>
- Handler
- (..custom
- [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input))
- (function (_ extension-name generate archive [class method outputT objectS inputsTS])
- (do {@ phase.monad}
- [objectI (generate archive objectS)
- inputsTI (monad.map @ (generate-input generate archive) inputsTS)]
- (wrap (|>> objectI
- (_.CHECKCAST class)
- (_.fuse (list@map product.right inputsTI))
- (<invoke> class method
- (type.method [(list@map product.left inputsTI)
- outputT
- (list)]))
- (prepare-output outputT)))))]))]
-
- [invoke::virtual _.INVOKEVIRTUAL]
- [invoke::special _.INVOKESPECIAL]
- [invoke::interface _.INVOKEINTERFACE]
- )
-
-(def: invoke::constructor
- Handler
- (..custom
- [($_ <>.and ..class (<>.some ..input))
- (function (_ extension-name generate archive [class inputsTS])
- (do {@ phase.monad}
- [inputsTI (monad.map @ (generate-input generate archive) inputsTS)]
- (wrap (|>> (_.NEW class)
- _.DUP
- (_.fuse (list@map product.right inputsTI))
- (_.INVOKESPECIAL class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)]))))))]))
-
-(def: member
- Bundle
- (<| (bundle.prefix "member")
- (|> (: Bundle bundle.empty)
- (dictionary.merge (<| (bundle.prefix "get")
- (|> (: Bundle bundle.empty)
- (bundle.install "static" get::static)
- (bundle.install "virtual" get::virtual))))
- (dictionary.merge (<| (bundle.prefix "put")
- (|> (: Bundle bundle.empty)
- (bundle.install "static" put::static)
- (bundle.install "virtual" put::virtual))))
- (dictionary.merge (<| (bundle.prefix "invoke")
- (|> (: Bundle bundle.empty)
- (bundle.install "static" invoke::static)
- (bundle.install "virtual" invoke::virtual)
- (bundle.install "special" invoke::special)
- (bundle.install "interface" invoke::interface)
- (bundle.install "constructor" invoke::constructor))))
- )))
-
-(def: annotation-parameter
- (Parser (/.Annotation-Parameter Synthesis))
- (<s>.tuple (<>.and <s>.text <s>.any)))
-
-(def: annotation
- (Parser (/.Annotation Synthesis))
- (<s>.tuple (<>.and <s>.text (<>.some ..annotation-parameter))))
-
-(def: argument
- (Parser Argument)
- (<s>.tuple (<>.and <s>.text ..value)))
-
-(def: overriden-method-definition
- (Parser [Environment (/.Overriden-Method Synthesis)])
- (<s>.tuple (do <>.monad
- [_ (<s>.text! /.overriden-tag)
- ownerT ..class
- name <s>.text
- strict-fp? <s>.bit
- annotations (<s>.tuple (<>.some ..annotation))
- vars (<s>.tuple (<>.some ..var))
- self-name <s>.text
- arguments (<s>.tuple (<>.some ..argument))
- returnT ..return
- exceptionsT (<s>.tuple (<>.some ..class))
- [environment body] (<s>.function 1
- (<s>.tuple <s>.any))]
- (wrap [environment
- [ownerT name
- strict-fp? annotations vars
- self-name arguments returnT exceptionsT
- body]]))))
-
-(def: (normalize-path normalize)
- (-> (-> Synthesis Synthesis)
- (-> Path Path))
- (function (recur path)
- (case path
- (^ (synthesis.path/then bodyS))
- (synthesis.path/then (normalize bodyS))
-
- (^template [<tag>]
- (^ (<tag> leftP rightP))
- (<tag> (recur leftP) (recur rightP)))
- ([#synthesis.Alt]
- [#synthesis.Seq])
-
- (^template [<tag>]
- (^ (<tag> value))
- path)
- ([#synthesis.Pop]
- [#synthesis.Test]
- [#synthesis.Bind]
- [#synthesis.Access]))))
-
-(def: (normalize-method-body mapping)
- (-> (Dictionary Variable Variable) Synthesis Synthesis)
- (function (recur body)
- (case body
- (^template [<tag>]
- (^ (<tag> value))
- body)
- ([#synthesis.Primitive]
- [synthesis.constant])
-
- (^ (synthesis.variant [lefts right? sub]))
- (synthesis.variant [lefts right? (recur sub)])
-
- (^ (synthesis.tuple members))
- (synthesis.tuple (list@map recur members))
-
- (^ (synthesis.variable var))
- (|> mapping
- (dictionary.get var)
- (maybe.default var)
- synthesis.variable)
-
- (^ (synthesis.branch/case [inputS pathS]))
- (synthesis.branch/case [(recur inputS) (normalize-path recur pathS)])
-
- (^ (synthesis.branch/let [inputS register outputS]))
- (synthesis.branch/let [(recur inputS) register (recur outputS)])
-
- (^ (synthesis.branch/if [testS thenS elseS]))
- (synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)])
-
- (^ (synthesis.loop/scope [offset initsS+ bodyS]))
- (synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)])
-
- (^ (synthesis.loop/recur updatesS+))
- (synthesis.loop/recur (list@map recur updatesS+))
-
- (^ (synthesis.function/abstraction [environment arity bodyS]))
- (synthesis.function/abstraction [(|> environment (list@map (function (_ local)
- (|> mapping
- (dictionary.get local)
- (maybe.default local)))))
- arity
- bodyS])
-
- (^ (synthesis.function/apply [functionS inputsS+]))
- (synthesis.function/apply [(recur functionS) (list@map recur inputsS+)])
-
- (#synthesis.Extension [name inputsS+])
- (#synthesis.Extension [name (list@map recur inputsS+)]))))
-
-(def: $Object (type.class "java.lang.Object" (list)))
-
-(def: (anonymous-init-method env)
- (-> Environment (Type Method))
- (type.method [(list.repeat (list.size env) $Object)
- type.void
- (list)]))
-
-(def: (with-anonymous-init class env super-class inputsTI)
- (-> (Type Class) Environment (Type Class) (List (Typed Inst)) Def)
- (let [store-capturedI (|> env
- list.size
- list.indices
- (list@map (.function (_ register)
- (|>> (_.ALOAD 0)
- (_.ALOAD (inc register))
- (_.PUTFIELD class (///reference.foreign-name register) $Object))))
- _.fuse)]
- (_def.method #$.Public $.noneM "<init>" (anonymous-init-method env)
- (|>> (_.ALOAD 0)
- ((_.fuse (list@map product.right inputsTI)))
- (_.INVOKESPECIAL super-class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)]))
- store-capturedI
- _.RETURN))))
-
-(def: (anonymous-instance archive class env)
- (-> Archive (Type Class) Environment (Operation Inst))
- (do {@ phase.monad}
- [captureI+ (monad.map @ (///reference.variable archive) env)]
- (wrap (|>> (_.NEW class)
- _.DUP
- (_.fuse captureI+)
- (_.INVOKESPECIAL class "<init>" (anonymous-init-method env))))))
-
-(def: (returnI returnT)
- (-> (Type Return) Inst)
- (case (type.void? returnT)
- (#.Right returnT)
- _.RETURN
-
- (#.Left returnT)
- (case (type.primitive? returnT)
- (#.Left returnT)
- (|>> (_.CHECKCAST returnT)
- _.ARETURN)
-
- (#.Right returnT)
- (cond (or (:: type.equivalence = type.boolean returnT)
- (:: type.equivalence = type.byte returnT)
- (:: type.equivalence = type.short returnT)
- (:: type.equivalence = type.int returnT)
- (:: type.equivalence = type.char returnT))
- _.IRETURN
-
- (:: type.equivalence = type.long returnT)
- _.LRETURN
-
- (:: type.equivalence = type.float returnT)
- _.FRETURN
-
- ## (:: type.equivalence = type.double returnT)
- _.DRETURN))))
-
-(def: class::anonymous
- Handler
- (..custom
- [($_ <>.and
- ..class
- (<s>.tuple (<>.some ..class))
- (<s>.tuple (<>.some ..input))
- (<s>.tuple (<>.some ..overriden-method-definition)))
- (function (_ extension-name generate archive [super-class super-interfaces
- inputsTS
- overriden-methods])
- (do {@ phase.monad}
- [[context _] (generation.with-new-context archive (wrap []))
- #let [[module-id artifact-id] context
- anonymous-class-name (///.class-name context)
- class (type.class anonymous-class-name (list))
- total-environment (|> overriden-methods
- ## Get all the environments.
- (list@map product.left)
- ## Combine them.
- list@join
- ## Remove duplicates.
- (set.from-list reference.hash)
- set.to-list)
- global-mapping (|> total-environment
- ## Give them names as "foreign" variables.
- list.enumerate
- (list@map (function (_ [id capture])
- [capture (#reference.Foreign id)]))
- (dictionary.from-list reference.hash))
- normalized-methods (list@map (function (_ [environment
- [ownerT name
- strict-fp? annotations vars
- self-name arguments returnT exceptionsT
- body]])
- (let [local-mapping (|> environment
- list.enumerate
- (list@map (function (_ [foreign-id capture])
- [(#reference.Foreign foreign-id)
- (|> global-mapping
- (dictionary.get capture)
- maybe.assume)]))
- (dictionary.from-list reference.hash))]
- [ownerT name
- strict-fp? annotations vars
- self-name arguments returnT exceptionsT
- (normalize-method-body local-mapping body)]))
- overriden-methods)]
- inputsTI (monad.map @ (generate-input generate archive) inputsTS)
- method-definitions (|> normalized-methods
- (monad.map @ (function (_ [ownerT name
- strict-fp? annotations vars
- self-name arguments returnT exceptionsT
- bodyS])
- (do @
- [bodyG (generation.with-context artifact-id
- (generate archive bodyS))]
- (wrap (_def.method #$.Public
- (if strict-fp?
- ($_ $.++M $.finalM $.strictM)
- $.finalM)
- name
- (type.method [(list@map product.right arguments)
- returnT
- exceptionsT])
- (|>> bodyG (returnI returnT)))))))
- (:: @ map _def.fuse))
- _ (generation.save! true ["" (%.nat artifact-id)]
- [anonymous-class-name
- (_def.class #$.V1_6 #$.Public $.finalC
- anonymous-class-name (list)
- super-class super-interfaces
- (|>> (///function.with-environment total-environment)
- (..with-anonymous-init class total-environment super-class inputsTI)
- method-definitions))])]
- (anonymous-instance archive class total-environment)))]))
-
-(def: bundle::class
- Bundle
- (<| (bundle.prefix "class")
- (|> (: Bundle bundle.empty)
- (bundle.install "anonymous" class::anonymous)
- )))
-
-(def: #export bundle
- Bundle
- (<| (bundle.prefix "jvm")
- (|> ..conversion
- (dictionary.merge ..int)
- (dictionary.merge ..long)
- (dictionary.merge ..float)
- (dictionary.merge ..double)
- (dictionary.merge ..char)
- (dictionary.merge ..array)
- (dictionary.merge ..object-bundle)
- (dictionary.merge ..member)
- (dictionary.merge ..bundle::class)
- )))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux
deleted file mode 100644
index 888ad9545..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/function.lux
+++ /dev/null
@@ -1,331 +0,0 @@
-(.module:
- [lux (#- Type function)
- [abstract
- ["." monad (#+ do)]]
- [control
- [pipe (#+ when> new>)]
- ["." function]]
- [data
- ["." product]
- [text
- ["%" format (#+ format)]]
- [number
- ["n" nat]
- ["i" int]]
- [collection
- ["." list ("#@." functor monoid)]]]
- [target
- [jvm
- ["." type (#+ Type)
- ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]]]]
- [tool
- [compiler
- [arity (#+ Arity)]
- [reference (#+ Register)]
- ["." phase]
- [language
- [lux
- [analysis (#+ Environment)]
- [synthesis (#+ Synthesis Abstraction Apply)]
- ["." generation]]]
- [meta
- [archive (#+ Archive)]]]]]
- [luxc
- [lang
- [host
- ["$" jvm (#+ Label Inst Def Operation Phase Generator)
- ["." def]
- ["_" inst]]]]]
- ["." //
- ["#." runtime]
- ["." reference]])
-
-(def: arity-field Text "arity")
-
-(def: (poly-arg? arity)
- (-> Arity Bit)
- (n.> 1 arity))
-
-(def: (captured-args env)
- (-> Environment (List (Type Value)))
- (list.repeat (list.size env) //.$Value))
-
-(def: (init-method env arity)
- (-> Environment Arity (Type Method))
- (if (poly-arg? arity)
- (type.method [(list.concat (list (captured-args env)
- (list type.int)
- (list.repeat (dec arity) //.$Value)))
- type.void
- (list)])
- (type.method [(captured-args env) type.void (list)])))
-
-(def: (implementation-method arity)
- (type.method [(list.repeat arity //.$Value) //.$Value (list)]))
-
-(def: get-amount-of-partialsI
- Inst
- (|>> (_.ALOAD 0)
- (_.GETFIELD //.$Function //runtime.partials-field type.int)))
-
-(def: (load-fieldI class field)
- (-> (Type Class) Text Inst)
- (|>> (_.ALOAD 0)
- (_.GETFIELD class field //.$Value)))
-
-(def: (inputsI start amount)
- (-> Register Nat Inst)
- (|> (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))
- function.identity)]
- (|>> (_.CHECKCAST //.$Function)
- (inputsI start max-args)
- (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature max-args))
- later-applysI)))
-
-(def: (inc-intI by)
- (-> Nat Inst)
- (|>> (_.int (.int by))
- _.IADD))
-
-(def: (nullsI amount)
- (-> Nat Inst)
- (|> _.NULL
- (list.repeat amount)
- _.fuse))
-
-(def: (instance archive class arity env)
- (-> Archive (Type Class) Arity Environment (Operation Inst))
- (do {@ phase.monad}
- [captureI+ (monad.map @ (reference.variable archive) env)
- #let [argsI (if (poly-arg? arity)
- (|> (nullsI (dec arity))
- (list (_.int +0))
- _.fuse)
- function.identity)]]
- (wrap (|>> (_.NEW class)
- _.DUP
- (_.fuse captureI+)
- argsI
- (_.INVOKESPECIAL class "<init>" (init-method env arity))))))
-
-(def: (reset-method return)
- (-> (Type Class) (Type Method))
- (type.method [(list) return (list)]))
-
-(def: (with-reset class arity env)
- (-> (Type Class) Arity Environment Def)
- (def.method #$.Public $.noneM "reset" (reset-method class)
- (if (poly-arg? arity)
- (let [env-size (list.size env)
- captureI (|> (case env-size
- 0 (list)
- _ (list.n/range 0 (dec env-size)))
- (list@map (.function (_ source)
- (|>> (_.ALOAD 0)
- (_.GETFIELD class (reference.foreign-name source) //.$Value))))
- _.fuse)
- argsI (|> (nullsI (dec arity))
- (list (_.int +0))
- _.fuse)]
- (|>> (_.NEW class)
- _.DUP
- captureI
- argsI
- (_.INVOKESPECIAL class "<init>" (init-method env arity))
- _.ARETURN))
- (|>> (_.ALOAD 0)
- _.ARETURN))))
-
-(def: (with-implementation arity @begin bodyI)
- (-> Nat Label Inst Def)
- (def.method #$.Public $.strictM "impl" (implementation-method arity)
- (|>> (_.label @begin)
- bodyI
- _.ARETURN)))
-
-(def: function-init-method
- (type.method [(list type.int) type.void (list)]))
-
-(def: (function-init arity env-size)
- (-> Arity Nat Inst)
- (if (n.= 1 arity)
- (|>> (_.int +0)
- (_.INVOKESPECIAL //.$Function "<init>" function-init-method))
- (|>> (_.ILOAD (inc env-size))
- (_.INVOKESPECIAL //.$Function "<init>" function-init-method))))
-
-(def: (with-init class env arity)
- (-> (Type Class) Environment Arity Def)
- (let [env-size (list.size env)
- offset-partial (: (-> Nat Nat)
- (|>> inc (n.+ env-size)))
- store-capturedI (|> (case env-size
- 0 (list)
- _ (list.n/range 0 (dec env-size)))
- (list@map (.function (_ register)
- (|>> (_.ALOAD 0)
- (_.ALOAD (inc register))
- (_.PUTFIELD class (reference.foreign-name register) //.$Value))))
- _.fuse)
- store-partialI (if (poly-arg? arity)
- (|> (list.n/range 0 (n.- 2 arity))
- (list@map (.function (_ idx)
- (let [register (offset-partial idx)]
- (|>> (_.ALOAD 0)
- (_.ALOAD (inc register))
- (_.PUTFIELD class (reference.partial-name idx) //.$Value)))))
- _.fuse)
- function.identity)]
- (def.method #$.Public $.noneM "<init>" (init-method env arity)
- (|>> (_.ALOAD 0)
- (function-init arity env-size)
- store-capturedI
- store-partialI
- _.RETURN))))
-
-(def: (with-apply class env function-arity @begin bodyI apply-arity)
- (-> (Type Class) Environment Arity Label Inst Arity
- Def)
- (let [num-partials (dec function-arity)
- @default ($.new-label [])
- @labels (list@map $.new-label (list.repeat num-partials []))
- 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)
- (|> (list.n/range 0 (dec stage))
- (list@map (|>> reference.partial-name (load-fieldI class)))
- _.fuse)
- function.identity)]
- (cond (i.= over-extent (.int stage))
- (|>> (_.label @label)
- (_.ALOAD 0)
- (when> [(new> (n.> 0 stage) [])]
- [(_.INVOKEVIRTUAL class "reset" (reset-method class))])
- load-partialsI
- (inputsI 1 apply-arity)
- (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity))
- _.ARETURN)
-
- (i.> 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))
- load-partialsI
- (inputsI 1 args-to-completion)
- (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity))
- (applysI (inc args-to-completion) args-left)
- _.ARETURN))
-
- ## (i.< over-extent (.int stage))
- (let [env-size (list.size env)
- load-capturedI (|> (case env-size
- 0 (list)
- _ (list.n/range 0 (dec env-size)))
- (list@map (|>> reference.foreign-name (load-fieldI class)))
- _.fuse)]
- (|>> (_.label @label)
- (_.NEW class)
- _.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)))
- (_.INVOKESPECIAL class "<init>" (init-method env function-arity))
- _.ARETURN))
- ))))
- _.fuse)]
- (def.method #$.Public $.noneM //runtime.apply-method (//runtime.apply-signature apply-arity)
- (|>> get-amount-of-partialsI
- (_.TABLESWITCH +0 (|> num-partials dec .int)
- @default @labels)
- casesI
- ))))
-
-(def: #export with-environment
- (-> Environment Def)
- (|>> list.enumerate
- (list@map (.function (_ [env-idx env-source])
- (def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value)))
- def.fuse))
-
-(def: (with-partial arity)
- (-> Arity Def)
- (if (poly-arg? arity)
- (|> (list.n/range 0 (n.- 2 arity))
- (list@map (.function (_ idx)
- (def.field #$.Private $.finalF (reference.partial-name idx) //.$Value)))
- def.fuse)
- function.identity))
-
-(def: #export (with-function archive @begin class env arity bodyI)
- (-> Archive Label Text Environment Arity Inst
- (Operation [Def Inst]))
- (let [classD (type.class class (list))
- applyD (: Def
- (if (poly-arg? arity)
- (|> (n.min arity //runtime.num-apply-variants)
- (list.n/range 1)
- (list@map (with-apply classD env arity @begin bodyI))
- (list& (with-implementation arity @begin bodyI))
- def.fuse)
- (def.method #$.Public $.strictM //runtime.apply-method (//runtime.apply-signature 1)
- (|>> (_.label @begin)
- bodyI
- _.ARETURN))))
- functionD (: Def
- (|>> (def.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity))
- (with-environment env)
- (with-partial arity)
- (with-init classD env arity)
- (with-reset classD arity env)
- applyD
- ))]
- (do phase.monad
- [instanceI (instance archive classD arity env)]
- (wrap [functionD instanceI]))))
-
-(def: #export (function generate archive [env arity bodyS])
- (Generator Abstraction)
- (do phase.monad
- [@begin _.make-label
- [function-context bodyI] (generation.with-new-context archive
- (generation.with-anchor [@begin 1]
- (generate archive bodyS)))
- #let [function-class (//.class-name function-context)]
- [functionD instanceI] (with-function archive @begin function-class env arity bodyI)
- _ (generation.save! true ["" (%.nat (product.right function-context))]
- [function-class
- (def.class #$.V1_6 #$.Public $.finalC
- function-class (list)
- //.$Function (list)
- functionD)])]
- (wrap instanceI)))
-
-(def: #export (call generate archive [functionS argsS])
- (Generator Apply)
- (do {@ phase.monad}
- [functionI (generate archive functionS)
- argsI (monad.map @ (generate archive) argsS)
- #let [applyI (|> argsI
- (list.split-all //runtime.num-apply-variants)
- (list@map (.function (_ chunkI+)
- (|>> (_.CHECKCAST //.$Function)
- (_.fuse chunkI+)
- (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature (list.size chunkI+))))))
- _.fuse)]]
- (wrap (|>> functionI
- applyI))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.lux
deleted file mode 100644
index 1f2168fed..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/loop.lux
+++ /dev/null
@@ -1,81 +0,0 @@
-(.module:
- [lux #*
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." function]]
- [data
- [number
- ["n" nat]]
- [collection
- ["." list ("#/." functor monoid)]]]
- [tool
- [compiler
- [reference (#+ Register)]
- ["." phase]
- [language
- [lux
- ["." synthesis (#+ Synthesis)]
- ["." generation]]]]]]
- [luxc
- [lang
- [host
- [jvm (#+ Inst Operation Phase Generator)
- ["_" inst]]]]]
- ["." //])
-
-(def: (invariant? register changeS)
- (-> Register Synthesis Bit)
- (case changeS
- (^ (synthesis.variable/local var))
- (n.= register var)
-
- _
- false))
-
-(def: #export (recur translate archive argsS)
- (Generator (List Synthesis))
- (do {@ phase.monad}
- [[@begin start] generation.anchor
- #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,
- ## and then I compile the stores/allocations.
- ## It must be done that way in order to avoid a potential bug.
- ## Let's say that you'll recur with 2 expressions: X and Y.
- ## If Y depends on the value of X, and you don't compile values
- ## and stores separately, then by the time Y is evaluated, it
- ## will refer to the new value of X, instead of the old value, as
- ## should be the case.
- valuesI+ (monad.map @ (function (_ [register argS])
- (: (Operation Inst)
- (if (invariant? register argS)
- (wrap function.identity)
- (translate archive argS))))
- pairs)
- #let [storesI+ (list/map (function (_ [register argS])
- (: Inst
- (if (invariant? register argS)
- function.identity
- (_.ASTORE register))))
- (list.reverse pairs))]]
- (wrap (|>> (_.fuse valuesI+)
- (_.fuse storesI+)
- (_.GOTO @begin)))))
-
-(def: #export (scope translate archive [start initsS+ iterationS])
- (Generator [Nat (List Synthesis) Synthesis])
- (do {@ phase.monad}
- [@begin _.make-label
- initsI+ (monad.map @ (translate archive) initsS+)
- iterationI (generation.with-anchor [@begin start]
- (translate archive iterationS))
- #let [initializationI (|> (list.enumerate initsI+)
- (list/map (function (_ [register initI])
- (|>> initI
- (_.ASTORE (n.+ start register)))))
- _.fuse)]]
- (wrap (|>> initializationI
- (_.label @begin)
- iterationI))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
deleted file mode 100644
index 873c363bd..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
+++ /dev/null
@@ -1,30 +0,0 @@
-(.module:
- [lux (#- i64)
- [target
- [jvm
- ["." type]]]
- [tool
- [compiler
- [phase ("operation@." monad)]]]]
- [luxc
- [lang
- [host
- ["." jvm (#+ Inst Operation)
- ["_" inst]]]]])
-
-(def: #export bit
- (-> Bit (Operation Inst))
- (let [Boolean (type.class "java.lang.Boolean" (list))]
- (function (_ value)
- (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean)))))
-
-(template [<name> <type> <load> <wrap>]
- [(def: #export (<name> value)
- (-> <type> (Operation Inst))
- (let [loadI (|> value <load>)]
- (operation@wrap (|>> loadI <wrap>))))]
-
- [i64 (I64 Any) (<| _.long .int) (_.wrap type.long)]
- [f64 Frac _.double (_.wrap type.double)]
- [text Text _.string (<|)]
- )
diff --git a/new-luxc/source/luxc/lang/translation/jvm/program.lux b/new-luxc/source/luxc/lang/translation/jvm/program.lux
deleted file mode 100644
index 7ac897009..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/program.lux
+++ /dev/null
@@ -1,82 +0,0 @@
-(.module:
- [lux #*
- [target
- [jvm
- ["$t" type]]]]
- [luxc
- [lang
- [host
- ["_" jvm
- ["$d" def]
- ["$i" inst]]]
- [translation
- ["." jvm
- ["." runtime]]]]])
-
-(def: #export class "LuxProgram")
-
-(def: ^Object ($t.class "java.lang.Object" (list)))
-
-(def: #export (program programI)
- (-> _.Inst _.Definition)
- (let [nilI runtime.noneI
- num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH)
- decI (|>> ($i.int +1) $i.ISUB)
- headI (|>> $i.DUP
- ($i.ALOAD 0)
- $i.SWAP
- $i.AALOAD
- $i.SWAP
- $i.DUP_X2
- $i.POP)
- pairI (|>> ($i.int +2)
- ($i.ANEWARRAY ..^Object)
- $i.DUP_X1
- $i.SWAP
- ($i.int +0)
- $i.SWAP
- $i.AASTORE
- $i.DUP_X1
- $i.SWAP
- ($i.int +1)
- $i.SWAP
- $i.AASTORE)
- consI (|>> ($i.int +1)
- ($i.string "")
- $i.DUP2_X1
- $i.POP2
- runtime.variantI)
- prepare-input-listI (<| $i.with-label (function (_ @loop))
- $i.with-label (function (_ @end))
- (|>> nilI
- num-inputsI
- ($i.label @loop)
- decI
- $i.DUP
- ($i.IFLT @end)
- headI
- pairI
- consI
- $i.SWAP
- ($i.GOTO @loop)
- ($i.label @end)
- $i.POP))
- feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))
- run-ioI (|>> ($i.CHECKCAST jvm.$Function)
- $i.NULL
- ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)))
- main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list))))
- $t.void
- (list)])]
- [..class
- ($d.class #_.V1_6
- #_.Public _.finalC
- ..class
- (list) ..^Object
- (list)
- (|>> ($d.method #_.Public _.staticM "main" main-type
- (|>> programI
- prepare-input-listI
- feed-inputsI
- run-ioI
- $i.RETURN))))]))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux
deleted file mode 100644
index 6bcf4a2e5..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux
+++ /dev/null
@@ -1,65 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ do)]]
- [data
- [text
- ["%" format (#+ format)]]]
- [target
- [jvm
- ["." type]]]
- [tool
- [compiler
- ["." reference (#+ Register Variable)]
- ["." phase ("operation@." monad)]
- [meta
- [archive (#+ Archive)]]
- [language
- [lux
- ["." generation]]]]]]
- [luxc
- [lang
- [host
- [jvm (#+ Inst Operation)
- ["_" inst]]]]]
- ["." //
- ["#." runtime]])
-
-(template [<name> <prefix>]
- [(def: #export <name>
- (-> Nat Text)
- (|>> %.nat (format <prefix>)))]
-
- [foreign-name "f"]
- [partial-name "p"]
- )
-
-(def: (foreign archive variable)
- (-> Archive Register (Operation Inst))
- (do {@ phase.monad}
- [class-name (:: @ map //.class-name
- (generation.context archive))]
- (wrap (|>> (_.ALOAD 0)
- (_.GETFIELD (type.class class-name (list))
- (|> variable .nat foreign-name)
- //.$Value)))))
-
-(def: local
- (-> Register Inst)
- (|>> _.ALOAD))
-
-(def: #export (variable archive variable)
- (-> Archive Variable (Operation Inst))
- (case variable
- (#reference.Local variable)
- (operation@wrap (local variable))
-
- (#reference.Foreign variable)
- (foreign archive variable)))
-
-(def: #export (constant archive name)
- (-> Archive Name (Operation Inst))
- (do {@ phase.monad}
- [class-name (:: @ map //.class-name
- (generation.remember archive name))]
- (wrap (_.GETSTATIC (type.class class-name (list)) //.value-field //.$Value))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
deleted file mode 100644
index a657a7a38..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
+++ /dev/null
@@ -1,387 +0,0 @@
-(.module:
- [lux (#- Type)
- [abstract
- [monad (#+ do)]]
- [data
- [binary (#+ Binary)]
- ["." product]
- [text
- ["%" format (#+ format)]]
- [collection
- ["." list ("#@." functor)]
- ["." row]]]
- ["." math]
- [target
- [jvm
- ["." type (#+ Type)
- ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)]
- ["." reflection]]]]
- [tool
- [compiler (#+ Output)
- [arity (#+ Arity)]
- ["." phase]
- [language
- [lux
- ["." synthesis]
- ["." generation]]]
- [meta
- [archive
- ["." artifact (#+ Registry)]]]]]]
- [luxc
- [lang
- [host
- ["$" jvm (#+ Label Inst Def Operation)
- ["$d" def]
- ["_" inst]]]]]
- ["." // (#+ ByteCode)])
-
-(def: $Text (type.class "java.lang.String" (list)))
-(def: #export $Tag type.int)
-(def: #export $Flag (type.class "java.lang.Object" (list)))
-(def: #export $Value (type.class "java.lang.Object" (list)))
-(def: #export $Index type.int)
-(def: #export $Stack (type.array $Value))
-(def: $Throwable (type.class "java.lang.Throwable" (list)))
-
-(def: nullary-init-methodT
- (type.method [(list) type.void (list)]))
-
-(def: throw-methodT
- (type.method [(list) type.void (list)]))
-
-(def: #export logI
- Inst
- (let [PrintStream (type.class "java.io.PrintStream" (list))
- outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream)
- printI (function (_ method)
- (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)])))]
- (|>> outI (_.string "LOG: ") (printI "print")
- outI _.SWAP (printI "println"))))
-
-(def: variant-method
- (type.method [(list $Tag $Flag $Value) //.$Variant (list)]))
-
-(def: #export variantI
- Inst
- (_.INVOKESTATIC //.$Runtime "variant_make" variant-method))
-
-(def: #export leftI
- Inst
- (|>> (_.int +0)
- _.NULL
- _.DUP2_X1
- _.POP2
- variantI))
-
-(def: #export rightI
- Inst
- (|>> (_.int +1)
- (_.string "")
- _.DUP2_X1
- _.POP2
- variantI))
-
-(def: #export someI Inst rightI)
-
-(def: #export noneI
- Inst
- (|>> (_.int +0)
- _.NULL
- (_.string synthesis.unit)
- variantI))
-
-(def: (tryI unsafeI)
- (-> Inst Inst)
- (<| _.with-label (function (_ @from))
- _.with-label (function (_ @to))
- _.with-label (function (_ @handler))
- (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list)))
- (_.label @from)
- unsafeI
- someI
- _.ARETURN
- (_.label @to)
- (_.label @handler)
- noneI
- _.ARETURN)))
-
-(def: #export partials-field Text "partials")
-(def: #export apply-method Text "apply")
-(def: #export num-apply-variants Nat 8)
-
-(def: #export (apply-signature arity)
- (-> Arity (Type Method))
- (type.method [(list.repeat arity $Value) $Value (list)]))
-
-(def: adt-methods
- Def
- (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
- store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
- store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
- (|>> ($d.method #$.Public $.staticM "variant_make"
- (type.method [(list $Tag $Flag $Value) //.$Variant (list)])
- (|>> (_.int +3)
- (_.ANEWARRAY $Value)
- store-tagI
- store-flagI
- store-valueI
- _.ARETURN)))))
-
-(def: frac-methods
- Def
- (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)])
- (tryI
- (|>> (_.ALOAD 0)
- (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)]))
- (_.wrap type.double))))
- ))
-
-(def: (illegal-state-exception message)
- (-> Text Inst)
- (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))]
- (|>> (_.NEW IllegalStateException)
- _.DUP
- (_.string message)
- (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list $Text) type.void (list)])))))
-
-(def: pm-methods
- Def
- (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH)
- last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB)
- leftsI (_.ILOAD 1)
- left-indexI leftsI
- sub-leftsI (|>> leftsI
- last-rightI
- _.ISUB)
- sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST //.$Tuple))
- recurI (: (-> Label Inst)
- (function (_ @loop)
- (|>> sub-leftsI (_.ISTORE 1)
- sub-tupleI (_.ASTORE 0)
- (_.GOTO @loop))))]
- (|>> ($d.method #$.Public $.staticM "pm_fail" throw-methodT
- (|>> (illegal-state-exception "Invalid expression for pattern-matching.")
- _.ATHROW))
- ($d.method #$.Public $.staticM "apply_fail" throw-methodT
- (|>> (illegal-state-exception "Error while applying function.")
- _.ATHROW))
- ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)])
- (|>> (_.int +2)
- (_.ANEWARRAY $Value)
- _.DUP
- (_.int +1)
- (_.ALOAD 0)
- _.AASTORE
- _.DUP
- (_.int +0)
- (_.ALOAD 1)
- _.AASTORE
- _.ARETURN))
- ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)])
- (<| _.with-label (function (_ @loop))
- _.with-label (function (_ @perfect-match!))
- _.with-label (function (_ @tags-match!))
- _.with-label (function (_ @maybe-nested))
- _.with-label (function (_ @mismatch!))
- (let [$variant (_.ALOAD 0)
- $tag (_.ILOAD 1)
- $last? (_.ALOAD 2)
-
- variant-partI (: (-> Nat Inst)
- (function (_ idx)
- (|>> (_.int (.int idx)) _.AALOAD)))
- ::tag (: Inst
- (|>> (variant-partI 0) (_.unwrap type.int)))
- ::last? (variant-partI 1)
- ::value (variant-partI 2)
-
- super-nested-tag (|>> _.SWAP ## variant::tag, tag
- _.ISUB)
- super-nested (|>> super-nested-tag ## super-tag
- $variant ::last? ## super-tag, super-last
- $variant ::value ## super-tag, super-last, super-value
- ..variantI)
-
- update-$tag _.ISUB
- update-$variant (|>> $variant ::value
- (_.CHECKCAST //.$Variant)
- (_.ASTORE 0))
- iterate! (: (-> Label Inst)
- (function (_ @loop)
- (|>> update-$variant
- update-$tag
- (_.GOTO @loop))))
-
- not-found _.NULL])
- (|>> $tag ## tag
- (_.label @loop)
- $variant ::tag ## tag, variant::tag
- _.DUP2 (_.IF_ICMPEQ @tags-match!) ## tag, variant::tag
- _.DUP2 (_.IF_ICMPGT @maybe-nested) ## tag, variant::tag
- $last? (_.IFNULL @mismatch!) ## tag, variant::tag
- super-nested ## super-variant
- _.ARETURN
- (_.label @tags-match!) ## tag, variant::tag
- $last? ## tag, variant::tag, last?
- $variant ::last? ## tag, variant::tag, last?, variant::last?
- (_.IF_ACMPEQ @perfect-match!) ## tag, variant::tag
- (_.label @maybe-nested) ## tag, variant::tag
- $variant ::last? ## tag, variant::tag, variant::last?
- (_.IFNULL @mismatch!) ## tag, variant::tag
- (iterate! @loop)
- (_.label @perfect-match!) ## tag, variant::tag
- ## _.POP2
- $variant ::value
- _.ARETURN
- (_.label @mismatch!) ## tag, variant::tag
- ## _.POP2
- not-found
- _.ARETURN)))
- ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)])
- (<| _.with-label (function (_ @loop))
- _.with-label (function (_ @recursive))
- (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
- (|>> (_.label @loop)
- leftsI last-rightI (_.IF_ICMPGE @recursive)
- left-accessI
- _.ARETURN
- (_.label @recursive)
- ## Recursive
- (recurI @loop))))
- ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)])
- (<| _.with-label (function (_ @loop))
- _.with-label (function (_ @not-tail))
- _.with-label (function (_ @slice))
- (let [right-indexI (|>> leftsI
- (_.int +1)
- _.IADD)
- right-accessI (|>> (_.ALOAD 0)
- _.SWAP
- _.AALOAD)
- sub-rightI (|>> (_.ALOAD 0)
- right-indexI
- tuple-sizeI
- (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange"
- (type.method [(list //.$Tuple $Index $Index)
- //.$Tuple
- (list)])))])
- (|>> (_.label @loop)
- last-rightI right-indexI
- _.DUP2 (_.IF_ICMPNE @not-tail)
- ## _.POP
- right-accessI
- _.ARETURN
- (_.label @not-tail)
- (_.IF_ICMPGT @slice)
- ## Must recurse
- (recurI @loop)
- (_.label @slice)
- sub-rightI
- _.ARETURN
- )))
- )))
-
-(def: #export try (type.method [(list //.$Function) //.$Variant (list)]))
-
-(def: io-methods
- Def
- (let [StringWriter (type.class "java.io.StringWriter" (list))
- PrintWriter (type.class "java.io.PrintWriter" (list))
- string-writerI (|>> (_.NEW StringWriter)
- _.DUP
- (_.INVOKESPECIAL StringWriter "<init>" nullary-init-methodT))
- print-writerI (|>> (_.NEW PrintWriter)
- _.SWAP
- _.DUP2
- _.POP
- _.SWAP
- (_.boolean true)
- (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
- )]
- (|>> ($d.method #$.Public $.staticM "try" ..try
- (<| _.with-label (function (_ @from))
- _.with-label (function (_ @to))
- _.with-label (function (_ @handler))
- (|>> (_.try @from @to @handler $Throwable)
- (_.label @from)
- (_.ALOAD 0)
- _.NULL
- (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1))
- rightI
- _.ARETURN
- (_.label @to)
- (_.label @handler)
- string-writerI ## TW
- _.DUP2 ## TWTW
- print-writerI ## TWTP
- (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW
- (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)])) ## TS
- _.SWAP _.POP leftI
- _.ARETURN)))
- )))
-
-(def: reflection
- (All [category]
- (-> (Type (<| Return' Value' category)) Text))
- (|>> type.reflection reflection.reflection))
-
-(def: translate-runtime
- (Operation [Text Binary])
- (let [runtime-class (..reflection //.$Runtime)
- bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime-class (list) (type.class "java.lang.Object" (list)) (list)
- (|>> adt-methods
- frac-methods
- pm-methods
- io-methods))
- payload ["0" bytecode]]
- (do phase.monad
- [_ (generation.execute! runtime-class [runtime-class bytecode])
- _ (generation.save! false ["" "0"] payload)]
- (wrap payload))))
-
-(def: translate-function
- (Operation [Text Binary])
- (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))
- (list@map _.ALOAD)
- _.fuse)]
- (|>> preI
- (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec arity)))
- (_.CHECKCAST //.$Function)
- (_.ALOAD arity)
- (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1))
- _.ARETURN)))))
- (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1)))
- $d.fuse)
- $Object (type.class "java.lang.Object" (list))
- function-class (..reflection //.$Function)
- bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function-class (list) $Object (list)
- (|>> ($d.field #$.Public $.finalF partials-field type.int)
- ($d.method #$.Public $.noneM "<init>" (type.method [(list type.int) type.void (list)])
- (|>> (_.ALOAD 0)
- (_.INVOKESPECIAL $Object "<init>" nullary-init-methodT)
- (_.ALOAD 0)
- (_.ILOAD 1)
- (_.PUTFIELD //.$Function partials-field type.int)
- _.RETURN))
- applyI))
- payload ["1" bytecode]]
- (do phase.monad
- [_ (generation.execute! function-class [function-class bytecode])
- _ (generation.save! false ["" "1"] payload)]
- (wrap payload))))
-
-(def: #export translate
- (Operation [Registry Output])
- (do phase.monad
- [runtime-payload ..translate-runtime
- function-payload ..translate-function]
- (wrap [(|> artifact.empty
- artifact.resource
- product.right
- artifact.resource
- product.right)
- (row.row runtime-payload
- function-payload)])))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
deleted file mode 100644
index 46f87142a..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux
+++ /dev/null
@@ -1,79 +0,0 @@
-(.module:
- [lux (#- Type)
- [abstract
- ["." monad (#+ do)]]
- [control
- ["ex" exception (#+ exception:)]]
- [data
- [number
- ["n" nat]]
- [text
- ["%" format (#+ format)]]
- [collection
- ["." list]]]
- [target
- [jvm
- ["." type (#+ Type)
- ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
- ["." descriptor (#+ Descriptor)]
- ["." signature (#+ Signature)]]]]
- [tool
- [compiler
- ["." phase]
- [meta
- [archive (#+ Archive)]]
- [language
- [lux
- [synthesis (#+ Synthesis)]]]]]]
- [luxc
- [lang
- [host
- [jvm (#+ Inst Operation Phase Generator)
- ["_" inst]]]]]
- ["." //
- ["#." runtime]])
-
-(exception: #export (not-a-tuple {size Nat})
- (ex.report ["Expected size" ">= 2"]
- ["Actual size" (%.nat size)]))
-
-(def: #export (tuple generate archive members)
- (Generator (List Synthesis))
- (do {@ phase.monad}
- [#let [size (list.size members)]
- _ (phase.assert not-a-tuple size
- (n.>= 2 size))
- membersI (|> members
- list.enumerate
- (monad.map @ (function (_ [idx member])
- (do @
- [memberI (generate archive member)]
- (wrap (|>> _.DUP
- (_.int (.int idx))
- memberI
- _.AASTORE)))))
- (:: @ map _.fuse))]
- (wrap (|>> (_.int (.int size))
- (_.array //runtime.$Value)
- membersI))))
-
-(def: (flagI right?)
- (-> Bit Inst)
- (if right?
- (_.string "")
- _.NULL))
-
-(def: #export (variant generate archive [lefts right? member])
- (Generator [Nat Bit Synthesis])
- (do phase.monad
- [memberI (generate archive member)]
- (wrap (|>> (_.int (.int (if right?
- (.inc lefts)
- lefts)))
- (flagI right?)
- memberI
- (_.INVOKESTATIC //.$Runtime
- "variant_make"
- (type.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value)
- //.$Variant
- (list)]))))))