Renamed "Statement" to "Directive".

1 files changed, 263 insertions, 0 deletions

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
+     ["<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)
+          )))