aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-08-23 00:03:20 -0400
committerEduardo Julian2019-08-23 00:03:20 -0400
commit181f93f3e963c9738ed60f6f5e2d2a37253a0b1b (patch)
treea2978b0184d29c499231de6120803a3f7728daad
parentbf84fa3eb63fad7f2360b863e7f26005ee2d5aa8 (diff)
JVM type -> Lux type machinery based on signature parsing.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/target/jvm/type.lux19
-rw-r--r--stdlib/source/lux/target/jvm/type/lux.lux203
2 files changed, 133 insertions, 89 deletions
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index 83a9d017a..d1af2ec02 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -8,8 +8,6 @@
["<>" parser ("#@." monad)
["<t>" text (#+ Parser)]]]
[data
- ["." product]
- ["." maybe ("#@." functor)]
["." text ("#@." equivalence)
["%" format (#+ format)]]
[collection
@@ -166,22 +164,25 @@
(format valid-var-characters/tail //name.internal-separator))
(template [<type> <name> <head> <tail> <adapter>]
- [(def: <name>
+ [(def: #export <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]
+ [Text var-name-parser valid-var-characters/head valid-var-characters/tail function.identity]
)
-(def: var-parser
- (Parser (Type Parameter))
+(def: #export var-parser
+ (Parser Text)
(|> ..var-name-parser
(<>.after (<t>.this /signature.var-prefix))
- (<>.before (<t>.this /descriptor.class-suffix))
- (<>@map ..var)))
+ (<>.before (<t>.this /descriptor.class-suffix))))
+
+(def: var-parser'
+ (Parser (Type Parameter))
+ (<>@map ..var ..var-parser))
(template [<name> <prefix> <constructor>]
[(def: <name>
@@ -213,7 +214,7 @@
(function (_ generic-parser)
(let [class-parser (..class-parser generic-parser)]
($_ <>.either
- ..var-parser
+ ..var-parser'
..wildcard-parser
(..lower-parser class-parser)
(..upper-parser class-parser)
diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux
index c773856f5..06cd81ec0 100644
--- a/stdlib/source/lux/target/jvm/type/lux.lux
+++ b/stdlib/source/lux/target/jvm/type/lux.lux
@@ -3,8 +3,11 @@
[abstract
["." monad (#+ do)]]
[control
- ["." exception (#+ exception:)]]
+ ["." exception (#+ exception:)]
+ ["<>" parser ("#@." monad)
+ ["<t>" text (#+ Parser)]]]
[data
+ ["." product]
["." text
["%" format (#+ format)]]
[collection
@@ -14,6 +17,8 @@
abstract
["." check (#+ Check) ("#@." monad)]]]
["." //
+ ["#." descriptor]
+ ["#." signature]
["#." reflection]
["/#" // #_
[encoding
@@ -26,90 +31,128 @@
)
(type: #export Mapping
- (Dictionary //.Var Type))
+ (Dictionary Text Type))
(def: #export fresh
Mapping
(dictionary.new text.hash))
-(exception: #export (unknown-var {var //.Var})
+(exception: #export (unknown-var {var Text})
(exception.report
["Var" (%.text var)]))
-(def: (generic mapping input)
- (-> Mapping //.Generic (Check Type))
- (case input
- (#//.Var var)
- (case (dictionary.get var mapping)
- #.None
- (check.throw ..unknown-var var)
-
- (#.Some type)
- (check@wrap type))
-
- (#//.Wildcard wildcard)
- (case wildcard
- #.None
- (do check.monad
- [[id type] check.existential]
- (wrap type))
-
- (#.Some [bound limit])
- (do check.monad
- [limitT (generic mapping limit)]
- (case bound
- (^template [<tag> <ctor> <limit>]
- <tag>
- ## TODO: Re-enable Lower and Upper, instead of using the
- ## simplified limit.
- ## (wrap (.type (<ctor> limitT)))
- (wrap <limit>))
- ([#//.Lower ..Lower (primitive "java.lang.Object")]
- [#//.Upper ..Upper limitT]))))
-
- (#//.Class name parameters)
- (do check.monad
- [parametersT+ (monad.map @ (generic mapping) parameters)]
- (wrap (#.Primitive name parametersT+)))))
-
-(def: #export (class mapping [name parameters])
- (-> Mapping //.Class (Check Type))
- (do check.monad
- [parametersT+ (monad.map @ (..generic mapping) parameters)]
- (wrap (#.Primitive name parametersT+))))
-
-(def: #export (type mapping input)
- (-> Mapping //.Type (Check Type))
- (case input
- (#//.Primitive primitive)
- (check@wrap (case primitive
- #//.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)
-
- (#//.Array elementT)
- (case elementT
- (#//.Primitive primitive)
- (check@wrap (#.Primitive (|> input //reflection.class ///name.internal ///name.read) #.Nil))
-
- _
- (:: check.monad map
- (|>> Array .type)
- (type mapping elementT)))))
-
-(def: #export (return mapping input)
- (-> Mapping (Maybe //.Type) (Check Type))
- (case input
- #.None
- (check@wrap Any)
-
- (#.Some input)
- (..type mapping input)))
+(def: void-parser
+ (Parser (Check Type))
+ (<>.after (<t>.this (//signature.signature //signature.void))
+ (<>@wrap (check@wrap .Any))))
+
+(template [<name> <signature> <reflection>]
+ [(def: <name>
+ (Parser (Check Type))
+ (<>.after (<t>.this (//signature.signature <signature>))
+ (<>@wrap (check@wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))]
+
+ [boolean-parser //signature.boolean //reflection.boolean]
+ [byte-parser //signature.byte //reflection.byte]
+ [short-parser //signature.short //reflection.short]
+ [int-parser //signature.int //reflection.int]
+ [long-parser //signature.long //reflection.long]
+ [float-parser //signature.float //reflection.float]
+ [double-parser //signature.double //reflection.double]
+ [char-parser //signature.char //reflection.char]
+ )
+
+(def: primitive-parser
+ (Parser (Check Type))
+ ($_ <>.either
+ ..boolean-parser
+ ..byte-parser
+ ..short-parser
+ ..int-parser
+ ..long-parser
+ ..float-parser
+ ..double-parser
+ ..char-parser))
+
+(def: wildcard-parser
+ (Parser (Check Type))
+ (<>.after (<t>.this (//signature.signature //signature.wildcard))
+ (<>@wrap (check@map product.right
+ check.existential))))
+
+(def: (var-parser mapping)
+ (-> Mapping (Parser (Check Type)))
+ (do <>.monad
+ [var //.var-parser]
+ (<>@wrap (case (dictionary.get var mapping)
+ #.None
+ (check.throw ..unknown-var [var])
+
+ (#.Some type)
+ (check@wrap type)))))
+
+(def: (class-parser parameter-parser)
+ (-> (Parser (Check Type)) (Parser (Check Type)))
+ (|> (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 (do check.monad
+ [parameters (monad.seq @ parameters)]
+ (wrap (#.Primitive name parameters)))))
+ (<>.after (<t>.this //descriptor.class-prefix))
+ (<>.before (<t>.this //descriptor.class-suffix))))
+
+(template [<name> <prefix> <constructor>]
+ [(def: <name>
+ (-> (Parser (Check Type)) (Parser (Check Type)))
+ ## TODO: Re-enable Lower and Upper, instead of using the simplified limit.
+ ## (<>@map (check@map (|>> <ctor> .type)))
+ (<>.after (<t>.this <prefix>)))]
+
+ [lower-parser //signature.lower-prefix ..Lower]
+ [upper-parser //signature.upper-prefix ..Upper]
+ )
+
+(def: (generic-parser mapping)
+ (-> Mapping (Parser (Check Type)))
+ (<>.rec
+ (function (_ generic-parser)
+ (let [class-parser (..class-parser generic-parser)]
+ ($_ <>.either
+ (..var-parser mapping)
+ ..wildcard-parser
+ (..lower-parser class-parser)
+ (..upper-parser class-parser)
+ class-parser)))))
+
+(def: array-parser
+ (-> (Parser (Check Type)) (Parser (Check Type)))
+ (|>> (<>@map (check@map (function (_ elementT)
+ (case elementT
+ (#.Primitive name #.Nil)
+ (#.Primitive (|> name //reflection.class //reflection.array //reflection.reflection) #.Nil)
+
+ _
+ (|> elementT Array .type)))))
+ (<>.after (<t>.this //descriptor.array-prefix))))
+
+(def: #export (type-parser mapping)
+ (-> Mapping (Parser (Check Type)))
+ (<>.rec
+ (function (_ type-parser)
+ ($_ <>.either
+ ..primitive-parser
+ (generic-parser mapping)
+ (..array-parser type-parser)))))
+
+(def: #export (return-parser mapping)
+ (-> Mapping (Parser (Check Type)))
+ ($_ <>.either
+ ..void-parser
+ (..type-parser mapping)
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 02:34:40 +0000