(.module: [lux #- Type] (lux (control monad ["p" parser]) (data (coll [list "list/" Functor])) [macro] (macro [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)])