aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/directive/jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'lux-jvm/source/luxc/lang/directive/jvm.lux')
-rw-r--r--lux-jvm/source/luxc/lang/directive/jvm.lux1522
1 files changed, 0 insertions, 1522 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux
deleted file mode 100644
index bff4a1ab4..000000000
--- a/lux-jvm/source/luxc/lang/directive/jvm.lux
+++ /dev/null
@@ -1,1522 +0,0 @@
-(.using
- [library
- [lux {"-" Type Primitive static local}
- ["[0]" ffi {"+" Inheritance Privacy State import:}]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["[0]" pipe]
- ["[0]" try {"+" Try}]
- ["<>" parser
- ["<[0]>" code {"+" Parser}]
- ["<[0]>" text]]]
- [data
- [identity {"+" Identity}]
- [binary {"+" Binary}]
- ["[0]" product]
- [text
- ["%" format {"+" format}]]
- [collection
- [array {"+" Array}]
- ["[0]" list ("[1]#[0]" mix functor monoid)]
- ["[0]" dictionary {"+" Dictionary}]
- ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)]
- ["[0]" set {"+" Set}]]]
- [macro
- ["^" pattern]]
- [math
- [number
- ["[0]" nat]]]
- [target
- ["/" jvm
- [encoding
- ["[0]" name {"+" External}]]
- ["[1][0]" type {"+" Type Typed Constraint}
- [category {"+" Void Value Return Primitive Object Class Var Parameter}]
- ["[0]" parser]
- ["[0]T" lux]
- ["[1]/[0]" signature]
- ["[1]/[0]" descriptor]]]]
- [tool
- [compiler
- ["[0]" phase]
- [language
- [lux
- ["[0]" synthesis {"+" Synthesis}]
- ["[0]" generation]
- ["[0]" directive {"+" Requirements}]
- ["[0]" analysis {"+" Analysis}
- ["[0]A" type]
- ["[0]A" scope]]
- [phase
- ["[0]" extension
- ["[0]" bundle]
- [analysis
- ["//A" jvm]]
- [directive
- ["[0]/" lux]]]]]]
- [meta
- [archive {"+" Archive}
- ["[0]" unit]]
- ["[0]" cache "_"
- ["[1]" artifact]]]]]]]
- [///
- [host
- ["[0]" jvm {"+" Inst}
- ["_" inst]
- ["[0]" def]]]
- [translation
- [jvm
- [extension
- ["//G" host]]]]])
-
-(import: org/objectweb/asm/Label
- "[1]::[0]"
- (new []))
-
-(def: (literal literal)
- (-> /.Literal Inst)
- (case literal
- {/.#Boolean value} (_.boolean value)
- {/.#Int value} (_.int value)
- {/.#Long value} (_.long value)
- {/.#Double value} (_.double value)
- {/.#Char value} (_.char value)
- {/.#String value} (_.string value)))
-
-(def: (constant instruction)
- (-> /.Constant Inst)
- (case instruction
- {/.#BIPUSH constant} (_.BIPUSH constant)
-
- {/.#SIPUSH constant} (_.SIPUSH constant)
-
- {/.#ICONST_M1} _.ICONST_M1
- {/.#ICONST_0} _.ICONST_0
- {/.#ICONST_1} _.ICONST_1
- {/.#ICONST_2} _.ICONST_2
- {/.#ICONST_3} _.ICONST_3
- {/.#ICONST_4} _.ICONST_4
- {/.#ICONST_5} _.ICONST_5
-
- {/.#LCONST_0} _.LCONST_0
- {/.#LCONST_1} _.LCONST_1
-
- {/.#FCONST_0} _.FCONST_0
- {/.#FCONST_1} _.FCONST_1
- {/.#FCONST_2} _.FCONST_2
-
- {/.#DCONST_0} _.DCONST_0
- {/.#DCONST_1} _.DCONST_1
-
- {/.#ACONST_NULL} _.NULL
-
- {/.#LDC literal}
- (..literal literal)
- ))
-
-(def: (int_arithmetic instruction)
- (-> /.Int_Arithmetic Inst)
- (case instruction
- {/.#IADD} _.IADD
- {/.#ISUB} _.ISUB
- {/.#IMUL} _.IMUL
- {/.#IDIV} _.IDIV
- {/.#IREM} _.IREM
- {/.#INEG} _.INEG))
-
-(def: (long_arithmetic instruction)
- (-> /.Long_Arithmetic Inst)
- (case instruction
- {/.#LADD} _.LADD
- {/.#LSUB} _.LSUB
- {/.#LMUL} _.LMUL
- {/.#LDIV} _.LDIV
- {/.#LREM} _.LREM
- {/.#LNEG} _.LNEG))
-
-(def: (float_arithmetic instruction)
- (-> /.Float_Arithmetic Inst)
- (case instruction
- {/.#FADD} _.FADD
- {/.#FSUB} _.FSUB
- {/.#FMUL} _.FMUL
- {/.#FDIV} _.FDIV
- {/.#FREM} _.FREM
- {/.#FNEG} _.FNEG))
-
-(def: (double_arithmetic instruction)
- (-> /.Double_Arithmetic Inst)
- (case instruction
- {/.#DADD} _.DADD
- {/.#DSUB} _.DSUB
- {/.#DMUL} _.DMUL
- {/.#DDIV} _.DDIV
- {/.#DREM} _.DREM
- {/.#DNEG} _.DNEG))
-
-(def: (arithmetic instruction)
- (-> /.Arithmetic Inst)
- (case instruction
- {/.#Int_Arithmetic int_arithmetic}
- (..int_arithmetic int_arithmetic)
-
- {/.#Long_Arithmetic long_arithmetic}
- (..long_arithmetic long_arithmetic)
-
- {/.#Float_Arithmetic float_arithmetic}
- (..float_arithmetic float_arithmetic)
-
- {/.#Double_Arithmetic double_arithmetic}
- (..double_arithmetic double_arithmetic)))
-
-(def: (int_bitwise instruction)
- (-> /.Int_Bitwise Inst)
- (case instruction
- {/.#IOR} _.IOR
- {/.#IXOR} _.IXOR
- {/.#IAND} _.IAND
- {/.#ISHL} _.ISHL
- {/.#ISHR} _.ISHR
- {/.#IUSHR} _.IUSHR))
-
-(def: (long_bitwise instruction)
- (-> /.Long_Bitwise Inst)
- (case instruction
- {/.#LOR} _.LOR
- {/.#LXOR} _.LXOR
- {/.#LAND} _.LAND
- {/.#LSHL} _.LSHL
- {/.#LSHR} _.LSHR
- {/.#LUSHR} _.LUSHR))
-
-(def: (bitwise instruction)
- (-> /.Bitwise Inst)
- (case instruction
- {/.#Int_Bitwise int_bitwise}
- (..int_bitwise int_bitwise)
-
- {/.#Long_Bitwise long_bitwise}
- (..long_bitwise long_bitwise)))
-
-(def: (conversion instruction)
- (-> /.Conversion Inst)
- (case instruction
- {/.#I2B} _.I2B
- {/.#I2S} _.I2S
- {/.#I2L} _.I2L
- {/.#I2F} _.I2F
- {/.#I2D} _.I2D
- {/.#I2C} _.I2C
-
- {/.#L2I} _.L2I
- {/.#L2F} _.L2F
- {/.#L2D} _.L2D
-
- {/.#F2I} _.F2I
- {/.#F2L} _.F2L
- {/.#F2D} _.F2D
-
- {/.#D2I} _.D2I
- {/.#D2L} _.D2L
- {/.#D2F} _.D2F))
-
-(def: (array instruction)
- (-> /.Array Inst)
- (case instruction
- {/.#ARRAYLENGTH} _.ARRAYLENGTH
-
- {/.#NEWARRAY type} (_.NEWARRAY type)
- {/.#ANEWARRAY type} (_.ANEWARRAY type)
-
- {/.#BALOAD} _.BALOAD
- {/.#BASTORE} _.BASTORE
-
- {/.#SALOAD} _.SALOAD
- {/.#SASTORE} _.SASTORE
-
- {/.#IALOAD} _.IALOAD
- {/.#IASTORE} _.IASTORE
-
- {/.#LALOAD} _.LALOAD
- {/.#LASTORE} _.LASTORE
-
- {/.#FALOAD} _.FALOAD
- {/.#FASTORE} _.FASTORE
-
- {/.#DALOAD} _.DALOAD
- {/.#DASTORE} _.DASTORE
-
- {/.#CALOAD} _.CALOAD
- {/.#CASTORE} _.CASTORE
-
- {/.#AALOAD} _.AALOAD
- {/.#AASTORE} _.AASTORE))
-
-(def: (object instruction)
- (-> /.Object Inst)
- (case instruction
- (^.template [<tag> <inst>]
- [{<tag> class field_name field_type}
- (<inst> class field_name field_type)])
- ([/.#GETSTATIC _.GETSTATIC]
- [/.#PUTSTATIC _.PUTSTATIC]
- [/.#GETFIELD _.GETFIELD]
- [/.#PUTFIELD _.PUTFIELD])
-
- {/.#NEW type} (_.NEW type)
-
- {/.#INSTANCEOF type} (_.INSTANCEOF type)
- {/.#CHECKCAST type} (_.CHECKCAST type)
-
- (^.template [<tag> <inst>]
- [{<tag> class method_name method_type}
- (<inst> class method_name method_type)])
- ([/.#INVOKEINTERFACE _.INVOKEINTERFACE]
- [/.#INVOKESPECIAL _.INVOKESPECIAL]
- [/.#INVOKESTATIC _.INVOKESTATIC]
- [/.#INVOKEVIRTUAL _.INVOKEVIRTUAL])
- ))
-
-(def: (local_int instruction)
- (-> /.Local_Int Inst)
- (case instruction
- {/.#ILOAD register} (_.ILOAD register)
- {/.#ISTORE register} (_.ISTORE register)))
-
-(def: (local_long instruction)
- (-> /.Local_Long Inst)
- (case instruction
- {/.#LLOAD register} (_.LLOAD register)
- {/.#LSTORE register} (_.LSTORE register)))
-
-(def: (local_float instruction)
- (-> /.Local_Float Inst)
- (case instruction
- {/.#FLOAD register} (_.FLOAD register)
- {/.#FSTORE register} (_.FSTORE register)))
-
-(def: (local_double instruction)
- (-> /.Local_Double Inst)
- (case instruction
- {/.#DLOAD register} (_.DLOAD register)
- {/.#DSTORE register} (_.DSTORE register)))
-
-(def: (local_object instruction)
- (-> /.Local_Object Inst)
- (case instruction
- {/.#ALOAD register} (_.ALOAD register)
- {/.#ASTORE register} (_.ASTORE register)))
-
-(def: (local instruction)
- (-> /.Local Inst)
- (case instruction
- {/.#Local_Int instruction} (..local_int instruction)
- {/.#IINC register} (_.IINC register)
- {/.#Local_Long instruction} (..local_long instruction)
- {/.#Local_Float instruction} (..local_float instruction)
- {/.#Local_Double instruction} (..local_double instruction)
- {/.#Local_Object instruction} (..local_object instruction)))
-
-(def: (stack instruction)
- (-> /.Stack Inst)
- (case instruction
- {/.#DUP} _.DUP
- {/.#DUP_X1} _.DUP_X1
- {/.#DUP_X2} _.DUP_X2
- {/.#DUP2} _.DUP2
- {/.#DUP2_X1} _.DUP2_X1
- {/.#DUP2_X2} _.DUP2_X2
- {/.#SWAP} _.SWAP
- {/.#POP} _.POP
- {/.#POP2} _.POP2))
-
-(def: (comparison instruction)
- (-> /.Comparison Inst)
- (case instruction
- {/.#LCMP} _.LCMP
-
- {/.#FCMPG} _.FCMPG
- {/.#FCMPL} _.FCMPL
-
- {/.#DCMPG} _.DCMPG
- {/.#DCMPL} _.DCMPL))
-
-(def: (branching instruction)
- (-> (/.Branching org/objectweb/asm/Label) Inst)
- (case instruction
- {/.#IF_ICMPEQ label} (_.IF_ICMPEQ label)
- {/.#IF_ICMPGE label} (_.IF_ICMPGE label)
- {/.#IF_ICMPGT label} (_.IF_ICMPGT label)
- {/.#IF_ICMPLE label} (_.IF_ICMPLE label)
- {/.#IF_ICMPLT label} (_.IF_ICMPLT label)
- {/.#IF_ICMPNE label} (_.IF_ICMPNE label)
- {/.#IFEQ label} (_.IFEQ label)
- {/.#IFGE label} (_.IFGE label)
- {/.#IFGT label} (_.IFGT label)
- {/.#IFLE label} (_.IFLE label)
- {/.#IFLT label} (_.IFLT label)
- {/.#IFNE label} (_.IFNE label)
-
- {/.#TABLESWITCH min max default labels}
- (_.TABLESWITCH min max default labels)
-
- {/.#LOOKUPSWITCH default keys+labels}
- (_.LOOKUPSWITCH default keys+labels)
-
- {/.#IF_ACMPEQ label} (_.IF_ACMPEQ label)
- {/.#IF_ACMPNE label} (_.IF_ACMPNE label)
- {/.#IFNONNULL label} (_.IFNONNULL label)
- {/.#IFNULL label} (_.IFNULL label)))
-
-(def: (exception instruction)
- (-> (/.Exception org/objectweb/asm/Label) Inst)
- (case instruction
- {/.#Try start end handler exception} (_.try start end handler exception)
- {/.#ATHROW} _.ATHROW))
-
-(def: (concurrency instruction)
- (-> /.Concurrency Inst)
- (case instruction
- {/.#MONITORENTER} _.MONITORENTER
- {/.#MONITOREXIT} _.MONITOREXIT))
-
-(def: (return instruction)
- (-> /.Return Inst)
- (case instruction
- {/.#RETURN} _.RETURN
- {/.#IRETURN} _.IRETURN
- {/.#LRETURN} _.LRETURN
- {/.#FRETURN} _.FRETURN
- {/.#DRETURN} _.DRETURN
- {/.#ARETURN} _.ARETURN))
-
-(def: (control instruction)
- (-> (/.Control org/objectweb/asm/Label) Inst)
- (case instruction
- {/.#GOTO label} (_.GOTO label)
- {/.#Branching instruction} (..branching instruction)
- {/.#Exception instruction} (..exception instruction)
- {/.#Concurrency instruction} (..concurrency instruction)
- {/.#Return instruction} (..return instruction)))
-
-(def: (instruction instruction)
- (-> (/.Instruction Inst org/objectweb/asm/Label) Inst)
- (case instruction
- {/.#NOP} _.NOP
- {/.#Constant instruction} (..constant instruction)
- {/.#Arithmetic instruction} (..arithmetic instruction)
- {/.#Bitwise instruction} (..bitwise instruction)
- {/.#Conversion instruction} (..conversion instruction)
- {/.#Array instruction} (..array instruction)
- {/.#Object instruction} (..object instruction)
- {/.#Local instruction} (..local instruction)
- {/.#Stack instruction} (..stack instruction)
- {/.#Comparison instruction} (..comparison instruction)
- {/.#Control instruction} (..control instruction)
- {/.#Embedded embedded} embedded))
-
-(type: Mapping
- (Dictionary /.Label org/objectweb/asm/Label))
-
-(type: (Re_labeler context)
- (-> [Mapping (context /.Label)]
- [Mapping (context org/objectweb/asm/Label)]))
-
-(def: (relabel [mapping label])
- (Re_labeler Identity)
- (case (dictionary.value label mapping)
- {.#Some label}
- [mapping label]
-
- {.#None}
- (let [label' (org/objectweb/asm/Label::new)]
- [(dictionary.has label label' mapping) label'])))
-
-(def: (relabel_branching [mapping instruction])
- (Re_labeler /.Branching)
- (case instruction
- (^.template [<tag>]
- [{<tag> label}
- (let [[mapping label] (..relabel [mapping label])]
- [mapping {<tag> label}])])
- ([/.#IF_ICMPEQ] [/.#IF_ICMPGE] [/.#IF_ICMPGT] [/.#IF_ICMPLE] [/.#IF_ICMPLT] [/.#IF_ICMPNE]
- [/.#IFEQ] [/.#IFNE] [/.#IFGE] [/.#IFGT] [/.#IFLE] [/.#IFLT]
-
- [/.#IF_ACMPEQ] [/.#IF_ACMPNE] [/.#IFNONNULL] [/.#IFNULL])
-
- {/.#TABLESWITCH min max default labels}
- (let [[mapping default] (..relabel [mapping default])
- [mapping labels] (list#mix (function (_ input [mapping output])
- (let [[mapping input] (..relabel [mapping input])]
- [mapping (list& input output)]))
- [mapping (list)] labels)]
- [mapping {/.#TABLESWITCH min max default (list.reversed labels)}])
-
- {/.#LOOKUPSWITCH default keys+labels}
- (let [[mapping default] (..relabel [mapping default])
- [mapping keys+labels] (list#mix (function (_ [expected input] [mapping output])
- (let [[mapping input] (..relabel [mapping input])]
- [mapping (list& [expected input] output)]))
- [mapping (list)] keys+labels)]
- [mapping {/.#LOOKUPSWITCH default (list.reversed keys+labels)}])
- ))
-
-(def: (relabel_exception [mapping instruction])
- (Re_labeler /.Exception)
- (case instruction
- {/.#Try start end handler exception}
- (let [[mapping start] (..relabel [mapping start])
- [mapping end] (..relabel [mapping end])
- [mapping handler] (..relabel [mapping handler])]
- [mapping {/.#Try start end handler exception}])
-
- {/.#ATHROW}
- [mapping {/.#ATHROW}]
- ))
-
-(def: (relabel_control [mapping instruction])
- (Re_labeler /.Control)
- (case instruction
- (^.template [<tag> <relabel>]
- [{<tag> instruction}
- (let [[mapping instruction] (<relabel> [mapping instruction])]
- [mapping {<tag> instruction}])])
- ([/.#GOTO ..relabel]
- [/.#Branching ..relabel_branching]
- [/.#Exception ..relabel_exception])
-
- (^.template [<tag>]
- [{<tag> instruction}
- [mapping {<tag> instruction}]])
- ([/.#Concurrency] [/.#Return])
- ))
-
-(def: (relabel_instruction [mapping instruction])
- (Re_labeler (/.Instruction Inst))
- (case instruction
- {/.#Embedded embedded}
- [mapping {/.#Embedded embedded}]
-
- {/.#NOP}
- [mapping {/.#NOP}]
-
- (^.template [<tag>]
- [{<tag> instruction}
- [mapping {<tag> instruction}]])
- ([/.#Constant]
- [/.#Arithmetic]
- [/.#Bitwise]
- [/.#Conversion]
- [/.#Array]
- [/.#Object]
- [/.#Local]
- [/.#Stack]
- [/.#Comparison])
-
- {/.#Control instruction}
- (let [[mapping instruction] (..relabel_control [mapping instruction])]
- [mapping {/.#Control instruction}])))
-
-(def: (relabel_bytecode [mapping bytecode])
- (Re_labeler (/.Bytecode Inst))
- (sequence#mix (function (_ input [mapping output])
- (let [[mapping input'] (..relabel_instruction [mapping input])]
- [mapping (sequence.suffix input' output)]))
- [mapping (sequence.sequence)]
- bytecode))
-
-(def: fresh
- Mapping
- (dictionary.empty nat.hash))
-
-(def: bytecode
- (-> (/.Bytecode Inst /.Label) jvm.Inst)
- (|>> [..fresh]
- ..relabel_bytecode
- product.right
- (sequence#each ..instruction)
- sequence.list
- _.fuse))
-
-(with_expansions [<anchor> (these jvm.Anchor)
- <expression> (these Inst)
- <directive> (these jvm.Definition)
- <type_vars> (these <anchor> <expression> <directive>)]
- (type: Handler'
- ... (generation.Handler jvm.Anchor (/.Bytecode Inst /.Label) jvm.Definition)
- (-> extension.Name
- (phase.Phase [(extension.Bundle <type_vars>)
- (generation.State <type_vars>)]
- Synthesis
- <expression>)
- (phase.Phase [(extension.Bundle <type_vars>)
- (generation.State <type_vars>)]
- (List Synthesis)
- (/.Bytecode Inst /.Label)))))
-
-(def: (true_handler extender pseudo)
- (-> jvm.Extender Any jvm.Handler)
- (function (_ extension_name phase archive inputs)
- (# phase.monad each
- (|>> (as (/.Bytecode Inst /.Label)) ..bytecode)
- ((extender pseudo) extension_name phase archive inputs))))
-
-(type: Phase (directive.Phase jvm.Anchor jvm.Inst jvm.Definition))
-(type: Operation (directive.Operation jvm.Anchor jvm.Inst jvm.Definition))
-(type: Handler (directive.Handler jvm.Anchor jvm.Inst jvm.Definition))
-
-(def: (def::generation extender)
- (-> jvm.Extender ..Handler)
- (function (handler extension_name phase archive inputsC+)
- (case inputsC+
- (pattern (list nameC valueC))
- (do phase.monad
- [[_ _ name] (lux/.evaluate! archive Text nameC)
- [_ handlerV] (lux/.generator archive (as Text name) ..Handler' valueC)
- _ (|> handlerV
- (..true_handler extender)
- (extension.install extender (as Text name))
- directive.lifted_generation)
- _ (directive.lifted_generation
- (generation.log! (format "Generation " (%.text (as Text name)))))]
- (in directive.no_requirements))
-
- _
- (phase.except extension.invalid_syntax [extension_name %.code inputsC+]))))
-
-(def: .public (custom [parser handler])
- (All (_ i)
- (-> [(Parser i)
- (-> Text ..Phase Archive i (..Operation Requirements))]
- ..Handler))
- (function (_ extension_name phase archive input)
- (case (<code>.result parser input)
- {try.#Success input'}
- (handler extension_name phase archive input')
-
- {try.#Failure error}
- (phase.except extension.invalid_syntax [extension_name %.code input]))))
-
-(type: Declaration
- [External (List (Type Var))])
-
-(template [<name> <type> <parser>]
- [(def: <name>
- (Parser <type>)
- (do [! <>.monad]
- [raw <code>.text]
- (<>.lifted (<text>.result <parser> raw))))]
-
- [class_declaration Declaration parser.declaration']
- [class (Type Class) parser.class]
- [type_variable (Type Var) parser.var]
- [value (Type Value) parser.value]
- [return_type (Type Return) parser.return]
- )
-
-(type: Annotation
- Code)
-
-(def: annotation
- (Parser Annotation)
- <code>.any)
-
-(type: Method_Declaration
- (Record
- [#name Text
- #annotations (List Annotation)
- #type_variables (List (Type Var))
- #exceptions (List (Type Class))
- #arguments (List (Type Value))
- #return (Type Value)]))
-
-(def: method_declaration
- (Parser Method_Declaration)
- (<code>.form
- ($_ <>.and
- <code>.text
- (<code>.tuple (<>.some ..annotation))
- (<code>.tuple (<>.some ..type_variable))
- (<code>.tuple (<>.some ..class))
- (<code>.tuple (<>.some ..value))
- ..value
- )))
-
-(def: java/lang/Object
- (/type.class "java.lang.Object" (list)))
-
-(def: inheritance
- (Parser Inheritance)
- ($_ <>.or
- (<code>.this_text "final")
- (<code>.this_text "abstract")
- (<code>.this_text "default")
- ))
-
-(def: privacy
- (Parser Privacy)
- ($_ <>.or
- (<code>.this_text "public")
- (<code>.this_text "private")
- (<code>.this_text "protected")
- (<code>.this_text "default")
- ))
-
-(def: state
- (Parser State)
- ($_ <>.or
- (<code>.this_text "volatile")
- (<code>.this_text "final")
- (<code>.this_text "default")
- ))
-
-(type: Field
- [Text Privacy State (List Annotation) (Type Value)])
-
-(def: field
- (Parser Field)
- (<code>.form
- (do <>.monad
- [_ (<code>.this_text "variable")
- name <code>.text
- privacy ..privacy
- state ..state
- _ (<code>.tuple (<>.some ..annotation))
- type ..value]
- (in [name privacy state (list) type]))))
-
-(type: Argument
- [Text (Type Value)])
-
-(def: argument
- (Parser Argument)
- (<code>.tuple
- (<>.and <code>.text
- ..value)))
-
-(type: (Constructor a)
- [Privacy Bit (List Annotation) (List (Type Var)) (List (Type Class))
- Text (List Argument) (List (Typed a))
- a])
-
-(type: (Override a)
- [Declaration Text Bit (List Annotation) (List (Type Var))
- Text (List Argument) (Type Return) (List (Type Class))
- a])
-
-(type: (Virtual a)
- [Text Privacy Bit Bit (List Annotation) (List (Type Var))
- Text (List Argument) (Type Return) (List (Type Class))
- a])
-
-(type: (Static a)
- [Text Privacy Bit (List Annotation) (List (Type Var))
- (List Argument) (Type Return) (List (Type Class))
- a])
-
-(type: Abstract
- [Text Privacy (List Annotation) (List (Type Var))
- (List Argument) (Type Return) (List (Type Class))])
-
-(type: (Method a)
- (Variant
- {#Constructor (Constructor a)}
- {#Override (Override a)}
- {#Virtual (Virtual a)}
- {#Static (Static a)}
- {#Abstract Abstract}))
-
-(def: (method_dependencies archive method)
- (-> Archive (Method Synthesis)
- (generation.Operation jvm.Anchor jvm.Inst jvm.Definition
- (Set unit.ID)))
- (case method
- {#Constructor [privacy strict_floating_point? annotations variables exceptions
- self arguments constructor_arguments
- body]}
- (do [! phase.monad]
- [all_super_ctor_dependencies (monad.each ! (|>> product.right (cache.dependencies archive))
- constructor_arguments)
- body_dependencies (cache.dependencies archive body)]
- (in (cache.all (list& body_dependencies all_super_ctor_dependencies))))
-
-
- (^.or {#Override [[parent_name parent_variables] name strict_floating_point? annotations variables
- self arguments return exceptions
- body]}
- {#Virtual [name privacy final? strict_floating_point? annotations variables
- self arguments return exceptions
- body]}
- {#Static [name privacy strict_floating_point? annotations variables
- arguments return exceptions
- body]})
- (cache.dependencies archive body)
-
- {#Abstract _}
- (# phase.monad in unit.none)))
-
-(def: constructor
- (Parser (Constructor Code))
- (let [constructor_argument (is (Parser [(Type Value) Code])
- (<code>.tuple
- (<>.and ..value
- <code>.any)))]
- (<| <code>.form
- (<>.after (<code>.this_text "init"))
- ($_ <>.and
- ..privacy
- <code>.bit
- (<code>.tuple (<>.some ..annotation))
- (<code>.tuple (<>.some ..type_variable))
- (<code>.tuple (<>.some ..class))
- <code>.text
- (<code>.tuple (<>.some ..argument))
- (<code>.tuple (<>.some constructor_argument))
- <code>.any
- ))))
-
-(def: override
- (Parser (Override Code))
- (<| <code>.form
- (<>.after (<code>.this_text "override"))
- ($_ <>.and
- ..class_declaration
- <code>.text
- <code>.bit
- (<code>.tuple (<>.some ..annotation))
- (<code>.tuple (<>.some ..type_variable))
- <code>.text
- (<code>.tuple (<>.some ..argument))
- ..return_type
- (<code>.tuple (<>.some ..class))
- <code>.any
- )))
-
-(def: virtual
- (Parser (Virtual Code))
- (<| <code>.form
- (<>.after (<code>.this_text "virtual"))
- ($_ <>.and
- <code>.text
- ..privacy
- <code>.bit
- <code>.bit
- (<code>.tuple (<>.some ..annotation))
- (<code>.tuple (<>.some ..type_variable))
- <code>.text
- (<code>.tuple (<>.some ..argument))
- ..return_type
- (<code>.tuple (<>.some ..class))
- <code>.any
- )))
-
-(def: static
- (Parser (Static Code))
- (<| <code>.form
- (<>.after (<code>.this_text "static"))
- ($_ <>.and
- <code>.text
- ..privacy
- <code>.bit
- (<code>.tuple (<>.some ..annotation))
- (<code>.tuple (<>.some ..type_variable))
- (<code>.tuple (<>.some ..argument))
- ..return_type
- (<code>.tuple (<>.some ..class))
- <code>.any
- )))
-
-(def: abstract
- (Parser Abstract)
- (<| <code>.form
- (<>.after (<code>.this_text "abstract"))
- ($_ <>.and
- <code>.text
- ..privacy
- (<code>.tuple (<>.some ..annotation))
- (<code>.tuple (<>.some ..type_variable))
- (<code>.tuple (<>.some ..argument))
- ..return_type
- (<code>.tuple (<>.some ..class))
- )))
-
-(def: method
- (Parser (Method Code))
- ($_ <>.or
- ..constructor
- ..override
- ..virtual
- ..static
- ..abstract
- ))
-
-(def: (constraint tv)
- (-> (Type Var) Constraint)
- [/type.#name (parser.name tv)
- /type.#super_class java/lang/Object
- /type.#super_interfaces (list)])
-
-(def: visibility
- (-> ffi.Privacy jvm.Visibility)
- (|>> (pipe.case {ffi.#PublicP} {jvm.#Public}
- {ffi.#PrivateP} {jvm.#Private}
- {ffi.#ProtectedP} {jvm.#Protected}
- {ffi.#DefaultP} {jvm.#Default})))
-
-(def: field_config
- (-> ffi.State jvm.Field_Config)
- (|>> (pipe.case {ffi.#VolatileS} jvm.volatileF
- {ffi.#FinalS} jvm.finalF
- {ffi.#DefaultS} jvm.noneF)))
-
-(def: (field_header [name privacy state annotations type])
- (-> Field jvm.Def)
- (def.field (..visibility privacy) (..field_config state) name type))
-
-(def: (header_value valueT)
- (-> (Type Value) Inst)
- (case (/type.primitive? valueT)
- {.#Left classT}
- _.NULL
-
- {.#Right primitiveT}
- (cond (or (# /type.equivalence = /type.boolean primitiveT)
- (# /type.equivalence = /type.byte primitiveT)
- (# /type.equivalence = /type.short primitiveT)
- (# /type.equivalence = /type.int primitiveT)
- (# /type.equivalence = /type.char primitiveT))
- _.ICONST_0
-
- (# /type.equivalence = /type.long primitiveT)
- _.LCONST_0
-
- (# /type.equivalence = /type.float primitiveT)
- _.FCONST_0
-
- ... (# /type.equivalence = /type.double primitiveT)
- _.DCONST_0)))
-
-(def: (header_return returnT)
- (-> (Type Return) Inst)
- (case (/type.void? returnT)
- {.#Right returnT}
- _.RETURN
-
- {.#Left valueT}
- (case (/type.primitive? valueT)
- {.#Left classT}
- (|>> (header_value classT)
- _.ARETURN)
-
- {.#Right primitiveT}
- (cond (or (# /type.equivalence = /type.boolean primitiveT)
- (# /type.equivalence = /type.byte primitiveT)
- (# /type.equivalence = /type.short primitiveT)
- (# /type.equivalence = /type.int primitiveT)
- (# /type.equivalence = /type.char primitiveT))
- (|>> (header_value primitiveT)
- _.IRETURN)
-
- (# /type.equivalence = /type.long primitiveT)
- (|>> (header_value primitiveT)
- _.LRETURN)
-
- (# /type.equivalence = /type.float primitiveT)
- (|>> (header_value primitiveT)
- _.FRETURN)
-
- ... (# /type.equivalence = /type.double primitiveT)
- (|>> (header_value primitiveT)
- _.DRETURN)))))
-
-(def: constructor_name
- "<init>")
-
-(def: (abstract_method_generation method)
- (-> Abstract jvm.Def)
- (let [[name privacy annotations variables
- arguments return exceptions] method]
- (def.abstract_method (..visibility privacy)
- jvm.noneM
- name
- (/type.method [variables (list#each product.right arguments) return exceptions]))))
-
-(def: (method_header super_class method)
- (-> (Type Class) (Method Code) jvm.Def)
- (case method
- {#Constructor [privacy strict_floating_point? annotations variables exceptions
- self arguments constructor_arguments
- body]}
- (let [[super_name super_vars] (parser.read_class super_class)
- init_constructor_arguments (|> constructor_arguments
- (list#each (|>> product.left ..header_value))
- _.fuse)
- super_constructorT (/type.method [(list)
- (list#each product.left constructor_arguments)
- /type.void
- (list)])]
- (def.method (..visibility privacy)
- (if strict_floating_point?
- jvm.strictM
- jvm.noneM)
- ..constructor_name
- (/type.method [variables (list#each product.right arguments) /type.void exceptions])
- (|>> (_.ALOAD 0)
- init_constructor_arguments
- (_.INVOKESPECIAL super_class ..constructor_name super_constructorT)
- _.RETURN)))
-
- {#Override [[parent_name parent_variables] name strict_floating_point? annotations variables
- self arguments return exceptions
- body]}
- (def.method {jvm.#Public}
- (if strict_floating_point?
- jvm.strictM
- jvm.noneM)
- name
- (/type.method [variables (list#each product.right arguments) return exceptions])
- (..header_return return))
-
- {#Virtual [name privacy final? strict_floating_point? annotations variables
- self arguments return exceptions
- body]}
- (def.method (..visibility privacy)
- (|> jvm.noneM
- (jvm.++M (if strict_floating_point?
- jvm.strictM
- jvm.noneM))
- (jvm.++M (if final?
- jvm.finalM
- jvm.noneM)))
- name
- (/type.method [variables (list#each product.right arguments) return exceptions])
- (..header_return return))
-
- {#Static [name privacy strict_floating_point? annotations variables
- arguments return exceptions
- body]}
- (def.method (..visibility privacy)
- (|> jvm.staticM
- (jvm.++M (if strict_floating_point?
- jvm.strictM
- jvm.noneM)))
- name
- (/type.method [variables (list#each product.right arguments) return exceptions])
- (..header_return return))
-
- {#Abstract method}
- (..abstract_method_generation method)
- ))
-
-(def: (header [class_name type_variables]
- super_class
- super_interfaces
- inheritance
- fields
- methods)
- (-> Declaration
- (Type Class)
- (List (Type Class))
- Inheritance
- (List Field)
- (List (Method Code))
- [External Binary])
- (let [constraints (list#each ..constraint type_variables)
- field_definitions (list#each ..field_header fields)
- method_definitions (list#each (..method_header super_class) methods)
- definitions (def.fuse (list#composite field_definitions
- method_definitions))]
- [class_name
- (case inheritance
- {ffi.#DefaultI}
- (def.class {jvm.#V1_6} {jvm.#Public} jvm.noneC class_name constraints super_class super_interfaces
- definitions)
-
- {ffi.#FinalI}
- (def.class {jvm.#V1_6} {jvm.#Public} jvm.finalC class_name constraints super_class super_interfaces
- definitions)
-
- {ffi.#AbstractI}
- (def.abstract {jvm.#V1_6} {jvm.#Public} jvm.noneC class_name constraints super_class super_interfaces
- definitions))]))
-
-(def: (constructor_method_analysis archive [class_name class_tvars] method)
- (-> Archive Declaration (Constructor Code) (Operation (Constructor Analysis)))
- (do [! phase.monad]
- [.let [[privacy strict_floating_point? annotations method_tvars exceptions
- self arguments constructor_argumentsC
- bodyC] method]
- analyse directive.analysis]
- (directive.lifted_analysis
- (do !
- [mapping (//A.with_fresh_type_vars class_tvars luxT.fresh)
- mapping (//A.with_fresh_type_vars method_tvars mapping)
- constructor_argumentsA (monad.each ! (function (_ [typeJ termC])
- (do !
- [typeL (//A.reflection_type mapping typeJ)
- termA (<| (typeA.expecting typeL)
- (analyse archive termC))]
- (in [typeJ termA])))
- constructor_argumentsC)
- selfT (//A.reflection_type mapping (/type.class class_name class_tvars))
- arguments' (monad.each !
- (function (_ [name type])
- (# ! each (|>> [name])
- (//A.boxed_reflection_type mapping type)))
- arguments)
- returnT (//A.boxed_reflection_return mapping /type.void)
- [_scope bodyA] (|> arguments'
- {.#Item [self selfT]}
- list.reversed
- (list#mix scopeA.with_local (analyse archive bodyC))
- (typeA.expecting returnT)
- scopeA.with)]
- (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)))
- (do [! phase.monad]
- [.let [[[super_name super_tvars] method_name strict_floating_point? annotations
- method_tvars self arguments returnJ exceptionsJ
- bodyC] method]
- analyse directive.analysis]
- (directive.lifted_analysis
- (do !
- [mapping (//A.with_fresh_type_vars class_tvars luxT.fresh)
- .let [parent_type (/type.class super_name super_tvars)]
- mapping (//A.with_override_mapping supers parent_type mapping)
- mapping (//A.with_fresh_type_vars method_tvars mapping)
- selfT (//A.reflection_type mapping (/type.class class_name class_tvars))
- arguments' (monad.each !
- (function (_ [name type])
- (# ! each (|>> [name])
- (//A.boxed_reflection_type mapping type)))
- arguments)
- returnT (//A.boxed_reflection_return mapping returnJ)
- [_scope bodyA] (|> arguments'
- {.#Item [self selfT]}
- list.reversed
- (list#mix scopeA.with_local (analyse archive bodyC))
- (typeA.expecting returnT)
- scopeA.with)]
- (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)))
- (do [! phase.monad]
- [.let [[name privacy final? strict_floating_point? annotations method_tvars
- self arguments returnJ exceptionsJ
- bodyC] method]
- analyse directive.analysis]
- (directive.lifted_analysis
- (do !
- [mapping (//A.with_fresh_type_vars class_tvars luxT.fresh)
- mapping (//A.with_fresh_type_vars method_tvars mapping)
- selfT (//A.reflection_type mapping (/type.class class_name class_tvars))
- arguments' (monad.each !
- (function (_ [name type])
- (# ! each (|>> [name])
- (//A.boxed_reflection_type mapping type)))
- arguments)
- returnT (//A.boxed_reflection_return mapping returnJ)
- [_scope bodyA] (|> arguments'
- {.#Item [self selfT]}
- list.reversed
- (list#mix scopeA.with_local (analyse archive bodyC))
- (typeA.expecting returnT)
- scopeA.with)]
- (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)))
- (do [! phase.monad]
- [.let [[name privacy strict_floating_point? annotations method_tvars
- arguments returnJ exceptionsJ
- bodyC] method]
- analyse directive.analysis]
- (directive.lifted_analysis
- (do !
- [mapping (//A.with_fresh_type_vars method_tvars luxT.fresh)
- arguments' (monad.each !
- (function (_ [name type])
- (# ! each (|>> [name])
- (//A.boxed_reflection_type mapping type)))
- arguments)
- returnT (//A.boxed_reflection_return mapping returnJ)
- [_scope bodyA] (|> arguments'
- list.reversed
- (list#mix scopeA.with_local (analyse archive bodyC))
- (typeA.expecting returnT)
- scopeA.with)]
- (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)))
- (case method
- {#Constructor method}
- (# phase.monad each (|>> {#Constructor})
- (constructor_method_analysis archive declaration method))
-
- {#Override method}
- (# phase.monad each (|>> {#Override})
- (override_method_analysis archive declaration supers method))
-
- {#Virtual method}
- (# phase.monad each (|>> {#Virtual})
- (virtual_method_analysis archive declaration method))
-
- {#Static method}
- (# phase.monad each (|>> {#Static})
- (static_method_analysis archive method))
-
- {#Abstract method}
- (# phase.monad in {#Abstract method})
- ))
-
-(template: (method_body <bodyS>)
- [(<| synthesis.function/abstraction [_ _]
- synthesis.loop/scope [_ _]
- synthesis.tuple
- (list _)
- <bodyS>)])
-
-(def: (constructor_method_synthesis archive method)
- (-> Archive (Constructor Analysis) (Operation (Constructor Synthesis)))
- (do [! phase.monad]
- [.let [[privacy strict_floating_point? annotations method_tvars exceptions
- self arguments constructor_argumentsA
- bodyA] method]
- synthesise directive.synthesis]
- (directive.lifted_synthesis
- (do !
- [constructor_argumentsS (monad.each ! (function (_ [typeJ termA])
- (# ! each (|>> [typeJ])
- (synthesise archive termA)))
- constructor_argumentsA)
- bodyS (synthesise archive {analysis.#Function (list) (//A.hidden_method_body (list.size arguments) bodyA)})]
- (in [privacy strict_floating_point? annotations method_tvars exceptions
- self arguments constructor_argumentsS
- (case bodyS
- (pattern (method_body bodyS))
- bodyS
-
- _
- bodyS)])))))
-
-(def: (override_method_synthesis archive method)
- (-> Archive (Override Analysis) (Operation (Override Synthesis)))
- (do [! phase.monad]
- [.let [[[super_name super_tvars] method_name strict_floating_point? annotations
- method_tvars self arguments returnJ exceptionsJ
- bodyA] method]
- synthesise directive.synthesis]
- (directive.lifted_synthesis
- (do !
- [bodyS (synthesise archive {analysis.#Function (list) (//A.hidden_method_body (list.size arguments) bodyA)})]
- (in [[super_name super_tvars] method_name strict_floating_point? annotations
- method_tvars self arguments returnJ exceptionsJ
- (case bodyS
- (pattern (method_body bodyS))
- bodyS
-
- _
- bodyS)])))))
-
-(def: (virtual_method_synthesis archive method)
- (-> Archive (Virtual Analysis) (Operation (Virtual Synthesis)))
- (do [! phase.monad]
- [.let [[name privacy final? strict_floating_point? annotations method_tvars
- self arguments returnJ exceptionsJ
- bodyA] method]
- synthesise directive.synthesis]
- (directive.lifted_synthesis
- (do !
- [bodyS (synthesise archive {analysis.#Function (list) (//A.hidden_method_body (list.size arguments) bodyA)})]
- (in [name privacy final? strict_floating_point? annotations method_tvars
- self arguments returnJ exceptionsJ
- (case bodyS
- (pattern (method_body bodyS))
- bodyS
-
- _
- bodyS)])))))
-
-(def: (static_method_synthesis archive method)
- (-> Archive (Static Analysis) (Operation (Static Synthesis)))
- (do [! phase.monad]
- [.let [[name privacy strict_floating_point? annotations method_tvars
- arguments returnJ exceptionsJ
- bodyA] method]
- synthesise directive.synthesis]
- (directive.lifted_synthesis
- (do !
- [bodyS (synthesise archive {analysis.#Function (list) (//A.hidden_method_body (list.size arguments) bodyA)})]
- (in [name privacy strict_floating_point? annotations method_tvars
- arguments returnJ exceptionsJ
- (case bodyS
- (pattern (method_body bodyS))
- bodyS
-
- _
- bodyS)])))))
-
-(def: (method_synthesis archive method)
- (-> Archive (Method Analysis) (Operation (Method Synthesis)))
- (case method
- {#Constructor method}
- (# phase.monad each (|>> {#Constructor})
- (constructor_method_synthesis archive method))
-
- {#Override method}
- (# phase.monad each (|>> {#Override})
- (override_method_synthesis archive method))
-
- {#Virtual method}
- (# phase.monad each (|>> {#Virtual})
- (virtual_method_synthesis archive method))
-
- {#Static method}
- (# phase.monad each (|>> {#Static})
- (static_method_synthesis archive method))
-
- {#Abstract method}
- (# phase.monad in {#Abstract method})
- ))
-
-(def: (constructor_method_generation archive super_class method)
- (-> Archive (Type Class) (Constructor Synthesis) (Operation jvm.Def))
- (do [! phase.monad]
- [.let [[privacy strict_floating_point? annotations method_tvars exceptions
- self arguments constructor_argumentsS
- bodyS] method]
- generate directive.generation]
- (directive.lifted_generation
- (do !
- [constructor_argumentsG (monad.each ! (|>> product.right (generate archive))
- constructor_argumentsS)
- bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS))
- .let [[super_name super_vars] (parser.read_class super_class)
- super_constructor_argument_values (_.fuse constructor_argumentsG)
- super_constructorT (/type.method [(list)
- (list#each product.left constructor_argumentsS)
- /type.void
- (list)])
- argumentsT (list#each product.right arguments)
- initialize_object! (is Inst
- (|>> (_.ALOAD 0)
- super_constructor_argument_values
- (_.INVOKESPECIAL super_class ..constructor_name super_constructorT)))]]
- (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))
- (do [! phase.monad]
- [.let [[[super_name super_tvars] method_name strict_floating_point? annotations
- method_tvars self arguments returnJ exceptionsJ
- bodyS] method]
- generate directive.generation]
- (directive.lifted_generation
- (do !
- [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS))
- .let [argumentsT (list#each product.right arguments)]]
- (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))
- (do [! phase.monad]
- [.let [[method_name privacy final? strict_floating_point? annotations method_tvars
- self arguments returnJ exceptionsJ
- bodyS] method]
- generate directive.generation]
- (directive.lifted_generation
- (do !
- [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS))
- .let [argumentsT (list#each product.right arguments)]]
- (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))
- (do [! phase.monad]
- [.let [[method_name privacy strict_floating_point? annotations method_tvars
- arguments returnJ exceptionsJ
- bodyS] method]
- generate directive.generation]
- (directive.lifted_generation
- (do !
- [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS))
- .let [argumentsT (list#each product.right arguments)]]
- (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))
- (case method
- {#Constructor method}
- (..constructor_method_generation archive super_class method)
-
- {#Override method}
- (..override_method_generation archive method)
-
- {#Virtual method}
- (..virtual_method_generation archive method)
-
- {#Static method}
- (..static_method_generation archive method)
-
- {#Abstract method}
- (# phase.monad in (..abstract_method_generation method))
- ))
-
-(import: java/lang/ClassLoader)
-
-(def: (convert_overriden_method method)
- (-> (Method Code) (Maybe (//A.Overriden_Method Code)))
- (case method
- {#Override [[parent_name parent_variables] method_name strict_floating_point? annotations variables
- self arguments return exceptions
- body]}
- {.#Some [(/type.class parent_name parent_variables) method_name
- strict_floating_point? (list) variables
- self arguments return exceptions
- body]}
-
- _
- {.#None}))
-
-(def: (jvm::class class_loader)
- (-> java/lang/ClassLoader ..Handler)
- (..custom
- [($_ <>.and
- ..class_declaration
- ..class
- (<code>.tuple (<>.some ..class))
- ..inheritance
- (<code>.tuple (<>.some ..annotation))
- (<code>.tuple (<>.some ..field))
- (<code>.tuple (<>.some ..method)))
- (function (_ extension_name phase archive
- [declaration
- super_class
- super_interfaces
- inheritance
- annotations
- fields
- methodsC])
- (do [! phase.monad]
- [.let [[class_name type_variables] declaration
- header (..header [class_name type_variables]
- super_class
- super_interfaces
- inheritance
- fields
- methodsC)]
- ... Necessary for reflection to work properly during analysis.
- _ (directive.lifted_generation
- (generation.execute! header))
- .let [supers (is (List (Type Class))
- (list& super_class super_interfaces))]
- _ (|> methodsC
- (list.all ..convert_overriden_method)
- (//A.require_complete_method_concretion class_loader supers)
- directive.lifted_analysis)
- methodsA (monad.each ! (method_analysis archive declaration supers) methodsC)
- methodsS (monad.each ! (method_synthesis archive) methodsA)
- methodsG (monad.each ! (method_generation archive super_class) methodsS)
- all_dependencies (|> methodsS
- (monad.each ! (method_dependencies archive))
- (# ! each cache.all)
- directive.lifted_generation)
- .let [directive [class_name
- (def.class {jvm.#V1_6} {jvm.#Public} jvm.noneC class_name
- (list#each ..constraint type_variables)
- super_class
- super_interfaces
- (def.fuse (list#composite (list#each ..field_header fields)
- methodsG)))]]]
- (directive.lifted_generation
- (do !
- [artifact_id (generation.learn_custom class_name all_dependencies)
- _ (generation.execute! directive)
- _ (generation.save! artifact_id {.#Some class_name} directive)
- _ (generation.log! (format "JVM Class " (%.text class_name)))]
- (in directive.no_requirements)))))]))
-
-(def: jvm::class::interface
- ..Handler
- (..custom
- [($_ <>.and
- ..class_declaration
- (<code>.tuple (<>.some ..class))
- (<code>.tuple (<>.some ..annotation))
- (<>.some ..method_declaration))
- (function (_ extension_name phase archive [[class_name type_variables] supers annotations method_declarations])
- (do [! phase.monad]
- [.let [directive [class_name
- (def.interface {jvm.#V1_6} {jvm.#Public} jvm.noneC class_name
- (list#each ..constraint type_variables)
- supers
- (|> method_declarations
- (list#each (function (_ (open "_[0]"))
- (def.abstract_method {jvm.#Public} jvm.noneM _#name
- (/type.method [_#type_variables _#arguments _#return _#exceptions]))))
- def.fuse))]]]
- (directive.lifted_generation
- (do !
- [artifact_id (generation.learn_custom class_name unit.none)
- _ (generation.execute! directive)
- _ (generation.save! artifact_id {.#Some class_name} directive)
- _ (generation.log! (format "JVM Interface " (%.text class_name)))]
- (in directive.no_requirements)))))]))
-
-(def: .public (bundle class_loader extender)
- (-> java/lang/ClassLoader jvm.Extender (directive.Bundle jvm.Anchor jvm.Inst jvm.Definition))
- (|> bundle.empty
- (dictionary.has "lux def generation" (..def::generation extender))
- (dictionary.has "jvm class" (..jvm::class class_loader))
- (dictionary.has "jvm class interface" ..jvm::class::interface)))