From 6c753288a89eadb3f7d70a8844e466c48c809051 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 31 Oct 2017 19:09:47 -0400 Subject: - Moved the "host" directory from under "generator" to under "luxc". --- new-luxc/source/luxc/host/jvm/def.lux | 287 ++++++++++++++++++++++++ new-luxc/source/luxc/host/jvm/inst.lux | 383 +++++++++++++++++++++++++++++++++ new-luxc/source/luxc/host/jvm/type.lux | 138 ++++++++++++ 3 files changed, 808 insertions(+) create mode 100644 new-luxc/source/luxc/host/jvm/def.lux create mode 100644 new-luxc/source/luxc/host/jvm/inst.lux create mode 100644 new-luxc/source/luxc/host/jvm/type.lux (limited to 'new-luxc/source/luxc/host/jvm') diff --git a/new-luxc/source/luxc/host/jvm/def.lux b/new-luxc/source/luxc/host/jvm/def.lux new file mode 100644 index 000000000..1d50ba9f6 --- /dev/null +++ b/new-luxc/source/luxc/host/jvm/def.lux @@ -0,0 +1,287 @@ +(;module: + lux + (lux (data [text] + text/format + [product] + (coll ["a" array] + [list "list/" Functor])) + [host #+ do-to]) + ["$" ..] + (.. ["$t" type])) + +## [Host] +(host;import #long java.lang.Object) +(host;import #long java.lang.String) + +(host;import org.objectweb.asm.Opcodes + (#static ACC_PUBLIC int) + (#static ACC_PROTECTED int) + (#static ACC_PRIVATE int) + + (#static ACC_TRANSIENT int) + (#static ACC_VOLATILE int) + + (#static ACC_ABSTRACT int) + (#static ACC_FINAL int) + (#static ACC_STATIC int) + (#static ACC_SYNCHRONIZED int) + (#static ACC_STRICT int) + + (#static ACC_SUPER int) + (#static ACC_INTERFACE int) + + (#static V1_1 int) + (#static V1_2 int) + (#static V1_3 int) + (#static V1_4 int) + (#static V1_5 int) + (#static V1_6 int) + (#static V1_7 int) + (#static V1_8 int) + ) + +(host;import org.objectweb.asm.FieldVisitor + (visitEnd [] void)) + +(host;import org.objectweb.asm.MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void)) + +(host;import org.objectweb.asm.ClassWriter + (#static COMPUTE_MAXS int) + (#static COMPUTE_FRAMES int) + (new [int]) + (visit [int int String String String (Array String)] void) + (visitEnd [] void) + (visitField [int String String String Object] FieldVisitor) + (visitMethod [int String String String (Array String)] MethodVisitor) + (toByteArray [] (Array byte))) + +## [Defs] +(def: (string-array values) + (-> (List Text) (Array Text)) + (let [output (host;array String (list;size values))] + (exec (list/map (function [[idx value]] + (host;array-write idx value output)) + (list;enumerate values)) + output))) + +(def: exceptions-array + (-> $;Method (Array Text)) + (|>. (get@ #$;exceptions) + (list/map (|>. #$;Generic $t;descriptor)) + string-array)) + +(def: (version-flag version) + (-> $;Version Int) + (case version + #$;V1.1 Opcodes.V1_1 + #$;V1.2 Opcodes.V1_2 + #$;V1.3 Opcodes.V1_3 + #$;V1.4 Opcodes.V1_4 + #$;V1.5 Opcodes.V1_5 + #$;V1.6 Opcodes.V1_6 + #$;V1.7 Opcodes.V1_7 + #$;V1.8 Opcodes.V1_8)) + +(def: (visibility-flag visibility) + (-> $;Visibility Int) + (case visibility + #$;Public Opcodes.ACC_PUBLIC + #$;Protected Opcodes.ACC_PROTECTED + #$;Private Opcodes.ACC_PRIVATE + #$;Default 0)) + +(def: (class-flags config) + (-> $;Class-Config Int) + ($_ i.+ + (if (get@ #$;finalC config) Opcodes.ACC_FINAL 0))) + +(def: (method-flags config) + (-> $;Method-Config Int) + ($_ i.+ + (if (get@ #$;staticM config) Opcodes.ACC_STATIC 0) + (if (get@ #$;finalM config) Opcodes.ACC_FINAL 0) + (if (get@ #$;synchronizedM config) Opcodes.ACC_SYNCHRONIZED 0) + (if (get@ #$;strictM config) Opcodes.ACC_STRICT 0))) + +(def: (field-flags config) + (-> $;Field-Config Int) + ($_ i.+ + (if (get@ #$;staticF config) Opcodes.ACC_STATIC 0) + (if (get@ #$;finalF config) Opcodes.ACC_FINAL 0) + (if (get@ #$;transientF config) Opcodes.ACC_TRANSIENT 0) + (if (get@ #$;volatileF config) Opcodes.ACC_VOLATILE 0))) + +(def: class-to-type + (-> $;Class $;Type) + (|>. #$;Class #$;Generic)) + +(def: param-signature + (-> $;Class Text) + (|>. class-to-type $t;signature (format ":"))) + +(def: (formal-param [name super interfaces]) + (-> $;Parameter Text) + (format name + (param-signature super) + (|> interfaces + (list/map param-signature) + (text;join-with "")))) + +(def: (parameters-signature parameters super interfaces) + (-> (List $;Parameter) $;Class (List $;Class) + Text) + (let [formal-params (if (list;empty? parameters) + "" + (format "<" + (|> parameters + (list/map formal-param) + (text;join-with "")) + ">"))] + (format formal-params + (|> super class-to-type $t;signature) + (|> interfaces + (list/map (|>. class-to-type $t;signature)) + (text;join-with ""))))) + +(def: class-computes + Int + ($_ i.+ + ClassWriter.COMPUTE_MAXS + ClassWriter.COMPUTE_FRAMES)) + +(do-template [ ] + [(def: #export ( version visibility config name parameters super interfaces + definitions) + (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def + (host;type (Array byte))) + (let [writer (|> (do-to (ClassWriter.new class-computes) + (ClassWriter.visit [(version-flag version) + ($_ i.+ + Opcodes.ACC_SUPER + + (visibility-flag visibility) + (class-flags config)) + ($t;binary-name name) + (parameters-signature parameters super interfaces) + (|> super product;left $t;binary-name) + (|> interfaces + (list/map (|>. product;left $t;binary-name)) + string-array)])) + definitions) + _ (ClassWriter.visitEnd [] writer)] + (ClassWriter.toByteArray [] writer)))] + + [class 0] + [abstract Opcodes.ACC_ABSTRACT] + ) + +(def: $Object $;Class ["java.lang.Object" (list)]) + +(def: #export (interface version visibility config name parameters interfaces + definitions) + (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def + (host;type (Array byte))) + (let [writer (|> (do-to (ClassWriter.new class-computes) + (ClassWriter.visit [(version-flag version) + ($_ i.+ + Opcodes.ACC_SUPER + Opcodes.ACC_INTERFACE + (visibility-flag visibility) + (class-flags config)) + ($t;binary-name name) + (parameters-signature parameters $Object interfaces) + (|> $Object product;left $t;binary-name) + (|> interfaces + (list/map (|>. product;left $t;binary-name)) + string-array)])) + definitions) + _ (ClassWriter.visitEnd [] writer)] + (ClassWriter.toByteArray [] writer))) + +(def: #export (method visibility config name type then) + (-> $;Visibility $;Method-Config Text $;Method $;Inst + $;Def) + (function [writer] + (let [=method (ClassWriter.visitMethod [($_ i.+ + (visibility-flag visibility) + (method-flags config)) + ($t;binary-name name) + ($t;method-descriptor type) + ($t;method-signature type) + (exceptions-array type)] + writer) + _ (MethodVisitor.visitCode [] =method) + _ (then =method) + _ (MethodVisitor.visitMaxs [0 0] =method) + _ (MethodVisitor.visitEnd [] =method)] + writer))) + +(def: #export (abstract-method visibility config name type) + (-> $;Visibility $;Method-Config Text $;Method + $;Def) + (function [writer] + (let [=method (ClassWriter.visitMethod [($_ i.+ + (visibility-flag visibility) + (method-flags config) + Opcodes.ACC_ABSTRACT) + ($t;binary-name name) + ($t;method-descriptor type) + ($t;method-signature type) + (exceptions-array type)] + writer) + _ (MethodVisitor.visitEnd [] =method)] + writer))) + +(def: #export (field visibility config name type) + (-> $;Visibility $;Field-Config Text $;Type $;Def) + (function [writer] + (let [=field (do-to (ClassWriter.visitField [($_ i.+ + (visibility-flag visibility) + (field-flags config)) + ($t;binary-name name) + ($t;descriptor type) + ($t;signature type) + (host;null)] writer) + (FieldVisitor.visitEnd []))] + writer))) + +(do-template [ ] + [(def: #export ( visibility config name value) + (-> $;Visibility $;Field-Config Text $;Def) + (function [writer] + (let [=field (do-to (ClassWriter.visitField [($_ i.+ + (visibility-flag visibility) + (field-flags config)) + ($t;binary-name name) + ($t;descriptor ) + ($t;signature ) + ( value)] + writer) + (FieldVisitor.visitEnd []))] + writer)))] + + [boolean-field Bool $t;boolean id] + [byte-field Int $t;byte host;l2b] + [short-field Int $t;short host;l2s] + [int-field Int $t;int host;l2i] + [long-field Int $t;long id] + [float-field Frac $t;float host;d2f] + [double-field Frac $t;double id] + [char-field Nat $t;char (|>. nat-to-int host;l2i host;i2c)] + [string-field Text ($t;class "java.lang.String" (list)) id] + ) + +(def: #export (fuse defs) + (-> (List $;Def) $;Def) + (case defs + #;Nil + id + + (#;Cons singleton #;Nil) + singleton + + (#;Cons head tail) + (. (fuse tail) head))) diff --git a/new-luxc/source/luxc/host/jvm/inst.lux b/new-luxc/source/luxc/host/jvm/inst.lux new file mode 100644 index 000000000..37ab75020 --- /dev/null +++ b/new-luxc/source/luxc/host/jvm/inst.lux @@ -0,0 +1,383 @@ +(;module: + [lux #- char] + (lux (control monad + ["p" parser]) + (data [maybe] + ["e" error] + text/format + (coll [list "L/" Functor])) + [host #+ do-to] + [meta] + (meta [code] + ["s" syntax #+ syntax:])) + ["$" ..] + (.. ["$t" type])) + +## [Host] +(host;import #long java.lang.Object) +(host;import #long java.lang.String) + +(syntax: (declare [codes (p;many s;local-symbol)]) + (|> codes + (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int))))) + wrap)) + +(`` (host;import org.objectweb.asm.Opcodes + (#static NOP int) + + ## Conversion + (~~ (declare D2F D2I D2L + F2D F2I F2L + I2B I2C I2D I2F I2L I2S + L2D L2F L2I)) + + ## Primitive + (~~ (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE + T_BYTE T_SHORT T_INT T_LONG)) + + ## Class + (~~ (declare CHECKCAST NEW INSTANCEOF)) + + ## Stack + (~~ (declare DUP DUP_X1 DUP_X2 + DUP2 DUP2_X1 DUP2_X2 + POP POP2 + SWAP)) + + ## Jump + (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT IF_ACMPEQ IFNULL + IFEQ IFNE IFLT IFLE IFGT IFGE + GOTO)) + + (#static ACONST_NULL int) + + ## Var + (~~ (declare ILOAD LLOAD DLOAD ALOAD + ISTORE LSTORE ASTORE)) + + ## Arithmetic + (~~ (declare IADD ISUB IMUL IDIV IREM + LADD LSUB LMUL LDIV LREM LCMP + FADD FSUB FMUL FDIV FREM FCMPG FCMPL + DADD DSUB DMUL DDIV DREM DCMPG DCMPL)) + + ## Bit-wise + (~~ (declare IAND IOR IXOR ISHL ISHR IUSHR + LAND LOR LXOR LSHL LSHR LUSHR)) + + ## Array + (~~ (declare ARRAYLENGTH NEWARRAY ANEWARRAY + AALOAD AASTORE + BALOAD BASTORE + SALOAD SASTORE + IALOAD IASTORE + LALOAD LASTORE + FALOAD FASTORE + DALOAD DASTORE + CALOAD CASTORE)) + + ## Member + (~~ (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD + INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE)) + + (#static ATHROW int) + + ## Concurrency + (~~ (declare MONITORENTER MONITOREXIT)) + + ## Return + (~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN)) + )) + +(host;import org.objectweb.asm.FieldVisitor + (visitEnd [] void)) + +(host;import org.objectweb.asm.Label + (new [])) + +(host;import org.objectweb.asm.MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void) + (visitInsn [int] void) + (visitLdcInsn [Object] void) + (visitFieldInsn [int String String String] void) + (visitTypeInsn [int String] void) + (visitVarInsn [int int] void) + (visitIntInsn [int int] void) + (visitMethodInsn [int String String String boolean] void) + (visitLabel [Label] void) + (visitJumpInsn [int Label] void) + (visitTryCatchBlock [Label Label Label String] void) + (visitTableSwitchInsn [int int Label (Array Label)] void) + ) + +## [Insts] +(def: #export make-label + (Meta Label) + (function [compiler] + (#e;Success [compiler (Label.new [])]))) + +(def: #export (with-label action) + (-> (-> Label $;Inst) $;Inst) + (action (Label.new []))) + +(do-template [ ] + [(def: #export ( value) + (-> $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitLdcInsn [( value)]))))] + + [boolean Bool id] + [int Int host;l2i] + [long Int id] + [double Frac id] + [char Nat (|>. nat-to-int host;l2i host;i2c)] + [string Text id] + ) + +(syntax: (prefix [base s;local-symbol]) + (wrap (list (code;local-symbol (format "Opcodes." base))))) + +(def: #export NULL + $;Inst + (function [visitor] + (do-to visitor + (MethodVisitor.visitInsn [(prefix ACONST_NULL)])))) + +(do-template [] + [(def: #export + $;Inst + (function [visitor] + (do-to visitor + (MethodVisitor.visitInsn [(prefix )]))))] + + [NOP] + + ## Stack + [DUP] [DUP_X1] [DUP_X2] [DUP2] [DUP2_X1] [DUP2_X2] + [POP] [POP2] + [SWAP] + + ## Conversions + [D2F] [D2I] [D2L] + [F2D] [F2I] [F2L] + [I2B] [I2C] [I2D] [I2F] [I2L] [I2S] + [L2D] [L2F] [L2I] + + ## Integer arithmetic + [IADD] [ISUB] [IMUL] [IDIV] [IREM] + + ## Integer bitwise + [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR] + + ## Long arithmetic + [LADD] [LSUB] [LMUL] [LDIV] [LREM] + [LCMP] + + ## Long bitwise + [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR] + + ## Float arithmetic + [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FCMPG] [FCMPL] + + ## Double arithmetic + [DADD] [DSUB] [DMUL] [DDIV] [DREM] + [DCMPG] [DCMPL] + + ## Array + [ARRAYLENGTH] + [AALOAD] [AASTORE] + [BALOAD] [BASTORE] + [SALOAD] [SASTORE] + [IALOAD] [IASTORE] + [LALOAD] [LASTORE] + [FALOAD] [FASTORE] + [DALOAD] [DASTORE] + [CALOAD] [CASTORE] + + ## Exceptions + [ATHROW] + + ## Concurrency + [MONITORENTER] [MONITOREXIT] + + ## Return + [RETURN] [IRETURN] [LRETURN] [DRETURN] [ARETURN] + ) + +(do-template [] + [(def: #export ( register) + (-> Nat $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitVarInsn [(prefix ) (nat-to-int register)]))))] + + [ILOAD] [LLOAD] [DLOAD] [ALOAD] + [ISTORE] [LSTORE] [ASTORE] + ) + +(do-template [ ] + [(def: #export ( class field type) + (-> Text Text $;Type $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitFieldInsn [ ($t;binary-name class) field ($t;descriptor type)]))))] + + [GETSTATIC Opcodes.GETSTATIC] + [PUTSTATIC Opcodes.PUTSTATIC] + + [PUTFIELD Opcodes.PUTFIELD] + [GETFIELD Opcodes.GETFIELD] + ) + +(do-template [ ] + [(def: #export ( class) + (-> Text $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitTypeInsn [ ($t;binary-name class)]))))] + + [CHECKCAST Opcodes.CHECKCAST] + [NEW Opcodes.NEW] + [INSTANCEOF Opcodes.INSTANCEOF] + [ANEWARRAY Opcodes.ANEWARRAY] + ) + +(def: #export (NEWARRAY type) + (-> $;Primitive $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitIntInsn [Opcodes.NEWARRAY (case type + #$;Boolean Opcodes.T_BOOLEAN + #$;Byte Opcodes.T_BYTE + #$;Short Opcodes.T_SHORT + #$;Int Opcodes.T_INT + #$;Long Opcodes.T_LONG + #$;Float Opcodes.T_FLOAT + #$;Double Opcodes.T_DOUBLE + #$;Char Opcodes.T_CHAR)])))) + +(do-template [ ] + [(def: #export ( class method-name method-signature interface?) + (-> Text Text $;Method Bool $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitMethodInsn [ ($t;binary-name class) method-name ($t;method-descriptor method-signature) interface?]))))] + + [INVOKESTATIC Opcodes.INVOKESTATIC] + [INVOKEVIRTUAL Opcodes.INVOKEVIRTUAL] + [INVOKESPECIAL Opcodes.INVOKESPECIAL] + [INVOKEINTERFACE Opcodes.INVOKEINTERFACE] + ) + +(do-template [] + [(def: #export ( @where) + (-> $;Label $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitJumpInsn [(prefix ) @where]))))] + + [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL] + [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE] + [GOTO] + ) + +(def: #export (TABLESWITCH min max default labels) + (-> Int Int $;Label (List $;Label) $;Inst) + (function [visitor] + (let [num-labels (list;size labels) + labels-array (host;array Label num-labels) + _ (loop [idx +0] + (if (n.< num-labels idx) + (exec (host;array-write idx + (maybe;assume (list;nth idx labels)) + labels-array) + (recur (n.inc idx))) + []))] + (do-to visitor + (MethodVisitor.visitTableSwitchInsn [min max default labels-array]))))) + +(def: #export (try @from @to @handler exception) + (-> $;Label $;Label $;Label Text $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitTryCatchBlock [@from @to @handler ($t;binary-name exception)])))) + +(def: #export (label @label) + (-> $;Label $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitLabel [@label])))) + +(def: #export (array type) + (-> $;Type $;Inst) + (case type + (#$;Primitive prim) + (NEWARRAY prim) + + (#$;Generic generic) + (let [elem-class (case generic + (#$;Class class params) + ($t;binary-name class) + + _ + ($t;binary-name "java.lang.Object"))] + (ANEWARRAY elem-class)) + + _ + (ANEWARRAY ($t;descriptor type)))) + +(def: (primitive-wrapper type) + (-> $;Primitive Text) + (case type + #$;Boolean "java.lang.Boolean" + #$;Byte "java.lang.Byte" + #$;Short "java.lang.Short" + #$;Int "java.lang.Integer" + #$;Long "java.lang.Long" + #$;Float "java.lang.Float" + #$;Double "java.lang.Double" + #$;Char "java.lang.Character")) + +(def: (primitive-unwrap type) + (-> $;Primitive Text) + (case type + #$;Boolean "booleanValue" + #$;Byte "byteValue" + #$;Short "shortValue" + #$;Int "intValue" + #$;Long "longValue" + #$;Float "floatValue" + #$;Double "doubleValue" + #$;Char "charValue")) + +(def: #export (wrap type) + (-> $;Primitive $;Inst) + (let [class (primitive-wrapper type)] + (|>. (INVOKESTATIC class "valueOf" + ($t;method (list (#$;Primitive type)) + (#;Some ($t;class class (list))) + (list)) + false)))) + +(def: #export (unwrap type) + (-> $;Primitive $;Inst) + (let [class (primitive-wrapper type)] + (|>. (CHECKCAST class) + (INVOKEVIRTUAL class (primitive-unwrap type) + ($t;method (list) (#;Some (#$;Primitive type)) (list)) + false)))) + +(def: #export (fuse insts) + (-> (List $;Inst) $;Inst) + (case insts + #;Nil + id + + (#;Cons singleton #;Nil) + singleton + + (#;Cons head tail) + (. (fuse tail) head))) diff --git a/new-luxc/source/luxc/host/jvm/type.lux b/new-luxc/source/luxc/host/jvm/type.lux new file mode 100644 index 000000000..3825d443b --- /dev/null +++ b/new-luxc/source/luxc/host/jvm/type.lux @@ -0,0 +1,138 @@ +(;module: + [lux #- char] + (lux (data [text] + text/format + (coll [list "L/" Functor]))) + ["$" ..]) + +## Types +(do-template [ ] + [(def: #export $;Type (#$;Primitive ))] + + [boolean #$;Boolean] + [byte #$;Byte] + [short #$;Short] + [int #$;Int] + [long #$;Long] + [float #$;Float] + [double #$;Double] + [char #$;Char] + ) + +(def: #export (class name params) + (-> Text (List $;Generic) $;Type) + (#$;Generic (#$;Class name params))) + +(def: #export (var name) + (-> Text $;Type) + (#$;Generic (#$;Var name))) + +(def: #export (wildcard bound) + (-> (Maybe [$;Bound $;Generic]) $;Type) + (#$;Generic (#$;Wildcard bound))) + +(def: #export (array depth elemT) + (-> Nat $;Type $;Type) + (case depth + +0 elemT + _ (#$;Array (array (n.dec depth) elemT)))) + +(def: #export (binary-name class) + (-> Text Text) + (text;replace-all "." "/" class)) + +(def: #export (descriptor type) + (-> $;Type Text) + (case type + (#$;Primitive prim) + (case prim + #$;Boolean "Z" + #$;Byte "B" + #$;Short "S" + #$;Int "I" + #$;Long "J" + #$;Float "F" + #$;Double "D" + #$;Char "C") + + (#$;Array sub) + (format "[" (descriptor sub)) + + (#$;Generic generic) + (case generic + (#$;Class class params) + (format "L" (binary-name class) ";") + + (^or (#$;Var name) (#$;Wildcard ?bound)) + (descriptor (#$;Generic (#$;Class "java.lang.Object" (list))))) + )) + +(def: #export (signature type) + (-> $;Type Text) + (case type + (#$;Primitive prim) + (case prim + #$;Boolean "Z" + #$;Byte "B" + #$;Short "S" + #$;Int "I" + #$;Long "J" + #$;Float "F" + #$;Double "D" + #$;Char "C") + + (#$;Array sub) + (format "[" (signature sub)) + + (#$;Generic generic) + (case generic + (#$;Class class params) + (let [=params (if (list;empty? params) + "" + (format "<" + (|> params + (L/map (|>. #$;Generic signature)) + (text;join-with "")) + ">"))] + (format "L" (binary-name class) =params ";")) + + (#$;Var name) + (format "T" name ";") + + (#$;Wildcard #;None) + "*" + + (^template [ ] + (#$;Wildcard (#;Some [ bound])) + (format (signature (#$;Generic bound)))) + ([#$;Upper "+"] + [#$;Lower "-"])) + )) + +## Methods +(def: #export (method args return exceptions) + (-> (List $;Type) (Maybe $;Type) (List $;Generic) $;Method) + {#$;args args #$;return return #$;exceptions exceptions}) + +(def: #export (method-descriptor method) + (-> $;Method Text) + (format "(" (text;join-with "" (L/map descriptor (get@ #$;args method))) ")" + (case (get@ #$;return method) + #;None + "V" + + (#;Some return) + (descriptor return)))) + +(def: #export (method-signature method) + (-> $;Method Text) + (format "(" (|> (get@ #$;args method) (L/map signature) (text;join-with "")) ")" + (case (get@ #$;return method) + #;None + "V" + + (#;Some return) + (signature return)) + (|> (get@ #$;exceptions method) + (L/map (|>. #$;Generic signature (format "^"))) + (text;join-with "")))) -- cgit v1.2.3