From 5f494b497e79bcea1d3c64d663ca5435bbf8ca2d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 7 Sep 2019 20:02:14 -0400 Subject: Renamed "Statement" to "Directive". --- new-luxc/source/luxc/lang/directive/jvm.lux | 263 ++++++++++++++++++++++++++++ new-luxc/source/luxc/lang/statement/jvm.lux | 263 ---------------------------- 2 files changed, 263 insertions(+), 263 deletions(-) create mode 100644 new-luxc/source/luxc/lang/directive/jvm.lux delete mode 100644 new-luxc/source/luxc/lang/statement/jvm.lux (limited to 'new-luxc/source/luxc') diff --git a/new-luxc/source/luxc/lang/directive/jvm.lux b/new-luxc/source/luxc/lang/directive/jvm.lux new file mode 100644 index 000000000..5c1ddee0d --- /dev/null +++ b/new-luxc/source/luxc/lang/directive/jvm.lux @@ -0,0 +1,263 @@ +(.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) + ))) diff --git a/new-luxc/source/luxc/lang/statement/jvm.lux b/new-luxc/source/luxc/lang/statement/jvm.lux deleted file mode 100644 index 20ba938d1..000000000 --- a/new-luxc/source/luxc/lang/statement/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 - ["." statement (#+ Handler Bundle)] - ["." phase - ["." generation] - [analysis - [".A" type]] - ["." extension - ["." bundle] - [analysis - ["." jvm]] - [statement - ["/" 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 (statement.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 (statement.lift-analysis - (typeA.with-env - (luxT.check (luxT.class mapping) (..signature super-class)))) - super-interfaceT+ (statement.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@ [#statement.analysis #statement.phase] state) - synthesize (get@ [#statement.synthesis #statement.phase] state) - generate (get@ [#statement.generation #statement.phase] state)] - methods (monad.map @ (function (_ methodC) - (do @ - [methodA (statement.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)))] - (statement.lift-synthesis - (synthesize methodA)))) - methods) - _ (statement.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 statement.no-requirements)))])) - -(def: #export bundle - (Bundle Anchor Inst Definition) - (<| (bundle.prefix "jvm") - (|> bundle.empty - (dictionary.put "class" jvm::class) - ))) -- cgit v1.2.3