diff options
| -rw-r--r-- | stdlib/source/lux/data/collection/dictionary.lux | 48 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/analysis/case.lux | 19 |
2 files changed, 40 insertions, 27 deletions
diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index 3580b0ddd..2f07ceb3e 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -1,6 +1,9 @@ (.module: [lux #* [abstract + [monoid (#+)] + [fold (#+)] + [monad (#+)] [hash (#+ Hash)] [equivalence (#+ Equivalence)] [functor (#+ Functor)]] @@ -681,28 +684,29 @@ #0)) (keys test))))) +(structure: functor' + (All [k] (Functor (Node k))) + (def: (map f fa) + (case fa + (#Hierarchy size hierarchy) + (#Hierarchy size (array@map (map f) hierarchy)) + + (#Base bitmap base) + (#Base bitmap (array@map (function (_ either) + (case either + (#.Left fa') + (#.Left (map f fa')) + + (#.Right [k v]) + (#.Right [k (f v)]))) + base)) + + (#Collisions hash collisions) + (#Collisions hash (array@map (function (_ [k v]) + [k (f v)]) + collisions))))) + (structure: #export functor (All [k] (Functor (Dictionary k))) (def: (map f fa) - (update@ #root - (function (recur node) - (case node - (#Hierarchy size hierarchy) - (#Hierarchy size (array@map recur hierarchy)) - - (#Base bitmap base) - (#Base bitmap (array@map (function (_ either) - (case either - (#.Left node) - (#.Left (recur node)) - - (#.Right [k v]) - (#.Right [k (f v)]))) - base)) - - (#Collisions hash collisions) - (#Collisions hash (array@map (function (_ [k v]) - [k (f v)]) - collisions)))) - fa) - )) + (update@ #root (:: ..functor' map f) fa))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux index 9d7c9ea7f..dff106eb7 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux @@ -90,9 +90,9 @@ (#.ExQ _) (do ///.monad - [[ex-id exT] (//type.with-env - check.existential)] - (recur envs (maybe.assume (type.apply (list exT) caseT)))) + [[var-id varT] (//type.with-env + check.var)] + (recur envs (maybe.assume (type.apply (list varT) caseT)))) (#.Apply inputT funcT) (.case funcT @@ -215,7 +215,7 @@ thenA]))) _ - (/.throw cannot-match-with-pattern [inputT pattern]) + (/.throw cannot-match-with-pattern [inputT' pattern]) ))) [cursor (#.Record record)] @@ -260,8 +260,17 @@ _ (/.throw sum-has-no-case [idx inputT]))) + (#.UnivQ _) + (do ///.monad + [[ex-id exT] (//type.with-env + check.existential)] + (analyse-pattern num-tags + (maybe.assume (type.apply (list exT) inputT')) + pattern + next)) + _ - (/.throw cannot-match-with-pattern [inputT pattern])))) + (/.throw cannot-match-with-pattern [inputT' pattern])))) (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))]) (/.with-cursor cursor |