diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/lux/compiler.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/lux/type/auto.lux | 32 | ||||
| -rw-r--r-- | stdlib/test/test/lux/type/auto.lux | 2 |
3 files changed, 43 insertions, 3 deletions
diff --git a/stdlib/source/lux/compiler.lux b/stdlib/source/lux/compiler.lux index 437389717..feade4a8c 100644 --- a/stdlib/source/lux/compiler.lux +++ b/stdlib/source/lux/compiler.lux @@ -532,6 +532,18 @@ _ (fail ($_ Text/append "Unknown tag: " (Ident/encode tag)))))) +(def: #export (tag-lists module) + (-> Text (Lux (List [(List Ident) Type]))) + (do Monad<Lux> + [=module (find-module module) + this-module-name current-module-name] + (wrap (|> (get@ #;types =module) + (list;filter (lambda [[type-name [tag-list exported? type]]] + (or exported? + (Text/= this-module-name module)))) + (List/map (lambda [[type-name [tag-list exported? type]]] + [tag-list type])))))) + (def: #export locals (Lux (List (List [Text Type]))) (lambda [state] diff --git a/stdlib/source/lux/type/auto.lux b/stdlib/source/lux/type/auto.lux index c22434e9f..31439af3d 100644 --- a/stdlib/source/lux/type/auto.lux +++ b/stdlib/source/lux/type/auto.lux @@ -6,7 +6,7 @@ (;module: lux (lux (control monad) - (data [text] + (data [text "Text/" Eq<Text>] text/format [number] (struct [list "List/" Monad<List> Fold<List>] @@ -75,10 +75,38 @@ (:: Monad<Check> wrap sig-type) (tc;fail (format "Can't find member type " (%n idx) " for " (%type sig-type)))))) +(def: (find-member-name member) + (-> Ident (Lux Ident)) + (case member + ["" simple-name] + (compiler;either (do Monad<Lux> + [member (compiler;normalize member) + _ (compiler;resolve-tag member)] + (wrap member)) + (do Monad<Lux> + [this-module-name compiler;current-module-name + imp-mods (compiler;imported-modules this-module-name) + tag-lists (mapM @ compiler;tag-lists imp-mods) + #let [tag-lists (|> tag-lists List/join (List/map product;left) List/join) + candidates (list;filter (. (Text/= simple-name) product;right) + tag-lists)]] + (case candidates + #;Nil + (compiler;fail (format "Unknown tag: " (%ident member))) + + (#;Cons winner #;Nil) + (wrap winner) + + _ + (compiler;fail (format "Too many candidate tags: " (%list %ident candidates)))))) + + _ + (:: Monad<Lux> wrap member))) + (def: (resolve-member member) (-> Ident (Lux [Nat Type])) (do Monad<Lux> - [member (compiler;normalize member) + [member (find-member-name member) [idx tag-list sig-type] (compiler;resolve-tag member)] (wrap [idx sig-type]))) diff --git a/stdlib/test/test/lux/type/auto.lux b/stdlib/test/test/lux/type/auto.lux index ef69961cd..eb25a2371 100644 --- a/stdlib/test/test/lux/type/auto.lux +++ b/stdlib/test/test/lux/type/auto.lux @@ -25,4 +25,4 @@ y R;nat] (assert "Can automatically select first-order structures." (B/= (:: number;Eq<Nat> = x y) - (::: eq;= x y)))) + (::: = x y)))) |