aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/target/jvm/type.lux257
-rw-r--r--stdlib/source/lux/target/jvm/type/descriptor.lux8
-rw-r--r--stdlib/source/lux/target/jvm/type/lux.lux16
-rw-r--r--stdlib/source/lux/target/jvm/type/reflection.lux16
-rw-r--r--stdlib/source/lux/target/jvm/type/signature.lux31
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)