aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc
diff options
context:
space:
mode:
authorEduardo Julian2021-08-02 20:26:21 -0400
committerEduardo Julian2021-08-02 20:26:21 -0400
commiteff4c59794868b89d60fdc411f9b544a270b817e (patch)
treee88c4dd09acdf1e83c8683940c0496a844096dfe /lux-jvm/source/luxc
parentbcd70df3568d71f14763959f454c15d8164e2d15 (diff)
Fixed a bug in the new compiler which allowed the same module to be imported more than once.
Diffstat (limited to '')
-rw-r--r--lux-jvm/source/luxc/lang/directive/jvm.lux204
-rw-r--r--lux-jvm/source/luxc/lang/host/jvm.lux38
-rw-r--r--lux-jvm/source/luxc/lang/host/jvm/def.lux6
-rw-r--r--lux-jvm/source/luxc/lang/host/jvm/inst.lux12
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm.lux28
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/case.lux198
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension.lux4
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux37
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux352
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/function.lux24
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/loop.lux16
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/primitive.lux18
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/reference.lux12
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/runtime.lux18
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/structure.lux36
15 files changed, 507 insertions, 496 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux
index fe3889c38..93a356c0e 100644
--- a/lux-jvm/source/luxc/lang/directive/jvm.lux
+++ b/lux-jvm/source/luxc/lang/directive/jvm.lux
@@ -446,7 +446,7 @@
(let [[mapping input] (..relabel [mapping input])]
[mapping (list& input output)]))
[mapping (list)] labels)]
- [mapping (#/.TABLESWITCH min max default (list.reverse labels))])
+ [mapping (#/.TABLESWITCH min max default (list.reversed labels))])
(#/.LOOKUPSWITCH default keys+labels)
(let [[mapping default] (..relabel [mapping default])
@@ -454,7 +454,7 @@
(let [[mapping input] (..relabel [mapping input])]
[mapping (list& [expected input] output)]))
[mapping (list)] keys+labels)]
- [mapping (#/.LOOKUPSWITCH default (list.reverse keys+labels))])
+ [mapping (#/.LOOKUPSWITCH default (list.reversed keys+labels))])
))
(def: (relabel_exception [mapping instruction])
@@ -523,7 +523,7 @@
(def: fresh
Mapping
- (dictionary.new nat.hash))
+ (dictionary.empty nat.hash))
(def: bytecode
(-> (/.Bytecode Inst /.Label) jvm.Inst)
@@ -575,10 +575,10 @@
directive.lift_generation)
_ (directive.lift_generation
(generation.log! (format "Generation " (%.text (:as Text name)))))]
- (wrap directive.no_requirements))
+ (in directive.no_requirements))
_
- (phase.throw extension.invalid_syntax [extension_name %.code inputsC+]))))
+ (phase.except extension.invalid_syntax [extension_name %.code inputsC+]))))
(def: #export (custom [parser handler])
(All [i]
@@ -591,7 +591,7 @@
(handler extension_name phase archive input')
(#try.Failure error)
- (phase.throw extension.invalid_syntax [extension_name %.code input]))))
+ (phase.except extension.invalid_syntax [extension_name %.code input]))))
(type: Declaration
[External (List (Type Var))])
@@ -678,7 +678,7 @@
state ..state
_ (<code>.tuple (<>.some ..annotation))
type ..value]
- (wrap [name privacy state (list) type]))))
+ (in [name privacy state (list) type]))))
(type: Argument
[Text (Type Value)])
@@ -1021,7 +1021,7 @@
[typeL (//A.reflection_type mapping typeJ)
termA (typeA.with_type typeL
(analyse archive termC))]
- (wrap [typeJ termA])))
+ (in [typeJ termA])))
constructor_argumentsC)
selfT (//A.reflection_type mapping (/type.class class_name class_tvars))
arguments' (monad.map !
@@ -1031,14 +1031,14 @@
arguments)
returnT (//A.boxed_reflection_return mapping /type.void)
[_scope bodyA] (|> arguments'
- (#.Cons [self selfT])
- list.reverse
+ (#.Item [self selfT])
+ list.reversed
(list\fold scopeA.with_local (analyse archive bodyC))
(typeA.with_type returnT)
analysis.with_scope)]
- (wrap [privacy strict_floating_point? annotations method_tvars exceptions
- self arguments constructor_argumentsA
- bodyA])))))
+ (in [privacy strict_floating_point? annotations method_tvars exceptions
+ self arguments constructor_argumentsA
+ bodyA])))))
(def: (override_method_analysis archive [class_name class_tvars] supers method)
(-> Archive Declaration (List (Type Class)) (Override Code) (Operation (Override Analysis)))
@@ -1061,14 +1061,14 @@
arguments)
returnT (//A.boxed_reflection_return mapping returnJ)
[_scope bodyA] (|> arguments'
- (#.Cons [self selfT])
- list.reverse
+ (#.Item [self selfT])
+ list.reversed
(list\fold scopeA.with_local (analyse archive bodyC))
(typeA.with_type returnT)
analysis.with_scope)]
- (wrap [[super_name super_tvars] method_name strict_floating_point? annotations
- method_tvars self arguments returnJ exceptionsJ
- bodyA])))))
+ (in [[super_name super_tvars] method_name strict_floating_point? annotations
+ method_tvars self arguments returnJ exceptionsJ
+ bodyA])))))
(def: (virtual_method_analysis archive [class_name class_tvars] method)
(-> Archive Declaration (Virtual Code) (Operation (Virtual Analysis)))
@@ -1089,14 +1089,14 @@
arguments)
returnT (//A.boxed_reflection_return mapping returnJ)
[_scope bodyA] (|> arguments'
- (#.Cons [self selfT])
- list.reverse
+ (#.Item [self selfT])
+ list.reversed
(list\fold scopeA.with_local (analyse archive bodyC))
(typeA.with_type returnT)
analysis.with_scope)]
- (wrap [name privacy final? strict_floating_point? annotations method_tvars
- self arguments returnJ exceptionsJ
- bodyA])))))
+ (in [name privacy final? strict_floating_point? annotations method_tvars
+ self arguments returnJ exceptionsJ
+ bodyA])))))
(def: (static_method_analysis archive method)
(-> Archive (Static Code) (Operation (Static Analysis)))
@@ -1115,13 +1115,13 @@
arguments)
returnT (//A.boxed_reflection_return mapping returnJ)
[_scope bodyA] (|> arguments'
- list.reverse
+ list.reversed
(list\fold scopeA.with_local (analyse archive bodyC))
(typeA.with_type returnT)
analysis.with_scope)]
- (wrap [name privacy strict_floating_point? annotations method_tvars
- arguments returnJ exceptionsJ
- bodyA])))))
+ (in [name privacy strict_floating_point? annotations method_tvars
+ arguments returnJ exceptionsJ
+ bodyA])))))
(def: (method_analysis archive declaration supers method)
(-> Archive Declaration (List (Type Class)) (Method Code) (Operation (Method Analysis)))
@@ -1143,7 +1143,7 @@
(static_method_analysis archive method))
(#Abstract method)
- (\ phase.monad wrap (#Abstract method))
+ (\ phase.monad in (#Abstract method))
))
(template: (method_body <bodyS>)
@@ -1167,14 +1167,14 @@
(synthesise archive termA)))
constructor_argumentsA)
bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))]
- (wrap [privacy strict_floating_point? annotations method_tvars exceptions
- self arguments constructor_argumentsS
- (case bodyS
- (^ (method_body bodyS))
- bodyS
+ (in [privacy strict_floating_point? annotations method_tvars exceptions
+ self arguments constructor_argumentsS
+ (case bodyS
+ (^ (method_body bodyS))
+ bodyS
- _
- bodyS)])))))
+ _
+ bodyS)])))))
(def: (override_method_synthesis archive method)
(-> Archive (Override Analysis) (Operation (Override Synthesis)))
@@ -1186,14 +1186,14 @@
(directive.lift_synthesis
(do !
[bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))]
- (wrap [[super_name super_tvars] method_name strict_floating_point? annotations
- method_tvars self arguments returnJ exceptionsJ
- (case bodyS
- (^ (method_body bodyS))
- bodyS
+ (in [[super_name super_tvars] method_name strict_floating_point? annotations
+ method_tvars self arguments returnJ exceptionsJ
+ (case bodyS
+ (^ (method_body bodyS))
+ bodyS
- _
- bodyS)])))))
+ _
+ bodyS)])))))
(def: (virtual_method_synthesis archive method)
(-> Archive (Virtual Analysis) (Operation (Virtual Synthesis)))
@@ -1205,14 +1205,14 @@
(directive.lift_synthesis
(do !
[bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))]
- (wrap [name privacy final? strict_floating_point? annotations method_tvars
- self arguments returnJ exceptionsJ
- (case bodyS
- (^ (method_body bodyS))
- bodyS
+ (in [name privacy final? strict_floating_point? annotations method_tvars
+ self arguments returnJ exceptionsJ
+ (case bodyS
+ (^ (method_body bodyS))
+ bodyS
- _
- bodyS)])))))
+ _
+ bodyS)])))))
(def: (static_method_synthesis archive method)
(-> Archive (Static Analysis) (Operation (Static Synthesis)))
@@ -1224,14 +1224,14 @@
(directive.lift_synthesis
(do !
[bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))]
- (wrap [name privacy strict_floating_point? annotations method_tvars
- arguments returnJ exceptionsJ
- (case bodyS
- (^ (method_body bodyS))
- bodyS
+ (in [name privacy strict_floating_point? annotations method_tvars
+ arguments returnJ exceptionsJ
+ (case bodyS
+ (^ (method_body bodyS))
+ bodyS
- _
- bodyS)])))))
+ _
+ bodyS)])))))
(def: (method_synthesis archive method)
(-> Archive (Method Analysis) (Operation (Method Synthesis)))
@@ -1253,7 +1253,7 @@
(static_method_synthesis archive method))
(#Abstract method)
- (\ phase.monad wrap (#Abstract method))
+ (\ phase.monad in (#Abstract method))
))
(def: (constructor_method_generation archive super_class method)
@@ -1279,16 +1279,16 @@
(|>> (_.ALOAD 0)
super_constructor_argument_values
(_.INVOKESPECIAL super_class ..constructor_name super_constructorT)))]]
- (wrap (def.method (..visibility privacy)
- (if strict_floating_point?
- jvm.strictM
- jvm.noneM)
- ..constructor_name
- (/type.method [method_tvars argumentsT /type.void exceptions])
- (|>> initialize_object!
- (//G.prepare_arguments 1 argumentsT)
- bodyG
- _.RETURN)))))))
+ (in (def.method (..visibility privacy)
+ (if strict_floating_point?
+ jvm.strictM
+ jvm.noneM)
+ ..constructor_name
+ (/type.method [method_tvars argumentsT /type.void exceptions])
+ (|>> initialize_object!
+ (//G.prepare_arguments 1 argumentsT)
+ bodyG
+ _.RETURN)))))))
(def: (override_method_generation archive method)
(-> Archive (Override Synthesis) (Operation jvm.Def))
@@ -1301,15 +1301,15 @@
(do !
[bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS))
#let [argumentsT (list\map product.right arguments)]]
- (wrap (def.method #jvm.Public
- (if strict_floating_point?
- jvm.strictM
- jvm.noneM)
- method_name
- (/type.method [method_tvars argumentsT returnJ exceptionsJ])
- (|>> (//G.prepare_arguments 1 argumentsT)
- bodyG
- (//G.returnI returnJ))))))))
+ (in (def.method #jvm.Public
+ (if strict_floating_point?
+ jvm.strictM
+ jvm.noneM)
+ method_name
+ (/type.method [method_tvars argumentsT returnJ exceptionsJ])
+ (|>> (//G.prepare_arguments 1 argumentsT)
+ bodyG
+ (//G.returnI returnJ))))))))
(def: (virtual_method_generation archive method)
(-> Archive (Virtual Synthesis) (Operation jvm.Def))
@@ -1322,19 +1322,19 @@
(do !
[bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS))
#let [argumentsT (list\map product.right arguments)]]
- (wrap (def.method (..visibility privacy)
- (|> jvm.noneM
- (jvm.++M (if strict_floating_point?
- jvm.strictM
- jvm.noneM))
- (jvm.++M (if final?
- jvm.finalM
- jvm.noneM)))
- method_name
- (/type.method [method_tvars argumentsT returnJ exceptionsJ])
- (|>> (//G.prepare_arguments 1 argumentsT)
- bodyG
- (//G.returnI returnJ))))))))
+ (in (def.method (..visibility privacy)
+ (|> jvm.noneM
+ (jvm.++M (if strict_floating_point?
+ jvm.strictM
+ jvm.noneM))
+ (jvm.++M (if final?
+ jvm.finalM
+ jvm.noneM)))
+ method_name
+ (/type.method [method_tvars argumentsT returnJ exceptionsJ])
+ (|>> (//G.prepare_arguments 1 argumentsT)
+ bodyG
+ (//G.returnI returnJ))))))))
(def: (static_method_generation archive method)
(-> Archive (Static Synthesis) (Operation jvm.Def))
@@ -1347,16 +1347,16 @@
(do !
[bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS))
#let [argumentsT (list\map product.right arguments)]]
- (wrap (def.method (..visibility privacy)
- (|> jvm.staticM
- (jvm.++M (if strict_floating_point?
- jvm.strictM
- jvm.noneM)))
- method_name
- (/type.method [method_tvars argumentsT returnJ exceptionsJ])
- (|>> (//G.prepare_arguments 0 argumentsT)
- bodyG
- (//G.returnI returnJ))))))))
+ (in (def.method (..visibility privacy)
+ (|> jvm.staticM
+ (jvm.++M (if strict_floating_point?
+ jvm.strictM
+ jvm.noneM)))
+ method_name
+ (/type.method [method_tvars argumentsT returnJ exceptionsJ])
+ (|>> (//G.prepare_arguments 0 argumentsT)
+ bodyG
+ (//G.returnI returnJ))))))))
(def: (method_generation archive super_class method)
(-> Archive (Type Class) (Method Synthesis) (Operation jvm.Def))
@@ -1374,7 +1374,7 @@
(..static_method_generation archive method)
(#Abstract method)
- (\ phase.monad wrap (..abstract_method_generation method))
+ (\ phase.monad in (..abstract_method_generation method))
))
(import: java/lang/ClassLoader)
@@ -1445,7 +1445,7 @@
_ (generation.execute! directive)
_ (generation.save! artifact_id (#.Some class_name) directive)
_ (generation.log! (format "JVM Class " (%.text class_name)))]
- (wrap directive.no_requirements)))))]))
+ (in directive.no_requirements)))))]))
(def: jvm::class::interface
..Handler
@@ -1472,7 +1472,7 @@
_ (generation.execute! directive)
_ (generation.save! artifact_id (#.Some class_name) directive)
_ (generation.log! (format "JVM Interface " (%.text class_name)))]
- (wrap directive.no_requirements)))))]))
+ (in directive.no_requirements)))))]))
(def: #export (bundle class_loader extender)
(-> java/lang/ClassLoader jvm.Extender (directive.Bundle jvm.Anchor jvm.Inst jvm.Definition))
diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux
index 1c81be667..5c854d646 100644
--- a/lux-jvm/source/luxc/lang/host/jvm.lux
+++ b/lux-jvm/source/luxc/lang/host/jvm.lux
@@ -103,25 +103,25 @@
(|> (~ g!none)
(set@ (~ (code.local_tag option)) #1)))))
options)]
- (wrap (list& (` (type: (~' #export) (~ g!type)
- (~ (code.record (list/map (function (_ tag)
- [tag (` .Bit)])
- g!tags+)))))
-
- (` (def: (~' #export) (~ g!none)
- (~ g!type)
- (~ (code.record (list/map (function (_ tag)
- [tag (` #0)])
- g!tags+)))))
-
- (` (def: (~' #export) ((~ (code.local_identifier ++)) (~ g!_left) (~ g!_right))
- (-> (~ g!type) (~ g!type) (~ g!type))
- (~ (code.record (list/map (function (_ tag)
- [tag (` (or (get@ (~ tag) (~ g!_left))
- (get@ (~ tag) (~ g!_right))))])
- g!tags+)))))
-
- g!options+))))
+ (in (list& (` (type: (~' #export) (~ g!type)
+ (~ (code.record (list/map (function (_ tag)
+ [tag (` .Bit)])
+ g!tags+)))))
+
+ (` (def: (~' #export) (~ g!none)
+ (~ g!type)
+ (~ (code.record (list/map (function (_ tag)
+ [tag (` #0)])
+ g!tags+)))))
+
+ (` (def: (~' #export) ((~ (code.local_identifier ++)) (~ g!_left) (~ g!_right))
+ (-> (~ g!type) (~ g!type) (~ g!type))
+ (~ (code.record (list/map (function (_ tag)
+ [tag (` (or (get@ (~ tag) (~ g!_left))
+ (get@ (~ tag) (~ g!_right))))])
+ g!tags+)))))
+
+ g!options+))))
(config: Class_Config noneC ++C [finalC])
(config: Method_Config noneM ++M [finalM staticM synchronizedM strictM])
diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux
index 953dbf200..e1e60179f 100644
--- a/lux-jvm/source/luxc/lang/host/jvm/def.lux
+++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux
@@ -293,11 +293,11 @@
(def: #export (fuse defs)
(-> (List //.Def) //.Def)
(case defs
- #.Nil
+ #.End
function.identity
- (#.Cons singleton #.Nil)
+ (#.Item singleton #.End)
singleton
- (#.Cons head tail)
+ (#.Item head tail)
(function.compose (fuse tail) head)))
diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux
index e86504d60..ea68f2680 100644
--- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux
+++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux
@@ -47,7 +47,7 @@
(syntax: (declare {codes (p.many s.local_identifier)})
(|> codes
(list@map (function (_ code) (` ((~' #static) (~ (code.local_identifier code)) (~' int)))))
- wrap))
+ in))
(`` (import: org/objectweb/asm/Opcodes
["#::."
@@ -375,7 +375,7 @@
labels_array (ffi.array org/objectweb/asm/Label array_size)
_ (loop [idx 0]
(if (n.< array_size idx)
- (let [[key label] (maybe.assume (list.nth idx keys+labels))]
+ (let [[key label] (maybe.assume (list.item idx keys+labels))]
(exec
(ffi.array_write idx (ffi.long_to_int key) keys_array)
(ffi.array_write idx label labels_array)
@@ -392,7 +392,7 @@
_ (loop [idx 0]
(if (n.< num_labels idx)
(exec (ffi.array_write idx
- (maybe.assume (list.nth idx labels))
+ (maybe.assume (list.item idx labels))
labels_array)
(recur (inc idx)))
[]))]
@@ -459,11 +459,11 @@
(def: #export (fuse insts)
(-> (List Inst) Inst)
(case insts
- #.Nil
+ #.End
function.identity
- (#.Cons singleton #.Nil)
+ (#.Item singleton #.End)
singleton
- (#.Cons head tail)
+ (#.Item head tail)
(function.compose (fuse tail) head)))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux
index 1b916d925..4cf712a45 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm.lux
@@ -88,13 +88,13 @@
(#try.Success value)
#.None
- (exception.throw ..invalid_value class_name))
+ (exception.except ..invalid_value class_name))
(#try.Failure error)
- (exception.throw ..cannot_load [class_name error]))
+ (exception.except ..cannot_load [class_name error]))
(#try.Failure error)
- (exception.throw ..invalid_field [class_name ..value_field error])))
+ (exception.except ..invalid_field [class_name ..value_field error])))
(def: class_path_separator ".")
@@ -129,9 +129,9 @@
(io.run (do (try.with io.monad)
[_ (loader.store eval_class bytecode library)
class (loader.load eval_class loader)
- value (\ io.monad wrap (..class_value eval_class class))]
- (wrap [value
- [eval_class bytecode]])))))
+ value (\ io.monad in (..class_value eval_class class))]
+ (in [value
+ [eval_class bytecode]])))))
(def: (execute! library loader [class_name class_bytecode])
(-> Library java/lang/ClassLoader Definition (Try Any))
@@ -142,7 +142,7 @@
(try.lifted io.monad)
(: (IO (Try Bit))))
_ (if existing_class?
- (wrap [])
+ (in [])
(loader.store class_name class_bytecode library))]
(loader.load class_name loader))))
@@ -150,9 +150,9 @@
(-> Library java/lang/ClassLoader generation.Context (Maybe Text) Inst (Try [Text Any Definition]))
(do try.monad
[[value definition] (evaluate! library loader context valueI)]
- (wrap [(maybe.default (..class_name context)
- custom)
- value definition])))
+ (in [(maybe.else (..class_name context)
+ custom)
+ value definition])))
(def: #export host
(IO [java/lang/ClassLoader Host])
@@ -176,16 +176,16 @@
(def: (re_learn context custom [_ bytecode])
(io.run
- (loader.store (maybe.default (..class_name context) custom) bytecode library)))
+ (loader.store (maybe.else (..class_name context) custom) bytecode library)))
(def: (re_load context custom [directive_name bytecode])
(io.run
(do (try.with io.monad)
- [#let [class_name (maybe.default (..class_name context)
- custom)]
+ [#let [class_name (maybe.else (..class_name context)
+ custom)]
_ (loader.store class_name bytecode library)
class (loader.load class_name loader)]
- (\ io.monad wrap (..class_value class_name class)))))))])))
+ (\ io.monad in (..class_value class_name class)))))))])))
(def: #export $Variant
(type.array ..$Value))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
index b7b1d6b0f..2c9bfdb61 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
@@ -71,6 +71,9 @@
5 _.ICONST_5
_ (_.int (.int value))))
+(def: projectionJT
+ (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)]))
+
(def: (left_projection lefts)
(-> Nat Inst)
(.let [[indexI accessI] (.case lefts
@@ -80,7 +83,7 @@
lefts
[(leftsI lefts)
- (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)]))])]
+ (_.INVOKESTATIC //.$Runtime "tuple_left" ..projectionJT)])]
(|>> (_.CHECKCAST //.$Tuple)
indexI
accessI)))
@@ -89,17 +92,23 @@
(-> Nat Inst)
(|>> (_.CHECKCAST //.$Tuple)
(leftsI lefts)
- (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)]))))
+ (_.INVOKESTATIC //.$Runtime "tuple_right" ..projectionJT)))
+
+(def: equalsJT
+ (type.method [(list) (list //.$Value) type.boolean (list)]))
+
+(def: sideJT
+ (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)]))
(def: (path' stack_depth @else @end phase archive path)
(-> Nat Label Label Phase Archive Path (Operation Inst))
(.case path
#synthesis.Pop
- (operation@wrap ..popI)
+ (operation@in ..popI)
(#synthesis.Bind register)
- (operation@wrap (|>> peekI
- (_.ASTORE register)))
+ (operation@in (|>> peekI
+ (_.ASTORE register)))
(#synthesis.Bit_Fork when thenP elseP)
(do phase.monad
@@ -109,15 +118,15 @@
(path' stack_depth @else @end phase archive elseP)
#.None
- (wrap (_.GOTO @else)))
+ (in (_.GOTO @else)))
#let [ifI (.if when _.IFEQ _.IFNE)]]
- (wrap (<| _.with_label (function (_ @else))
- (|>> peekI
- (_.unwrap type.boolean)
- (ifI @else)
- thenG
- (_.label @else)
- elseG))))
+ (in (<| _.with_label (function (_ @else))
+ (|>> peekI
+ (_.unwrap type.boolean)
+ (ifI @else)
+ thenG
+ (_.label @else)
+ elseG))))
(^template [<tag> <unwrap> <dup> <pop> <test> <comparison> <if>]
[(<tag> cons)
@@ -126,70 +135,70 @@
(monad.fold @ (function (_ [test thenP] elseG)
(do @
[thenG (path' stack_depth @else @end phase archive thenP)]
- (wrap (<| _.with_label (function (_ @else))
- (|>> <dup>
- (<test> test)
- <comparison>
- (<if> @else)
- <pop>
- thenG
- (_.label @else)
- elseG)))))
+ (in (<| _.with_label (function (_ @else))
+ (|>> <dup>
+ (<test> test)
+ <comparison>
+ (<if> @else)
+ <pop>
+ thenG
+ (_.label @else)
+ elseG)))))
(|>> <pop>
(_.GOTO @else))
- (#.Cons cons)))]
- (wrap (|>> peekI
- <unwrap>
- forkG)))])
+ (#.Item cons)))]
+ (in (|>> peekI
+ <unwrap>
+ forkG)))])
([#synthesis.I64_Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE]
[#synthesis.F64_Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE]
[#synthesis.Text_Fork (|>) _.DUP _.POP _.string
- (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" (type.method [(list) (list //.$Value) type.boolean (list)]))
+ (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" ..equalsJT)
_.IFEQ])
(#synthesis.Then bodyS)
(do phase.monad
[bodyI (phase archive bodyS)]
- (wrap (|>> (pop_altI stack_depth)
- bodyI
- (_.GOTO @end))))
+ (in (|>> (pop_altI stack_depth)
+ bodyI
+ (_.GOTO @end))))
(^template [<pattern> <right?>]
[(^ (<pattern> lefts))
- (operation@wrap (<| _.with_label (function (_ @success))
- _.with_label (function (_ @fail))
- (|>> peekI
- (_.CHECKCAST //.$Variant)
- (structure.tagI lefts <right?>)
- (structure.flagI <right?>)
- (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)]))
- _.DUP
- (_.IFNULL @fail)
- (_.GOTO @success)
- (_.label @fail)
- _.POP
- (_.GOTO @else)
- (_.label @success)
- pushI)))])
+ (operation@in (<| _.with_label (function (_ @success))
+ _.with_label (function (_ @fail))
+ (|>> peekI
+ (_.CHECKCAST //.$Variant)
+ (structure.tagI lefts <right?>)
+ (structure.flagI <right?>)
+ (_.INVOKESTATIC //.$Runtime "pm_variant" ..sideJT)
+ _.DUP
+ (_.IFNULL @fail)
+ (_.GOTO @success)
+ (_.label @fail)
+ _.POP
+ (_.GOTO @else)
+ (_.label @success)
+ pushI)))])
([synthesis.side/left false]
[synthesis.side/right true])
## Extra optimization
(^template [<path> <projection>]
[(^ (<path> lefts))
- (operation@wrap (|>> peekI
- (<projection> lefts)
- pushI))
+ (operation@in (|>> peekI
+ (<projection> lefts)
+ pushI))
(^ (synthesis.path/seq
(<path> lefts)
(synthesis.!bind_top register thenP)))
(do phase.monad
[then! (path' stack_depth @else @end phase archive thenP)]
- (wrap (|>> peekI
- (<projection> lefts)
- (_.ASTORE register)
- then!)))])
+ (in (|>> peekI
+ (<projection> lefts)
+ (_.ASTORE register)
+ then!)))])
([synthesis.member/left ..left_projection]
[synthesis.member/right ..right_projection])
@@ -197,32 +206,35 @@
(do phase.monad
[leftI (path' stack_depth @else @end phase archive leftP)
rightI (path' stack_depth @else @end phase archive rightP)]
- (wrap (|>> leftI
- rightI)))
+ (in (|>> leftI
+ rightI)))
(#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)))
+ (in (|>> _.DUP
+ leftI
+ (_.label @alt_else)
+ _.POP
+ rightI)))
))
+(def: failJT
+ (type.method [(list) (list) type.void (list)]))
+
(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) (list) type.void (list)]))
- _.NULL
- (_.GOTO @end)))))
+ (in (|>> pathI
+ (_.label @else)
+ _.POP
+ (_.INVOKESTATIC //.$Runtime "pm_fail" ..failJT)
+ _.NULL
+ (_.GOTO @end)))))
(def: #export (if phase archive [testS thenS elseS])
(Generator [Synthesis Synthesis Synthesis])
@@ -230,40 +242,40 @@
[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))))))
+ (in (<| _.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))))
+ (in (|>> inputI
+ (_.ASTORE register)
+ exprI))))
(def: #export (get phase archive [path recordS])
(Generator [(List synthesis.Member) Synthesis])
(do phase.monad
[recordG (phase archive recordS)]
- (wrap (list@fold (function (_ step so_far)
- (.let [next (.case step
- (#.Left lefts)
- (..left_projection lefts)
-
- (#.Right lefts)
- (..right_projection lefts))]
- (|>> so_far next)))
- recordG
- (list.reverse path)))))
+ (in (list@fold (function (_ step so_far)
+ (.let [next (.case step
+ (#.Left lefts)
+ (..left_projection lefts)
+
+ (#.Right lefts)
+ (..right_projection lefts))]
+ (|>> so_far next)))
+ recordG
+ (list.reversed path)))))
(def: #export (case phase archive [valueS path])
(Generator [Synthesis Path])
@@ -271,8 +283,8 @@
[@end _.make_label
valueI (phase archive valueS)
pathI (..path @end phase archive path)]
- (wrap (|>> _.NULL
- valueI
- pushI
- pathI
- (_.label @end)))))
+ (in (|>> _.NULL
+ valueI
+ pushI
+ pathI
+ (_.label @end)))))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux
index 2f1bd6a36..8fced4749 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux
@@ -13,5 +13,5 @@
(def: #export bundle
Bundle
- (dictionary.merge /common.bundle
- /host.bundle))
+ (dictionary.merged /common.bundle
+ /host.bundle))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
index 70175b636..eb3d02be7 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
@@ -52,7 +52,7 @@
(handler extension_name phase archive input')
(#try.Failure error)
- (phase.throw extension.invalid_syntax [extension_name %synthesis input]))))
+ (phase.except extension.invalid_syntax [extension_name %synthesis input]))))
(import: java/lang/Double
["#::."
@@ -103,13 +103,13 @@
(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))]))))
+ (in (<| _.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)
@@ -117,13 +117,12 @@
conditionalsG (|> conditionalsG+
(list@map product.right)
_.fuse)]]
- (wrap (|>> inputG (_.unwrap type.long) _.L2I
- (_.LOOKUPSWITCH @else table)
- conditionalsG
- (_.label @else)
- elseG
- (_.label @end)
- )))))]))
+ (in (|>> inputG (_.unwrap type.long) _.L2I
+ (_.LOOKUPSWITCH @else table)
+ conditionalsG
+ (_.label @else)
+ elseG
+ (_.label @end))))))]))
(def: (lux::is [referenceI sampleI])
(Binary Inst)
@@ -372,7 +371,7 @@
Bundle
(<| (bundle.prefix "lux")
(|> bundle::lux
- (dictionary.merge bundle::i64)
- (dictionary.merge bundle::f64)
- (dictionary.merge bundle::text)
- (dictionary.merge bundle::io))))
+ (dictionary.merged bundle::i64)
+ (dictionary.merged bundle::f64)
+ (dictionary.merged bundle::text)
+ (dictionary.merged bundle::io))))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index 4f8210a47..e87ea6510 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -70,7 +70,7 @@
(template [<name> <category> <parser>]
[(def: #export <name>
(Parser (Type <category>))
- (<text>.embed <parser> <synthesis>.text))]
+ (<text>.then <parser> <synthesis>.text))]
[var Var parser.var]
[class Class parser.class]
@@ -94,15 +94,15 @@
(def: #export object_array
(Parser (Type Object))
(do <>.monad
- [arrayJT (<text>.embed parser.array <synthesis>.text)]
+ [arrayJT (<text>.then parser.array <synthesis>.text)]
(case (parser.array? arrayJT)
(#.Some elementJT)
(case (parser.object? elementJT)
(#.Some elementJT)
- (wrap elementJT)
+ (in elementJT)
#.None
- (<>.failure (exception.construct ..not_an_object_array arrayJT)))
+ (<>.failure (exception.error ..not_an_object_array [arrayJT])))
#.None
(undefined))))
@@ -110,11 +110,11 @@
(template [<name> <inst>]
[(def: <name>
Inst
- <inst>)]
+ (|>> _.L2I <inst>))]
- [L2S (|>> _.L2I _.I2S)]
- [L2B (|>> _.L2I _.I2B)]
- [L2C (|>> _.L2I _.I2C)]
+ [L2S _.I2S]
+ [L2B _.I2B]
+ [L2C _.I2C]
)
(template [<conversion> <name>]
@@ -355,9 +355,9 @@
(function (_ extension_name generate archive arrayS)
(do phase.monad
[arrayI (generate archive arrayS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array jvm_primitive))
- _.ARRAYLENGTH))))]))
+ (in (|>> arrayI
+ (_.CHECKCAST (type.array jvm_primitive))
+ _.ARRAYLENGTH))))]))
(def: array::length::object
Handler
@@ -366,9 +366,9 @@
(function (_ extension_name generate archive [elementJT arrayS])
(do phase.monad
[arrayI (generate archive arrayS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array elementJT))
- _.ARRAYLENGTH))))]))
+ (in (|>> arrayI
+ (_.CHECKCAST (type.array elementJT))
+ _.ARRAYLENGTH))))]))
(def: (new_primitive_array_handler jvm_primitive)
(-> (Type Primitive) Handler)
@@ -377,11 +377,11 @@
(^ (list lengthS))
(do phase.monad
[lengthI (generate archive lengthS)]
- (wrap (|>> lengthI
- (_.array jvm_primitive))))
+ (in (|>> lengthI
+ (_.array jvm_primitive))))
_
- (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))))
+ (phase.except extension.invalid_syntax [extension_name %synthesis inputs]))))
(def: array::new::object
Handler
@@ -390,8 +390,8 @@
(function (_ extension_name generate archive [objectJT lengthS])
(do phase.monad
[lengthI (generate archive lengthS)]
- (wrap (|>> lengthI
- (_.ANEWARRAY objectJT)))))]))
+ (in (|>> lengthI
+ (_.ANEWARRAY objectJT)))))]))
(def: (read_primitive_array_handler jvm_primitive loadI)
(-> (Type Primitive) Inst Handler)
@@ -401,13 +401,13 @@
(do phase.monad
[arrayI (generate archive arrayS)
idxI (generate archive idxS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array jvm_primitive))
- idxI
- loadI)))
+ (in (|>> arrayI
+ (_.CHECKCAST (type.array jvm_primitive))
+ idxI
+ loadI)))
_
- (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))))
+ (phase.except extension.invalid_syntax [extension_name %synthesis inputs]))))
(def: array::read::object
Handler
@@ -417,10 +417,10 @@
(do phase.monad
[arrayI (generate archive arrayS)
idxI (generate archive idxS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array elementJT))
- idxI
- _.AALOAD))))]))
+ (in (|>> arrayI
+ (_.CHECKCAST (type.array elementJT))
+ idxI
+ _.AALOAD))))]))
(def: (write_primitive_array_handler jvm_primitive storeI)
(-> (Type Primitive) Inst Handler)
@@ -431,15 +431,15 @@
[arrayI (generate archive arrayS)
idxI (generate archive idxS)
valueI (generate archive valueS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array jvm_primitive))
- _.DUP
- idxI
- valueI
- storeI)))
+ (in (|>> arrayI
+ (_.CHECKCAST (type.array jvm_primitive))
+ _.DUP
+ idxI
+ valueI
+ storeI)))
_
- (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))))
+ (phase.except extension.invalid_syntax [extension_name %synthesis inputs]))))
(def: array::write::object
Handler
@@ -450,61 +450,61 @@
[arrayI (generate archive arrayS)
idxI (generate archive idxS)
valueI (generate archive valueS)]
- (wrap (|>> arrayI
- (_.CHECKCAST (type.array elementJT))
- _.DUP
- idxI
- valueI
- _.AASTORE))))]))
+ (in (|>> arrayI
+ (_.CHECKCAST (type.array elementJT))
+ _.DUP
+ idxI
+ valueI
+ _.AASTORE))))]))
(def: array_bundle
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))))
+ (dictionary.merged (<| (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.merged (<| (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.merged (<| (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.merged (<| (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 _)
@@ -546,11 +546,11 @@
(^ (list (synthesis.text class)))
(do phase.monad
[]
- (wrap (|>> (_.string class)
- (_.INVOKESTATIC $Class "forName" (type.method [(list) (list (type.class "java.lang.String" (list))) $Class (list)])))))
+ (in (|>> (_.string class)
+ (_.INVOKESTATIC $Class "forName" (type.method [(list) (list (type.class "java.lang.String" (list))) $Class (list)])))))
_
- (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))
+ (phase.except extension.invalid_syntax [extension_name %synthesis inputs])))
(def: object::instance?
Handler
@@ -559,9 +559,9 @@
(function (_ extension_name generate archive [class objectS])
(do phase.monad
[objectI (generate archive objectS)]
- (wrap (|>> objectI
- (_.INSTANCEOF (type.class class (list)))
- (_.wrap type.boolean)))))]))
+ (in (|>> objectI
+ (_.INSTANCEOF (type.class class (list)))
+ (_.wrap type.boolean)))))]))
(def: (object::cast extension_name generate archive inputs)
Handler
@@ -574,13 +574,13 @@
from)
(text\= <object>
to))
- (wrap (|>> valueI (_.wrap <primitive>)))
+ (in (|>> valueI (_.wrap <primitive>)))
(and (text\= <object>
from)
(text\= (reflection.reflection (type.reflection <primitive>))
to))
- (wrap (|>> valueI (_.unwrap <primitive>)))]
+ (in (|>> valueI (_.unwrap <primitive>)))]
[box.boolean type.boolean]
[box.byte type.byte]
@@ -591,10 +591,10 @@
[box.double type.double]
[box.char type.char]))
## else
- (wrap valueI))))
+ (in valueI))))
_
- (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))
+ (phase.except extension.invalid_syntax [extension_name %synthesis inputs])))
(def: object_bundle
Bundle
@@ -630,10 +630,10 @@
[]
(case (dictionary.get unboxed ..primitives)
(#.Some primitive)
- (wrap (_.GETSTATIC (type.class class (list)) field primitive))
+ (in (_.GETSTATIC (type.class class (list)) field primitive))
#.None
- (wrap (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))]))
+ (in (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))]))
(def: put::static
Handler
@@ -645,15 +645,15 @@
#let [$class (type.class class (list))]]
(case (dictionary.get unboxed ..primitives)
(#.Some primitive)
- (wrap (|>> valueI
- (_.PUTSTATIC $class field primitive)
- (_.string synthesis.unit)))
+ (in (|>> valueI
+ (_.PUTSTATIC $class field primitive)
+ (_.string synthesis.unit)))
#.None
- (wrap (|>> valueI
- (_.CHECKCAST $class)
- (_.PUTSTATIC $class field $class)
- (_.string synthesis.unit))))))]))
+ (in (|>> valueI
+ (_.CHECKCAST $class)
+ (_.PUTSTATIC $class field $class)
+ (_.string synthesis.unit))))))]))
(def: get::virtual
Handler
@@ -669,9 +669,9 @@
#.None
(_.GETFIELD $class field (type.class unboxed (list))))]]
- (wrap (|>> objectI
- (_.CHECKCAST $class)
- getI))))]))
+ (in (|>> objectI
+ (_.CHECKCAST $class)
+ getI))))]))
(def: put::virtual
Handler
@@ -690,11 +690,11 @@
(let [$unboxed (type.class unboxed (list))]
(|>> (_.CHECKCAST $unboxed)
(_.PUTFIELD $class field $unboxed))))]]
- (wrap (|>> objectI
- (_.CHECKCAST $class)
- _.DUP
- valueI
- putI))))]))
+ (in (|>> objectI
+ (_.CHECKCAST $class)
+ _.DUP
+ valueI
+ putI))))]))
(type: Input
(Typed Synthesis))
@@ -710,11 +710,11 @@
[valueI (generate archive valueS)]
(case (type.primitive? valueT)
(#.Right valueT)
- (wrap [valueT valueI])
+ (in [valueT valueI])
(#.Left valueT)
- (wrap [valueT (|>> valueI
- (_.CHECKCAST valueT))]))))
+ (in [valueT (|>> valueI
+ (_.CHECKCAST valueT))]))))
(def: voidI
(_.string synthesis.unit))
@@ -735,9 +735,9 @@
(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) (list\map product.left inputsTI) outputT (list)]))
- (prepare_output outputT)))))]))
+ (in (|>> (_.fuse (list\map product.right inputsTI))
+ (_.INVOKESTATIC class method (type.method [(list) (list\map product.left inputsTI) outputT (list)]))
+ (prepare_output outputT)))))]))
(template [<name> <invoke>]
[(def: <name>
@@ -748,15 +748,15 @@
(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)
- (list\map product.left inputsTI)
- outputT
- (list)]))
- (prepare_output outputT)))))]))]
+ (in (|>> objectI
+ (_.CHECKCAST class)
+ (_.fuse (list\map product.right inputsTI))
+ (<invoke> class method
+ (type.method [(list)
+ (list\map product.left inputsTI)
+ outputT
+ (list)]))
+ (prepare_output outputT)))))]))]
[invoke::virtual _.INVOKEVIRTUAL]
[invoke::special _.INVOKESPECIAL]
@@ -770,30 +770,30 @@
(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) (list\map product.left inputsTI) type.void (list)]))))))]))
+ (in (|>> (_.NEW class)
+ _.DUP
+ (_.fuse (list\map product.right inputsTI))
+ (_.INVOKESPECIAL class "<init>" (type.method [(list) (list\map product.left inputsTI) type.void (list)]))))))]))
(def: member_bundle
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))))
+ (dictionary.merged (<| (bundle.prefix "get")
+ (|> (: Bundle bundle.empty)
+ (bundle.install "static" get::static)
+ (bundle.install "virtual" get::virtual))))
+ (dictionary.merged (<| (bundle.prefix "put")
+ (|> (: Bundle bundle.empty)
+ (bundle.install "static" put::static)
+ (bundle.install "virtual" put::virtual))))
+ (dictionary.merged (<| (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
@@ -858,11 +858,11 @@
<synthesis>.tuple
(<>.after <synthesis>.any)
<synthesis>.any)]
- (wrap [environment
- [ownerT name
- strict_fp? annotations vars
- self_name arguments returnT exceptionsT
- (..hidden_method_body (list.size arguments) body)]]))))
+ (in [environment
+ [ownerT name
+ strict_fp? annotations vars
+ self_name arguments returnT exceptionsT
+ (..hidden_method_body (list.size arguments) body)]]))))
(def: (normalize_path normalize)
(-> (-> Synthesis Synthesis)
@@ -918,7 +918,7 @@
(^ (synthesis.variable var))
(|> mapping
(dictionary.get body)
- (maybe.default var)
+ (maybe.else var)
synthesis.variable)
(^ (synthesis.branch/case [inputS pathS]))
@@ -945,7 +945,7 @@
(^ (synthesis.variable var))
(|> mapping
(dictionary.get captured)
- (maybe.default var)
+ (maybe.else var)
synthesis.variable)
_
@@ -991,10 +991,10 @@
(-> Phase Archive (Type Class) (Environment Synthesis) (Operation Inst))
(do {! phase.monad}
[captureI+ (monad.map ! (generate archive) env)]
- (wrap (|>> (_.NEW class)
- _.DUP
- (_.fuse captureI+)
- (_.INVOKESPECIAL class "<init>" (anonymous_init_method env))))))
+ (in (|>> (_.NEW class)
+ _.DUP
+ (_.fuse captureI+)
+ (_.INVOKESPECIAL class "<init>" (anonymous_init_method env))))))
(def: (prepare_argument lux_register argumentT jvm_register)
(-> Register (Type Value) Register [Register Inst])
@@ -1086,7 +1086,7 @@
inputsTS
overriden_methods])
(do {! phase.monad}
- [[context _] (generation.with_new_context archive (wrap []))
+ [[context _] (generation.with_new_context archive (in []))
#let [[module_id artifact_id] context
anonymous_class_name (///.class_name context)
class (type.class anonymous_class_name (list))
@@ -1132,15 +1132,15 @@
[bodyG (generation.with_context artifact_id
(generate archive bodyS))
#let [argumentsT (list\map product.right arguments)]]
- (wrap (_def.method #$.Public
- (if strict_fp?
- ($_ $.++M $.finalM $.strictM)
- $.finalM)
- name
- (type.method [varsT argumentsT returnT exceptionsT])
- (|>> (prepare_arguments 1 argumentsT)
- bodyG
- (returnI returnT)))))))
+ (in (_def.method #$.Public
+ (if strict_fp?
+ ($_ $.++M $.finalM $.strictM)
+ $.finalM)
+ name
+ (type.method [varsT argumentsT returnT exceptionsT])
+ (|>> (prepare_arguments 1 argumentsT)
+ bodyG
+ (returnI returnT)))))))
(\ ! map _def.fuse))
#let [directive [anonymous_class_name
(_def.class #$.V1_6 #$.Public $.finalC
@@ -1164,13 +1164,13 @@
Bundle
(<| (bundle.prefix "jvm")
(|> ..conversion_bundle
- (dictionary.merge ..int_bundle)
- (dictionary.merge ..long_bundle)
- (dictionary.merge ..float_bundle)
- (dictionary.merge ..double_bundle)
- (dictionary.merge ..char_bundle)
- (dictionary.merge ..array_bundle)
- (dictionary.merge ..object_bundle)
- (dictionary.merge ..member_bundle)
- (dictionary.merge ..class_bundle)
+ (dictionary.merged ..int_bundle)
+ (dictionary.merged ..long_bundle)
+ (dictionary.merged ..float_bundle)
+ (dictionary.merged ..double_bundle)
+ (dictionary.merged ..char_bundle)
+ (dictionary.merged ..array_bundle)
+ (dictionary.merged ..object_bundle)
+ (dictionary.merged ..member_bundle)
+ (dictionary.merged ..class_bundle)
)))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index fcbfe1277..bb592ca32 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -115,11 +115,11 @@
(list (_.int +0))
_.fuse)
function.identity)]]
- (wrap (|>> (_.NEW class)
- _.DUP
- (_.fuse captureI+)
- argsI
- (_.INVOKESPECIAL class "<init>" (init_method env arity))))))
+ (in (|>> (_.NEW class)
+ _.DUP
+ (_.fuse captureI+)
+ argsI
+ (_.INVOKESPECIAL class "<init>" (init_method env arity))))))
(def: (reset_method return)
(-> (Type Class) (Type Method))
@@ -301,7 +301,7 @@
))]
(do phase.monad
[instanceI (..instance generate archive classD arity env)]
- (wrap [functionD instanceI]))))
+ (in [functionD instanceI]))))
(def: #export (function' forced_context generate archive [env arity bodyS])
(-> (Maybe Context) (Generator Abstraction))
@@ -312,8 +312,8 @@
(do !
[without_context (generation.with_anchor [@begin 1]
(generate archive bodyS))]
- (wrap [function_context
- without_context]))
+ (in [function_context
+ without_context]))
#.None
(generation.with_new_context archive
@@ -332,8 +332,8 @@
(generation.save! (product.right function_context) #.None directive)
(#.Some function_context)
- (wrap []))]
- (wrap instanceI)))
+ (in []))]
+ (in instanceI)))
(def: #export function
(Generator Abstraction)
@@ -351,5 +351,5 @@
(_.fuse chunkI+)
(_.INVOKEVIRTUAL //.$Function //runtime.apply_method (//runtime.apply_signature (list.size chunkI+))))))
_.fuse)]]
- (wrap (|>> functionI
- applyI))))
+ (in (|>> functionI
+ applyI))))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
index d17d3dfe2..40f8ef0de 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
@@ -55,7 +55,7 @@
valuesI+ (monad.map @ (function (_ [register argS])
(: (Operation Inst)
(if (invariant? register argS)
- (wrap function.identity)
+ (in function.identity)
(translate archive argS))))
pairs)
#let [storesI+ (list@map (function (_ [register argS])
@@ -63,10 +63,10 @@
(if (invariant? register argS)
function.identity
(_.ASTORE register))))
- (list.reverse pairs))]]
- (wrap (|>> (_.fuse valuesI+)
- (_.fuse storesI+)
- (_.GOTO @begin)))))
+ (list.reversed pairs))]]
+ (in (|>> (_.fuse valuesI+)
+ (_.fuse storesI+)
+ (_.GOTO @begin)))))
(def: #export (scope translate archive [start initsS+ iterationS])
(Generator [Nat (List Synthesis) Synthesis])
@@ -80,6 +80,6 @@
(|>> initI
(_.ASTORE (n.+ start register)))))
_.fuse)]]
- (wrap (|>> initializationI
- (_.label @begin)
- iterationI))))
+ (in (|>> initializationI
+ (_.label @begin)
+ iterationI))))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
index 1bced2ffc..2c814d24f 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
@@ -21,7 +21,7 @@
(-> Bit (Operation Inst))
(let [Boolean (type.class "java.lang.Boolean" (list))]
(function (_ value)
- (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean)))))
+ (operation@in (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean)))))
(import: java/lang/Byte
["#::."
@@ -38,13 +38,13 @@
(case (.int value)
(^template [<int> <instruction>]
[<int>
- (operation@wrap (|>> <instruction> (_.wrap type.long)))])
+ (operation@in (|>> <instruction> (_.wrap type.long)))])
([+0 _.LCONST_0]
[+1 _.LCONST_1])
(^template [<int> <instruction>]
[<int>
- (operation@wrap (|>> <instruction> _.I2L (_.wrap type.long)))])
+ (operation@in (|>> <instruction> _.I2L (_.wrap type.long)))])
([-1 _.ICONST_M1]
## [+0 _.ICONST_0]
## [+1 _.ICONST_1]
@@ -64,7 +64,7 @@
## else
(|> value .int _.long))]
- (operation@wrap (|>> constantI (_.wrap type.long))))))
+ (operation@in (|>> constantI (_.wrap type.long))))))
(import: java/lang/Double
["#::."
@@ -79,17 +79,17 @@
(case value
(^template [<int> <instruction>]
[<int>
- (operation@wrap (|>> <instruction> (_.wrap type.double)))])
+ (operation@in (|>> <instruction> (_.wrap type.double)))])
([+1.0 _.DCONST_1])
(^template [<int> <instruction>]
[<int>
- (operation@wrap (|>> <instruction> _.F2D (_.wrap type.double)))])
+ (operation@in (|>> <instruction> _.F2D (_.wrap type.double)))])
([+2.0 _.FCONST_2])
(^template [<int> <instruction>]
[<int>
- (operation@wrap (|>> <instruction> _.I2D (_.wrap type.double)))])
+ (operation@in (|>> <instruction> _.I2D (_.wrap type.double)))])
([-1.0 _.ICONST_M1]
## [+0.0 _.ICONST_0]
## [+1.0 _.ICONST_1]
@@ -105,8 +105,8 @@
(i.= ..d0-bits))
_.DCONST_0
(_.double value))]
- (operation@wrap (|>> constantI (_.wrap type.double))))))
+ (operation@in (|>> constantI (_.wrap type.double))))))
(def: #export text
(-> Text (Operation Inst))
- (|>> _.string operation@wrap))
+ (|>> _.string operation@in))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
index bfbda85be..b2dfe7676 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
@@ -41,10 +41,10 @@
(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)))))
+ (in (|>> (_.ALOAD 0)
+ (_.GETFIELD (type.class class_name (list))
+ (|> variable .nat foreign_name)
+ //.$Value)))))
(def: local
(-> Register Inst)
@@ -54,7 +54,7 @@
(-> Archive Variable (Operation Inst))
(case variable
(#variable.Local variable)
- (operation@wrap (local variable))
+ (operation@in (local variable))
(#variable.Foreign variable)
(foreign archive variable)))
@@ -64,4 +64,4 @@
(do {@ phase.monad}
[class_name (\ @ map //.class_name
(generation.remember archive name))]
- (wrap (_.GETSTATIC (type.class class_name (list)) //.value_field //.$Value))))
+ (in (_.GETSTATIC (type.class class_name (list)) //.value_field //.$Value))))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
index cccdf42bf..e8f678211 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
@@ -351,7 +351,7 @@
(do phase.monad
[_ (generation.execute! directive)
_ (generation.save! ..runtime_id #.None directive)]
- (wrap [..runtime_id #.None bytecode]))))
+ (in [..runtime_id #.None bytecode]))))
(def: function_id
1)
@@ -388,17 +388,17 @@
(do phase.monad
[_ (generation.execute! directive)
_ (generation.save! ..function_id #.None directive)]
- (wrap [..function_id #.None bytecode]))))
+ (in [..function_id #.None bytecode]))))
(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)])))
+ (in [(|> artifact.empty
+ artifact.resource
+ product.right
+ artifact.resource
+ product.right)
+ (row.row runtime_payload
+ function_payload)])))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
index a9666958b..86b4431da 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
@@ -46,21 +46,21 @@
(Generator (List Synthesis))
(do {@ phase.monad}
[#let [size (list.size members)]
- _ (phase.assert ..not_a_tuple size
- (n.>= 2 size))
+ _ (phase.assertion ..not_a_tuple size
+ (n.>= 2 size))
membersI (|> members
list.enumeration
(monad.map @ (function (_ [idx member])
(do @
[memberI (generate archive member)]
- (wrap (|>> _.DUP
- (_.int (.int idx))
- memberI
- _.AASTORE)))))
+ (in (|>> _.DUP
+ (_.int (.int idx))
+ memberI
+ _.AASTORE)))))
(\ @ map _.fuse))]
- (wrap (|>> (_.int (.int size))
- (_.array //runtime.$Value)
- membersI))))
+ (in (|>> (_.int (.int size))
+ (_.array //runtime.$Value)
+ membersI))))
(import: java/lang/Byte
["#::."
@@ -109,12 +109,12 @@
(do phase.monad
[memberI (generate archive member)
#let [tagI (..tagI lefts right?)]]
- (wrap (|>> tagI
- (flagI right?)
- memberI
- (_.INVOKESTATIC //.$Runtime
- "variant_make"
- (type.method [(list)
- (list //runtime.$Tag //runtime.$Flag //runtime.$Value)
- //.$Variant
- (list)]))))))
+ (in (|>> tagI
+ (flagI right?)
+ memberI
+ (_.INVOKESTATIC //.$Runtime
+ "variant_make"
+ (type.method [(list)
+ (list //runtime.$Tag //runtime.$Flag //runtime.$Value)
+ //.$Variant
+ (list)]))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 03:21:38 +0000