aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source')
-rw-r--r--new-luxc/source/luxc/lang/directive/jvm.lux263
-rw-r--r--new-luxc/source/luxc/lang/packager.lux112
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux154
-rw-r--r--new-luxc/source/program.lux112
4 files changed, 20 insertions, 621 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/packager.lux b/new-luxc/source/luxc/lang/packager.lux
deleted file mode 100644
index d72506da2..000000000
--- a/new-luxc/source/luxc/lang/packager.lux
+++ /dev/null
@@ -1,112 +0,0 @@
-(.module:
- [lux #*
- ["." host (#+ import: do-to)]
- [data
- ["." binary (#+ Binary)]
- ["." text]
- [number
- ["n" nat]]
- [collection
- ["." row]
- ["." list ("#@." fold)]]]
- [target
- [jvm
- [encoding
- ["." name (#+ External)]]]]
- [tool
- [compiler
- [phase
- [generation (#+ Buffer Output)]]
- [meta
- [archive
- [descriptor (#+ Module)]]]]]]
- [//
- [host
- [jvm (#+ Definition)]]])
-
-(import: #long java/lang/Object)
-
-(import: #long java/lang/String)
-
-(import: #long java/util/jar/Attributes
- (put [java/lang/Object java/lang/Object] #? java/lang/Object))
-
-(import: #long java/util/jar/Attributes$Name
- (#static MAIN_CLASS java/util/jar/Attributes$Name)
- (#static MANIFEST_VERSION java/util/jar/Attributes$Name))
-
-(import: #long java/util/jar/Manifest
- (new [])
- (getMainAttributes [] java/util/jar/Attributes))
-
-(import: #long java/io/Flushable
- (flush [] void))
-
-(import: #long java/io/Closeable
- (close [] void))
-
-(import: #long java/io/OutputStream)
-
-(import: #long java/io/ByteArrayOutputStream
- (new [int])
- (toByteArray [] [byte]))
-
-(import: #long java/util/zip/ZipEntry)
-
-(import: #long java/util/zip/ZipOutputStream
- (write [[byte] int int] void)
- (closeEntry [] void))
-
-(import: #long java/util/jar/JarEntry
- (new [java/lang/String]))
-
-(import: #long java/util/jar/JarOutputStream
- (new [java/io/OutputStream java/util/jar/Manifest])
- (putNextEntry [java/util/zip/ZipEntry] void))
-
-(def: byte 1)
-## https://en.wikipedia.org/wiki/Kibibyte
-(def: kibi-byte (n.* 1,024 byte))
-## https://en.wikipedia.org/wiki/Mebibyte
-(def: mebi-byte (n.* 1,024 kibi-byte))
-
-(def: manifest-version "1.0")
-
-(def: class-name
- (-> Text Text)
- (text.suffix ".class"))
-
-(def: (manifest program-class)
- (-> External java/util/jar/Manifest)
- (let [manifest (java/util/jar/Manifest::new)]
- (exec (do-to (java/util/jar/Manifest::getMainAttributes manifest)
- (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) program-class)
- (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest-version))
- manifest)))
-
-(def: (write-class [def-name [class-name bytecode]] sink)
- (-> [Name Definition] java/util/jar/JarOutputStream java/util/jar/JarOutputStream)
- (let [class-name (|> class-name name.internal name.read ..class-name)]
- (do-to sink
- (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class-name))
- (java/util/zip/ZipOutputStream::write bytecode +0 (.int (binary.size bytecode)))
- (java/io/Flushable::flush)
- (java/util/zip/ZipOutputStream::closeEntry))))
-
-(def: (write-module [module classes] sink)
- (-> [Module (Buffer Definition)] java/util/jar/JarOutputStream java/util/jar/JarOutputStream)
- (|> classes
- row.to-list
- (list@fold ..write-class sink)))
-
-(def: #export (package program-class outputs)
- (-> External (Output Definition) Binary)
- (let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi-byte))
- sink (java/util/jar/JarOutputStream::new buffer (manifest program-class))]
- (exec (|> outputs
- row.to-list
- (list@fold ..write-module sink))
- (do-to sink
- (java/io/Flushable::flush)
- (java/io/Closeable::close))
- (java/io/ByteArrayOutputStream::toByteArray buffer))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
deleted file mode 100644
index fccbd14bf..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ /dev/null
@@ -1,154 +0,0 @@
-(.module:
- [lux (#- Definition)
- ["." host (#+ import: do-to object)]
- [abstract
- [monad (#+ do)]]
- [control
- pipe
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]
- ["." io (#+ IO io)]
- [concurrency
- ["." atom (#+ Atom atom)]]]
- [data
- [binary (#+ Binary)]
- ["." product]
- ["." text ("#@." hash)
- ["%" format (#+ format)]]
- [collection
- ["." array]
- ["." dictionary (#+ Dictionary)]]]
- [target
- [jvm
- ["." loader (#+ Library)]
- ["." type
- ["." descriptor]]]]
- [tool
- [compiler
- ["." name]]]]
- [///
- [host
- ["." jvm (#+ Inst Definition Host State)
- ["." def]
- ["." inst]]]]
- )
-
-(import: org/objectweb/asm/Label)
-
-(import: java/lang/reflect/Field
- (get [#? Object] #try #? Object))
-
-(import: (java/lang/Class a)
- (getField [String] #try Field))
-
-(import: java/lang/Object
- (getClass [] (Class Object)))
-
-(import: java/lang/ClassLoader)
-
-(type: #export ByteCode Binary)
-
-(def: #export value-field Text "_value")
-(def: #export $Value (type.class "java.lang.Object" (list)))
-
-(exception: #export (cannot-load {class Text} {error Text})
- (exception.report
- ["Class" class]
- ["Error" error]))
-
-(exception: #export (invalid-field {class Text} {field Text} {error Text})
- (exception.report
- ["Class" class]
- ["Field" field]
- ["Error" error]))
-
-(exception: #export (invalid-value {class Text})
- (exception.report
- ["Class" class]))
-
-(def: (class-value class-name class)
- (-> Text (Class Object) (Try Any))
- (case (Class::getField ..value-field class)
- (#try.Success field)
- (case (Field::get #.None field)
- (#try.Success ?value)
- (case ?value
- (#.Some value)
- (#try.Success value)
-
- #.None
- (exception.throw invalid-value class-name))
-
- (#try.Failure error)
- (exception.throw cannot-load [class-name error]))
-
- (#try.Failure 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]))
- (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))))]
- (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]])))))
-
-(def: (execute! library loader temp-label [class-name class-bytecode])
- (-> Library ClassLoader Text Definition (Try Any))
- (io.run (do (try.with io.monad)
- [existing-class? (|> (atom.read library)
- (:: io.monad map (dictionary.contains? class-name))
- (try.lift io.monad)
- (: (IO (Try Bit))))
- _ (if existing-class?
- (wrap [])
- (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]))
- (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)]
- (wrap [class-name value definition]))))
-
-(def: #export host
- (IO Host)
- (io (let [library (loader.new-library [])
- loader (loader.memory library)]
- (: Host
- (structure
- (def: (evaluate! temp-label valueI)
- (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
- (:: try.monad map product.left
- (..evaluate! library loader eval-class valueI))))
-
- (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/program.lux b/new-luxc/source/program.lux
index f975d2a87..2b2278cec 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Definition)
["@" target]
["." host (#+ import:)]
[abstract
@@ -19,33 +19,28 @@
["." file]]
[target
[jvm
- ["$t" type]]]
+ [bytecode (#+ Bytecode)]]]
[tool
[compiler
[phase
["." macro (#+ Expander)]
[extension (#+ Phase Bundle Operation Handler Extender)
["." analysis #_
- ["#" jvm]]]]
+ ["#" jvm]]
+ ["." directive #_
+ ["#" jvm]]]
+ ["." generation #_
+ ["#" jvm/extension]
+ ["." jvm
+ ["." runtime (#+ Anchor Definition)]
+ ["#/." program]
+ ["." packager]
+ ["#/." host]]]]
[default
["." platform (#+ Platform)]]]]]
[program
["/" compositor
- ["/." cli]]]
- [luxc
- [lang
- ["." packager]
- [host
- ["_" jvm
- ["$d" def]
- ["$i" inst]]]
- ["." directive #_
- ["#" jvm]]
- [translation
- ["." jvm
- ["." runtime]
- ["." expression]
- ["translation" extension]]]]])
+ ["/." cli]]])
(import: #long java/lang/reflect/Method
(invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))
@@ -90,81 +85,14 @@
apply-method))))
(def: #export platform
- (IO (Platform IO _.Anchor _.Inst _.Definition))
+ (IO (Platform IO Anchor (Bytecode Any) Definition))
(do io.monad
- [host jvm.host]
+ [host jvm/host.host]
(wrap {#platform.&monad io.monad
#platform.&file-system file.system
#platform.host host
- #platform.phase expression.translate
- #platform.runtime runtime.translate})))
-
-(def: program-class "LuxProgram")
-
-(def: #export (program programI)
- (-> _.Inst _.Definition)
- (let [$Object ($t.class "java.lang.Object" (list))
- nilI runtime.noneI
- num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH)
- decI (|>> ($i.int +1) $i.ISUB)
- headI (|>> $i.DUP
- ($i.ALOAD 0)
- $i.SWAP
- $i.AALOAD
- $i.SWAP
- $i.DUP_X2
- $i.POP)
- pairI (|>> ($i.int +2)
- ($i.ANEWARRAY $Object)
- $i.DUP_X1
- $i.SWAP
- ($i.int +0)
- $i.SWAP
- $i.AASTORE
- $i.DUP_X1
- $i.SWAP
- ($i.int +1)
- $i.SWAP
- $i.AASTORE)
- consI (|>> ($i.int +1)
- ($i.string "")
- $i.DUP2_X1
- $i.POP2
- runtime.variantI)
- prepare-input-listI (<| $i.with-label (function (_ @loop))
- $i.with-label (function (_ @end))
- (|>> nilI
- num-inputsI
- ($i.label @loop)
- decI
- $i.DUP
- ($i.IFLT @end)
- headI
- pairI
- consI
- $i.SWAP
- ($i.GOTO @loop)
- ($i.label @end)
- $i.POP))
- feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))
- run-ioI (|>> ($i.CHECKCAST jvm.$Function)
- $i.NULL
- ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)))
- main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list))))
- $t.void
- (list)])]
- [..program-class
- ($d.class #_.V1_6
- #_.Public _.finalC
- ..program-class
- (list) $Object
- (list)
- (|>> ($d.method #_.Public _.staticM "main" main-type
- (|>> programI
- prepare-input-listI
- feed-inputsI
- run-ioI
- $i.RETURN))))]))
+ #platform.phase jvm.generate
+ #platform.runtime runtime.generate})))
(def: extender
Extender
@@ -204,9 +132,9 @@
..expander
analysis.bundle
..platform
- translation.bundle
+ generation.bundle
directive.bundle
- ..program
+ jvm/program.program
..extender
service
- [(packager.package ..program-class) jar-path])))
+ [(packager.package jvm/program.class) jar-path])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:43:23 +0000