diff options
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/source/lux/target/jvm/type.lux | 257 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/type/descriptor.lux | 8 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/type/lux.lux | 16 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/type/reflection.lux | 16 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/type/signature.lux | 31 |
5 files changed, 196 insertions, 132 deletions
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index e28e9633a..83a9d017a 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -1,10 +1,11 @@ (.module: [lux (#- Type int char) [abstract - [equivalence (#+ Equivalence)]] + [equivalence (#+ Equivalence)] + [monad (#+ do)]] [control ["." function] - ["<>" parser + ["<>" parser ("#@." monad) ["<t>" text (#+ Parser)]]] [data ["." product] @@ -24,14 +25,14 @@ ["#." descriptor (#+ Descriptor)] ["#." reflection (#+ Reflection)]]) -(abstract: #export (Type brand) +(abstract: #export (Type category) {} - [(Signature Any) (Descriptor Any) (Reflection Any)] + [(Signature category) (Descriptor category) (Reflection category)] (template [<name> <style>] [(def: #export (<name> type) - (-> (Type Any) (<style> Any)) + (All [category] (-> (Type category) (<style> category))) (let [[signature descriptor reflection] (:representation type)] <name>))] @@ -40,9 +41,9 @@ [reflection Reflection] ) - (template [<brand> <name> <signature> <descriptor> <reflection>] + (template [<category> <name> <signature> <descriptor> <reflection>] [(def: #export <name> - (Type <brand>) + (Type <category>) (:abstraction [<signature> <descriptor> <reflection>]))] [Void void /signature.void /descriptor.void /reflection.void] @@ -102,99 +103,153 @@ (-> [(List (Type Value)) (Type Return) (List (Type Class))] - (Type Method)) - (:abstraction - [(/signature.method [(list@map ..signature inputs) - (..signature output) - (list@map ..signature exceptions)]) - (/descriptor.method [(list@map ..descriptor inputs) - (..descriptor output)]) - (/reflection.method [(list@map ..reflection inputs) - (..reflection output)])])) + [(Signature Method) + (Descriptor Method)]) + [(/signature.method [(list@map ..signature inputs) + (..signature output) + (list@map ..signature exceptions)]) + (/descriptor.method [(list@map ..descriptor inputs) + (..descriptor output)])]) + + (structure: #export equivalence + (All [category] (Equivalence (Type category))) + + (def: (= parameter subject) + (:: /signature.equivalence = + (..signature parameter) + (..signature subject)))) + ) + +(template [<category> <name> <signature> <type>] + [(def: <name> + (Parser (Type <category>)) + (<>.after (<t>.this (/signature.signature <signature>)) + (<>@wrap <type>)))] + + [Void void-parser /signature.void ..void] + [Primitive boolean-parser /signature.boolean ..boolean] + [Primitive byte-parser /signature.byte ..byte] + [Primitive short-parser /signature.short ..short] + [Primitive int-parser /signature.int ..int] + [Primitive long-parser /signature.long ..long] + [Primitive float-parser /signature.float ..float] + [Primitive double-parser /signature.double ..double] + [Primitive char-parser /signature.char ..char] + [Parameter wildcard-parser /signature.wildcard ..wildcard] + ) + +(def: primitive-parser + (Parser (Type Primitive)) + ($_ <>.either + ..boolean-parser + ..byte-parser + ..short-parser + ..int-parser + ..long-parser + ..float-parser + ..double-parser + ..char-parser)) + +(def: valid-var-characters/head + (format "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "_")) + +(def: valid-var-characters/tail + (format valid-var-characters/head + "0123456789")) + +(def: valid-class-characters/head + (format valid-var-characters/head //name.internal-separator)) + +(def: valid-class-characters/tail + (format valid-var-characters/tail //name.internal-separator)) + +(template [<type> <name> <head> <tail> <adapter>] + [(def: <name> + (Parser <type>) + (:: <>.functor map <adapter> + (<t>.slice (<t>.and! (<t>.one-of! <head>) + (<t>.some! (<t>.one-of! <tail>))))))] + + [External class-name-parser valid-class-characters/head valid-class-characters/tail (|>> //name.internal //name.external)] + [Text var-name-parser valid-var-characters/head valid-var-characters/tail function.identity] + ) + +(def: var-parser + (Parser (Type Parameter)) + (|> ..var-name-parser + (<>.after (<t>.this /signature.var-prefix)) + (<>.before (<t>.this /descriptor.class-suffix)) + (<>@map ..var))) + +(template [<name> <prefix> <constructor>] + [(def: <name> + (-> (Parser (Type Class)) (Parser (Type Parameter))) + (|>> (<>.after (<t>.this <prefix>)) + (<>@map <constructor>)))] + + [lower-parser /signature.lower-prefix ..lower] + [upper-parser /signature.upper-prefix ..upper] ) -## (def: valid-var-characters/head -## (format "abcdefghijklmnopqrstuvwxyz" -## "ABCDEFGHIJKLMNOPQRSTUVWXYZ" -## "_")) - -## (def: valid-var-characters/tail -## (format valid-var-characters/head -## "0123456789")) - -## (def: valid-class-characters/head -## (format valid-var-characters/head //name.internal-separator)) - -## (def: valid-class-characters/tail -## (format valid-var-characters/tail //name.internal-separator)) - -## (type: #export Parameter -## [Text Class (List Class)]) - -## (type: #export Argument -## [Text Type]) - -## (type: #export (Typed a) -## [Type a]) - -## (template [<name> <head> <tail> <adapter>] -## [(def: <name> -## (Parser Text) -## (:: <>.functor map <adapter> -## (<t>.slice (<t>.and! (<t>.one-of! <head>) -## (<t>.some! (<t>.one-of! <tail>))))))] - -## [parse-class-name valid-class-characters/head valid-class-characters/tail (|>> //name.internal //name.external)] -## [parse-var-name valid-var-characters/head valid-var-characters/tail function.identity] -## ) - -## (def: parse-var -## (Parser Var) -## (|> ..parse-var-name -## (<>.after (<t>.this ..var-prefix)) -## (<>.before (<t>.this ..object-suffix)))) - -## (def: parse-bound -## (Parser Bound) -## ($_ <>.or -## (<t>.this ..lower-prefix) -## (<t>.this ..upper-prefix))) - -## (def: parse-generic -## (Parser Generic) -## (<>.rec -## (function (_ recur) -## ($_ <>.or -## ..parse-var -## ($_ <>.or -## (<t>.this ..wildcard-signature) -## (<>.and ..parse-bound recur) -## ) -## (|> (<>.and ..parse-class-name -## (|> (<>.some recur) -## (<>.after (<t>.this "<")) -## (<>.before (<t>.this ">")) -## (<>.default (list)))) -## (<>.after (<t>.this ..object-prefix)) -## (<>.before (<t>.this ..object-suffix))) -## )))) - -## (def: #export parse-signature -## (Parser Type) -## (<>.rec -## (function (_ recur) -## ($_ <>.or -## ($_ <>.or -## (<t>.this ..boolean-descriptor) -## (<t>.this ..byte-descriptor) -## (<t>.this ..short-descriptor) -## (<t>.this ..int-descriptor) -## (<t>.this ..long-descriptor) -## (<t>.this ..float-descriptor) -## (<t>.this ..double-descriptor) -## (<t>.this ..char-descriptor) -## ) -## ..parse-generic -## (<>.after (<t>.this ..array-prefix) -## recur) -## )))) +(def: (class-parser parameter-parser) + (-> (Parser (Type Parameter)) (Parser (Type Class))) + (|> (do <>.monad + [_ (<t>.this /descriptor.class-prefix) + name ..class-name-parser + parameters (|> (<>.some parameter-parser) + (<>.after (<t>.this /signature.parameters-start)) + (<>.before (<t>.this /signature.parameters-end)) + (<>.default (list))) + _ (<t>.this /descriptor.class-suffix)] + (wrap (..class name parameters))) + (<>.after (<t>.this /descriptor.class-prefix)) + (<>.before (<t>.this /descriptor.class-suffix)))) + +(def: generic-parser + (Parser (Type Parameter)) + (<>.rec + (function (_ generic-parser) + (let [class-parser (..class-parser generic-parser)] + ($_ <>.either + ..var-parser + ..wildcard-parser + (..lower-parser class-parser) + (..upper-parser class-parser) + class-parser + ))))) + +(def: array-parser + (-> (Parser (Type Value)) (Parser (Type Array))) + (|>> (<>.after (<t>.this /descriptor.array-prefix)) + (<>@map ..array))) + +(def: #export value-parser + (Parser (Type Value)) + (<>.rec + (function (_ parser) + ($_ <>.either + ..primitive-parser + ..generic-parser + (..array-parser parser) + )))) + +(def: #export method-parser + (Parser [(Signature Method) + (Descriptor Method)]) + (let [parameters-parser (: (Parser (List (Type Value))) + (|> (<>.some ..value-parser) + (<>.after (<t>.this /signature.arguments-start)) + (<>.before (<t>.this /signature.arguments-end)))) + return-parser (: (Parser (Type Return)) + (<>.either ..void-parser + ..value-parser)) + exception-parser (: (Parser (Type Class)) + (|> (..class-parser ..generic-parser) + (<>.after (<t>.this /signature.exception-prefix))))] + (do <>.monad + [parameters parameters-parser + return return-parser + exceptions (<>.some exception-parser)] + (wrap (..method [parameters return exceptions]))))) diff --git a/stdlib/source/lux/target/jvm/type/descriptor.lux b/stdlib/source/lux/target/jvm/type/descriptor.lux index 4a46b5caa..e16693ff4 100644 --- a/stdlib/source/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/lux/target/jvm/type/descriptor.lux @@ -18,7 +18,7 @@ [encoding ["#." name (#+ External)]]]]) -(abstract: #export (Descriptor brand) +(abstract: #export (Descriptor category) {} Text @@ -27,9 +27,9 @@ (-> (Descriptor Any) Text) (|>> :representation)) - (template [<sigil> <brand> <name>] + (template [<sigil> <category> <name>] [(def: #export <name> - (Descriptor <brand>) + (Descriptor <category>) (:abstraction <sigil>))] ["V" Void void] @@ -92,7 +92,7 @@ (:representation output)))) (structure: #export equivalence - (All [brand] (Equivalence (Descriptor brand))) + (All [category] (Equivalence (Descriptor category))) (def: (= parameter subject) (text@= (:representation parameter) (:representation subject)))) diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux index 243861bd4..c773856f5 100644 --- a/stdlib/source/lux/target/jvm/type/lux.lux +++ b/stdlib/source/lux/target/jvm/type/lux.lux @@ -83,14 +83,14 @@ (case input (#//.Primitive primitive) (check@wrap (case primitive - #//.Boolean (#.Primitive //reflection.boolean #.Nil) - #//.Byte (#.Primitive //reflection.byte #.Nil) - #//.Short (#.Primitive //reflection.short #.Nil) - #//.Int (#.Primitive //reflection.int #.Nil) - #//.Long (#.Primitive //reflection.long #.Nil) - #//.Float (#.Primitive //reflection.float #.Nil) - #//.Double (#.Primitive //reflection.double #.Nil) - #//.Char (#.Primitive //reflection.char #.Nil))) + #//.Boolean (#.Primitive (//reflection.reflection //reflection.boolean) #.Nil) + #//.Byte (#.Primitive (//reflection.reflection //reflection.byte) #.Nil) + #//.Short (#.Primitive (//reflection.reflection //reflection.short) #.Nil) + #//.Int (#.Primitive (//reflection.reflection //reflection.int) #.Nil) + #//.Long (#.Primitive (//reflection.reflection //reflection.long) #.Nil) + #//.Float (#.Primitive (//reflection.reflection //reflection.float) #.Nil) + #//.Double (#.Primitive (//reflection.reflection //reflection.double) #.Nil) + #//.Char (#.Primitive (//reflection.reflection //reflection.char) #.Nil))) (#//.Generic generic) (..generic mapping generic) diff --git a/stdlib/source/lux/target/jvm/type/reflection.lux b/stdlib/source/lux/target/jvm/type/reflection.lux index 08c51b391..65ee1aa90 100644 --- a/stdlib/source/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/lux/target/jvm/type/reflection.lux @@ -5,14 +5,14 @@ ["%" format (#+ format)]]] [type abstract]] - ["." // + ["." // #_ [category (#+ Void Value Return Method Primitive Object Class Array Parameter)] ["#." descriptor] [// [encoding ["#." name (#+ External)]]]]) -(abstract: #export (Reflection brand) +(abstract: #export (Reflection category) {} Text @@ -21,9 +21,9 @@ (-> (Reflection Any) Text) (|>> :representation)) - (template [<brand> <name> <reflection>] + (template [<category> <name> <reflection>] [(def: #export <name> - (Reflection <brand>) + (Reflection <category>) (:abstraction <reflection>))] [Void void "void"] @@ -42,7 +42,7 @@ (|>> :abstraction)) (def: #export array - (-> (Reflection Class) (Reflection Array)) + (-> (Reflection Value) (Reflection Array)) (|>> :representation (format //descriptor.array-prefix) :abstraction)) @@ -57,11 +57,11 @@ [wildcard] ) - (def: #export (lower descriptor) - (-> (Descriptor Class) (Descriptor Parameter)) + (def: #export (lower reflection) + (-> (Reflection Class) (Reflection Parameter)) ..wildcard) (def: #export upper - (-> (Descriptor Class) (Descriptor Parameter)) + (-> (Reflection Class) (Reflection Parameter)) (|>> :transmutation)) ) diff --git a/stdlib/source/lux/target/jvm/type/signature.lux b/stdlib/source/lux/target/jvm/type/signature.lux index bfb3a14ba..260c564db 100644 --- a/stdlib/source/lux/target/jvm/type/signature.lux +++ b/stdlib/source/lux/target/jvm/type/signature.lux @@ -16,7 +16,7 @@ [encoding ["#." name (#+ External)]]]]) -(abstract: #export (Signature brand) +(abstract: #export (Signature category) {} Text @@ -25,9 +25,9 @@ (-> (Signature Any) Text) (|>> :representation)) - (template [<brand> <name> <descriptor>] + (template [<category> <name> <descriptor>] [(def: #export <name> - (Signature <brand>) + (Signature <category>) (:abstraction (//descriptor.descriptor <descriptor>)))] [Void void //descriptor.void] @@ -51,15 +51,15 @@ (Signature Parameter) (:abstraction "*")) - (def: var-prefix "T") + (def: #export var-prefix "T") (def: #export var (-> Text (Signature Parameter)) (|>> (text.enclose [..var-prefix //descriptor.class-suffix]) :abstraction)) - (def: lower-prefix "-") - (def: upper-prefix "+") + (def: #export lower-prefix "-") + (def: #export upper-prefix "+") (template [<name> <prefix>] [(def: #export <name> @@ -70,6 +70,9 @@ [upper ..upper-prefix] ) + (def: #export parameters-start "<") + (def: #export parameters-end ">") + (def: #export (class name parameters) (-> External (List (Signature Parameter)) (Signature Class)) (:abstraction @@ -80,13 +83,18 @@ "" _ - (format "<" + (format ..parameters-start (|> parameters (list@map ..signature) (text.join-with "")) - ">")) + ..parameters-end)) //descriptor.class-suffix))) + (def: #export arguments-start "(") + (def: #export arguments-end ")") + + (def: #export exception-prefix "^") + (def: #export (method [inputs output exceptions]) (-> [(List (Signature Value)) (Signature Return) @@ -96,14 +104,15 @@ (format (|> inputs (list@map ..signature) (text.join-with "") - (text.enclose ["(" ")"])) + (text.enclose [..arguments-start + ..arguments-end])) (:representation output) (|> exceptions - (list@map (|>> :representation (format "^"))) + (list@map (|>> :representation (format ..exception-prefix))) (text.join-with ""))))) (structure: #export equivalence - (All [brand] (Equivalence (Signature brand))) + (All [category] (Equivalence (Signature category))) (def: (= parameter subject) (text@= (:representation parameter) |