From 181f93f3e963c9738ed60f6f5e2d2a37253a0b1b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 23 Aug 2019 00:03:20 -0400 Subject: JVM type -> Lux type machinery based on signature parsing. --- stdlib/source/lux/target/jvm/type.lux | 19 +-- stdlib/source/lux/target/jvm/type/lux.lux | 203 ++++++++++++++++++------------ 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) ["" text (#+ Parser)]]] [data - ["." product] - ["." maybe ("#@." functor)] ["." text ("#@." equivalence) ["%" format (#+ format)]] [collection @@ -166,22 +164,25 @@ (format valid-var-characters/tail //name.internal-separator)) (template [ ] - [(def: + [(def: #export (Parser ) (:: <>.functor map (.slice (.and! (.one-of! ) (.some! (.one-of! ))))))] [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 (.this /signature.var-prefix)) - (<>.before (.this /descriptor.class-suffix)) - (<>@map ..var))) + (<>.before (.this /descriptor.class-suffix)))) + +(def: var-parser' + (Parser (Type Parameter)) + (<>@map ..var ..var-parser)) (template [ ] [(def: @@ -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) + ["" 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 [ ] - - ## TODO: Re-enable Lower and Upper, instead of using the - ## simplified limit. - ## (wrap (.type ( limitT))) - (wrap )) - ([#//.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 (.this (//signature.signature //signature.void)) + (<>@wrap (check@wrap .Any)))) + +(template [ ] + [(def: + (Parser (Check Type)) + (<>.after (.this (//signature.signature )) + (<>@wrap (check@wrap (#.Primitive (//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 (.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 + [_ (.this //descriptor.class-prefix) + name //.class-name-parser + parameters (|> (<>.some parameter-parser) + (<>.after (.this //signature.parameters-start)) + (<>.before (.this //signature.parameters-end)) + (<>.default (list))) + _ (.this //descriptor.class-suffix)] + (wrap (do check.monad + [parameters (monad.seq @ parameters)] + (wrap (#.Primitive name parameters))))) + (<>.after (.this //descriptor.class-prefix)) + (<>.before (.this //descriptor.class-suffix)))) + +(template [ ] + [(def: + (-> (Parser (Check Type)) (Parser (Check Type))) + ## TODO: Re-enable Lower and Upper, instead of using the simplified limit. + ## (<>@map (check@map (|>> .type))) + (<>.after (.this )))] + + [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 (.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) + )) -- cgit v1.2.3