From fa37f5d17184db1ed95949352e71542af8fb4ce1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 24 Dec 2019 23:05:30 -0400 Subject: Ported program generation, host environment and packaging machinery to stdlib. --- new-luxc/source/luxc/lang/directive/jvm.lux | 263 ---------------------------- 1 file changed, 263 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/directive/jvm.lux (limited to 'new-luxc/source/luxc/lang/directive/jvm.lux') 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 - ["" code (#+ Parser)] - ["" 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) - (.form (<>.and .text (<>.some jvm.var)))) - -(type: Inheritance - #FinalI - #AbstractI - #DefaultI) - -(def: inheritance - (Parser Inheritance) - ($_ <>.or - (.text! "final") - (.text! "abstract") - (.text! "default"))) - -(type: State - #VolatileS - #FinalS - #DefaultS) - -(def: state - (Parser State) - ($_ <>.or - (.text! "volatile") - (.text! "final") - (.text! "default"))) - -(type: Annotation Any) - -(def: annotation - (Parser Annotation) - .any) - -(def: field-type - (Parser (Type Value)) - (.embed parser.value .text)) - -(type: Constant - [Text (List Annotation) (Type Value) Code]) - -(def: constant - (Parser Constant) - (<| .form - (<>.after (.text! "constant")) - ($_ <>.and - .text - (.tuple (<>.some ..annotation)) - ..field-type - .any - ))) - -(type: Variable - [Text jvm.Visibility State (List Annotation) (Type Value)]) - -(def: variable - (Parser Variable) - (<| .form - (<>.after (.text! "variable")) - ($_ <>.and - .text - jvm.visibility - ..state - (.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 - (.tuple (<>.some jvm.class)) - ..inheritance - (.tuple (<>.some ..annotation)) - (.tuple (<>.some ..field)) - (.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 [ ] - [_ ( value)] - ( #$.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) - ))) -- cgit v1.2.3