aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/compiler.lux12
-rw-r--r--stdlib/source/lux/type/auto.lux32
-rw-r--r--stdlib/test/test/lux/type/auto.lux2
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))))