(;module: [lux #- Type Def] (lux (control monad ["p" parser]) (data (coll [list "list/" Functor])) [meta] (meta [code] ["s" syntax #+ syntax:]) [host])) ## [Host] (host;import org.objectweb.asm.MethodVisitor) (host;import org.objectweb.asm.ClassWriter) (host;import #long org.objectweb.asm.Label (new [])) ## [Type] (type: #export Bound #Upper #Lower) (type: #export Primitive #Boolean #Byte #Short #Int #Long #Float #Double #Char) (type: #export #rec Generic (#Var Text) (#Wildcard (Maybe [Bound Generic])) (#Class Text (List Generic))) (type: #export Class [Text (List Generic)]) (type: #export Parameter [Text Class (List Class)]) (type: #export #rec Type (#Primitive Primitive) (#Generic Generic) (#Array Type)) (type: #export Method {#args (List Type) #return (Maybe Type) #exceptions (List Generic)}) (type: #export Def (-> ClassWriter ClassWriter)) (type: #export Inst (-> MethodVisitor MethodVisitor)) (type: #export Label org.objectweb.asm.Label) (type: #export Register Nat) (type: #export Visibility #Public #Protected #Private #Default) (type: #export Version #V1.1 #V1.2 #V1.3 #V1.4 #V1.5 #V1.6 #V1.7 #V1.8) ## [Values] (syntax: (config: [type s;local-symbol] [none s;local-symbol] [++ s;local-symbol] [options (s;tuple (p;many s;local-symbol))]) (let [g!type (code;local-symbol type) g!none (code;local-symbol none) g!tags+ (list/map code;local-tag options) g!_left (code;local-symbol "_left") g!_right (code;local-symbol "_right") g!options+ (list/map (function [option] (` (def: (~' #export) (~ (code;local-symbol option)) (~ g!type) (|> (~ g!none) (set@ (~ (code;local-tag option)) true))))) options)] (wrap (list& (` (type: (~' #export) (~ g!type) (~ (code;record (list/map (function [tag] [tag (` ;Bool)]) g!tags+))))) (` (def: (~' #export) (~ g!none) (~ g!type) (~ (code;record (list/map (function [tag] [tag (` false)]) g!tags+))))) (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ g!_left) (~ g!_right)) (-> (~ g!type) (~ g!type) (~ g!type)) (~ (code;record (list/map (function [tag] [tag (` (or (get@ (~ tag) (~ g!_left)) (get@ (~ tag) (~ g!_right))))]) g!tags+))))) g!options+)))) ## Configs (config: Class-Config noneC ++C [finalC]) (config: Method-Config noneM ++M [finalM staticM synchronizedM strictM]) (config: Field-Config noneF ++F [finalF staticF transientF volatileF]) ## Labels (def: #export new-label (-> Unit Label) org.objectweb.asm.Label.new) (def: #export (simple-class name) (-> Text Class) [name (list)])