aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/directive/jvm.lux263
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/host.lux (renamed from new-luxc/source/luxc/lang/translation/jvm.lux)111
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/packager.lux (renamed from new-luxc/source/luxc/lang/packager.lux)11
3 files changed, 63 insertions, 322 deletions
diff --git a/new-luxc/source/luxc/lang/directive/jvm.lux b/new-luxc/source/luxc/lang/directive/jvm.lux
deleted file mode 100644
index 5c1ddee0d..000000000
--- a/new-luxc/source/luxc/lang/directive/jvm.lux
+++ /dev/null
@@ -1,263 +0,0 @@
-(.module:
- [lux (#- Type Definition)
- [abstract
- ["." monad (#+ do)]]
- [control
- ["<>" parser
- ["<c>" code (#+ Parser)]
- ["<t>" text]]]
- [data
- ["." product]
- [text
- ["%" format (#+ format)]]
- [collection
- ["." list ("#@." functor fold)]
- ["." dictionary]]]
- [type
- ["." check (#+ Check)]]
- [target
- [jvm
- ["." type (#+ Type Constraint Argument Typed)
- [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)]
- [".T" lux]
- ["." signature]
- ["." descriptor (#+ Descriptor)]
- ["." parser]]]]
- [tool
- [compiler
- ["." directive (#+ Handler Bundle)]
- ["." phase
- ["." generation]
- [analysis
- [".A" type]]
- ["." extension
- ["." bundle]
- [analysis
- ["." jvm]]
- [directive
- ["/" lux]]]]]]]
- [luxc
- [lang
- [host
- ["$" jvm (#+ Anchor Inst Definition Operation Phase)
- ["_." def]]]]])
-
-(def: signature (|>> type.signature signature.signature))
-
-(type: Declaration
- [Text (List (Type Var))])
-
-(def: declaration
- (Parser Declaration)
- (<c>.form (<>.and <c>.text (<>.some jvm.var))))
-
-(type: Inheritance
- #FinalI
- #AbstractI
- #DefaultI)
-
-(def: inheritance
- (Parser Inheritance)
- ($_ <>.or
- (<c>.text! "final")
- (<c>.text! "abstract")
- (<c>.text! "default")))
-
-(type: State
- #VolatileS
- #FinalS
- #DefaultS)
-
-(def: state
- (Parser State)
- ($_ <>.or
- (<c>.text! "volatile")
- (<c>.text! "final")
- (<c>.text! "default")))
-
-(type: Annotation Any)
-
-(def: annotation
- (Parser Annotation)
- <c>.any)
-
-(def: field-type
- (Parser (Type Value))
- (<t>.embed parser.value <c>.text))
-
-(type: Constant
- [Text (List Annotation) (Type Value) Code])
-
-(def: constant
- (Parser Constant)
- (<| <c>.form
- (<>.after (<c>.text! "constant"))
- ($_ <>.and
- <c>.text
- (<c>.tuple (<>.some ..annotation))
- ..field-type
- <c>.any
- )))
-
-(type: Variable
- [Text jvm.Visibility State (List Annotation) (Type Value)])
-
-(def: variable
- (Parser Variable)
- (<| <c>.form
- (<>.after (<c>.text! "variable"))
- ($_ <>.and
- <c>.text
- jvm.visibility
- ..state
- (<c>.tuple (<>.some ..annotation))
- ..field-type
- )))
-
-(type: Field
- (#Constant Constant)
- (#Variable Variable))
-
-(def: field
- (Parser Field)
- ($_ <>.or
- ..constant
- ..variable
- ))
-
-(type: Method-Definition
- (#Constructor (jvm.Constructor Code))
- (#Virtual-Method (jvm.Virtual-Method Code))
- (#Static-Method (jvm.Static-Method Code))
- (#Overriden-Method (jvm.Overriden-Method Code)))
-
-(def: method
- (Parser Method-Definition)
- ($_ <>.or
- jvm.constructor-definition
- jvm.virtual-method-definition
- jvm.static-method-definition
- jvm.overriden-method-definition
- ))
-
-(def: (constraint name)
- (-> Text Constraint)
- {#type.name name
- #type.super-class (type.class "java.lang.Object" (list))
- #type.super-interfaces (list)})
-
-(def: jvm::class
- (Handler Anchor Inst Definition)
- (/.custom
- [($_ <>.and
- ..declaration
- jvm.class
- (<c>.tuple (<>.some jvm.class))
- ..inheritance
- (<c>.tuple (<>.some ..annotation))
- (<c>.tuple (<>.some ..field))
- (<c>.tuple (<>.some ..method)))
- (function (_ extension phase
- [[name parameters]
- super-class
- super-interfaces
- inheritance
- ## TODO: Handle annotations.
- annotations
- fields
- methods])
- (do phase.monad
- [parameters (directive.lift-analysis
- (typeA.with-env
- (jvm.parameter-types parameters)))
- #let [mapping (list@fold (function (_ [parameterJ parameterT] mapping)
- (dictionary.put (parser.name parameterJ) parameterT mapping))
- luxT.fresh
- parameters)
- field-definitions (|> fields
- (list@map (function (_ field)
- (case field
- ## TODO: Handle annotations.
- (#Constant [name annotations type value])
- (case value
- (^template [<tag> <field>]
- [_ (<tag> value)]
- (<field> #$.Public ($.++F $.staticF $.finalF) name value))
- ([#.Bit _def.boolean-field]
- [#.Int _def.byte-field]
- [#.Int _def.short-field]
- [#.Int _def.int-field]
- [#.Int _def.long-field]
- [#.Frac _def.float-field]
- [#.Frac _def.double-field]
- [#.Nat _def.char-field]
- [#.Text _def.string-field])
-
- _
- (undefined))
-
- ## TODO: Handle annotations.
- (#Variable [name visibility state annotations type])
- (_def.field visibility
- (case state
- ## TODO: Handle transient & static.
- #VolatileS $.volatileF
- #FinalS $.finalF
- #DefaultS $.noneF)
- name
- type))))
- _def.fuse)]
- super-classT (directive.lift-analysis
- (typeA.with-env
- (luxT.check (luxT.class mapping) (..signature super-class))))
- super-interfaceT+ (directive.lift-analysis
- (typeA.with-env
- (monad.map check.monad
- (|>> ..signature (luxT.check (luxT.class mapping)))
- super-interfaces)))
- #let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list@map product.right parameters))
- super-classT
- super-interfaceT+)]
- state (extension.lift phase.get-state)
- #let [analyse (get@ [#directive.analysis #directive.phase] state)
- synthesize (get@ [#directive.synthesis #directive.phase] state)
- generate (get@ [#directive.generation #directive.phase] state)]
- methods (monad.map @ (function (_ methodC)
- (do @
- [methodA (directive.lift-analysis
- (case methodC
- (#Constructor method)
- (jvm.analyse-constructor-method analyse selfT mapping method)
-
- (#Virtual-Method method)
- (jvm.analyse-virtual-method analyse selfT mapping method)
-
- (#Static-Method method)
- (jvm.analyse-static-method analyse mapping method)
-
- (#Overriden-Method method)
- (jvm.analyse-overriden-method analyse selfT mapping method)))]
- (directive.lift-synthesis
- (synthesize methodA))))
- methods)
- _ (directive.lift-generation
- (generation.save! true ["" name]
- [name
- (_def.class #$.V1_6 #$.Public
- (case inheritance
- #FinalI $.finalC
- ## TODO: Handle abstract classes.
- #AbstractI (undefined)
- #DefaultI $.noneC)
- name (list@map (|>> product.left parser.name ..constraint) parameters)
- super-class super-interfaces
- field-definitions)]))
- #let [_ (log! (format "Class " name))]]
- (wrap directive.no-requirements)))]))
-
-(def: #export bundle
- (Bundle Anchor Inst Definition)
- (<| (bundle.prefix "jvm")
- (|> bundle.empty
- (dictionary.put "class" jvm::class)
- )))
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/host.lux
index fccbd14bf..2892ac045 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/host.lux
@@ -17,39 +17,47 @@
["%" format (#+ format)]]
[collection
["." array]
- ["." dictionary (#+ Dictionary)]]]
+ ["." dictionary (#+ Dictionary)]
+ ["." row]]
+ ["." format #_
+ ["#" binary]]]
[target
[jvm
["." loader (#+ Library)]
+ ["_" bytecode (#+ Bytecode)]
+ ["." modifier (#+ Modifier) ("#@." monoid)]
+ ["." field (#+ Field)]
+ ["." method (#+ Method)]
+ ["." version]
+ ["." class (#+ Class)]
+ ["." encoding #_
+ ["#/." name]]
["." type
["." descriptor]]]]
[tool
[compiler
["." name]]]]
- [///
- [host
- ["." jvm (#+ Inst Definition Host State)
- ["." def]
- ["." inst]]]]
+ ["." // #_
+ ["#." runtime (#+ Definition)]]
)
-(import: org/objectweb/asm/Label)
+(import: #long java/lang/reflect/Field
+ (get [#? java/lang/Object] #try #? java/lang/Object))
-(import: java/lang/reflect/Field
- (get [#? Object] #try #? Object))
+(import: #long (java/lang/Class a)
+ (getField [java/lang/String] #try java/lang/reflect/Field))
-(import: (java/lang/Class a)
- (getField [String] #try Field))
+(import: #long java/lang/Object
+ (getClass [] (java/lang/Class java/lang/Object)))
-(import: java/lang/Object
- (getClass [] (Class Object)))
+(import: #long java/lang/ClassLoader)
-(import: java/lang/ClassLoader)
+(def: value::field "_value")
+(def: value::type (type.class "java.lang.Object" (list)))
+(def: value::modifier ($_ modifier@compose field.public field.final field.static))
-(type: #export ByteCode Binary)
-
-(def: #export value-field Text "_value")
-(def: #export $Value (type.class "java.lang.Object" (list)))
+(def: init::type (type.method [(list) type.void (list)]))
+(def: init::modifier ($_ modifier@compose method.public method.static method.strict))
(exception: #export (cannot-load {class Text} {error Text})
(exception.report
@@ -67,51 +75,53 @@
["Class" class]))
(def: (class-value class-name class)
- (-> Text (Class Object) (Try Any))
- (case (Class::getField ..value-field class)
+ (-> Text (java/lang/Class java/lang/Object) (Try Any))
+ (case (java/lang/Class::getField ..value::field class)
(#try.Success field)
- (case (Field::get #.None field)
+ (case (java/lang/reflect/Field::get #.None field)
(#try.Success ?value)
(case ?value
(#.Some value)
(#try.Success value)
#.None
- (exception.throw invalid-value class-name))
+ (exception.throw ..invalid-value [class-name]))
(#try.Failure error)
- (exception.throw cannot-load [class-name error]))
+ (exception.throw ..cannot-load [class-name error]))
(#try.Failure error)
- (exception.throw invalid-field [class-name ..value-field error])))
+ (exception.throw ..invalid-field [class-name ..value::field error])))
(def: class-path-separator ".")
-(def: (evaluate! library loader eval-class valueI)
- (-> Library ClassLoader Text Inst (Try [Any Definition]))
+(def: (evaluate! library loader eval-class valueG)
+ (-> Library java/lang/ClassLoader Text (Bytecode Any) (Try [Any Definition]))
(let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class)
- bytecode (def.class #jvm.V1_6
- #jvm.Public jvm.noneC
- bytecode-name
- (list) $Value
- (list)
- (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
- ..value-field ..$Value)
- (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM)
- "<clinit>"
- (type.method [(list) type.void (list)])
- (|>> valueI
- (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value)
- inst.RETURN))))]
+ bytecode (class.class version.v6_0
+ class.public
+ (encoding/name.internal bytecode-name)
+ (encoding/name.internal "java.lang.Object") (list)
+ (list (field.field ..value::modifier ..value::field ..value::type (row.row)))
+ (list (method.method ..init::modifier "<clinit>" ..init::type
+ (list)
+ (#.Some
+ ($_ _.compose
+ valueG
+ (_.putstatic (type.class bytecode-name (list)) ..value::field ..value::type)
+ _.return))))
+ (row.row))]
(io.run (do (try.with io.monad)
- [_ (loader.store eval-class bytecode library)
+ [bytecode (:: @ map (format.run class.writer)
+ (io.io bytecode))
+ _ (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]])))))
(def: (execute! library loader temp-label [class-name class-bytecode])
- (-> Library ClassLoader Text Definition (Try Any))
+ (-> Library java/lang/ClassLoader Text Definition (Try Any))
(io.run (do (try.with io.monad)
[existing-class? (|> (atom.read library)
(:: io.monad map (dictionary.contains? class-name))
@@ -122,33 +132,28 @@
(loader.store class-name class-bytecode library))]
(loader.load class-name loader))))
-(def: (define! library loader [module name] valueI)
- (-> Library ClassLoader Name Inst (Try [Text Any Definition]))
+(def: (define! library loader [module name] valueG)
+ (-> Library java/lang/ClassLoader Name (Bytecode Any) (Try [Text Any Definition]))
(let [class-name (format (text.replace-all .module-separator class-path-separator module)
class-path-separator (name.normalize name)
"___" (%.nat (text@hash name)))]
(do try.monad
- [[value definition] (evaluate! library loader class-name valueI)]
+ [[value definition] (evaluate! library loader class-name valueG)]
(wrap [class-name value definition]))))
(def: #export host
- (IO Host)
+ (IO //runtime.Host)
(io (let [library (loader.new-library [])
loader (loader.memory library)]
- (: Host
+ (: //runtime.Host
(structure
- (def: (evaluate! temp-label valueI)
+ (def: (evaluate! temp-label valueG)
(let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
(:: try.monad map product.left
- (..evaluate! library loader eval-class valueI))))
+ (..evaluate! library loader eval-class valueG))))
(def: execute!
(..execute! library loader))
(def: define!
(..define! library loader)))))))
-
-(def: #export $Variant (type.array ..$Value))
-(def: #export $Tuple (type.array ..$Value))
-(def: #export $Function (type.class "LuxFunction" (list)))
-(def: #export $Runtime (type.class "LuxRuntime" (list)))
diff --git a/new-luxc/source/luxc/lang/packager.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/packager.lux
index d72506da2..9400adf1a 100644
--- a/new-luxc/source/luxc/lang/packager.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/packager.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Module Definition)
["." host (#+ import: do-to)]
[data
["." binary (#+ Binary)]
@@ -16,13 +16,12 @@
[tool
[compiler
[phase
- [generation (#+ Buffer Output)]]
+ [generation (#+ Buffer Output)
+ [jvm
+ [runtime (#+ Definition)]]]]
[meta
[archive
- [descriptor (#+ Module)]]]]]]
- [//
- [host
- [jvm (#+ Definition)]]])
+ [descriptor (#+ Module)]]]]]])
(import: #long java/lang/Object)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 17:53:57 +0000