git.iko.soy/elk
on master help sign in
Try to support polymorphic pattern matching
fceb46dEvan Czaplicki
compiler/Type/Constrain/Expression.hs+17−3
compare with master
unifiedsplit
@@ -2,6 +2,7 @@ module Type.Constrain.Expression where
2
2
3import qualified Data.List as List
3import qualified Data.List as List
4import qualified Data.Map as Map
4import qualified Data.Map as Map
5+import qualified Data.Set as Set
5import Data.Map ((!))
6import Data.Map ((!))
6import Control.Arrow (second)
7import Control.Arrow (second)
7import Control.Applicative ((<$>),(<*>))
8import Control.Applicative ((<$>),(<*>))
@@ -26,7 +27,7 @@ import Parse.Expression
26import Parse.Helpers (iParse)
27import Parse.Helpers (iParse)
27import Type.Solve (solve)
28import Type.Solve (solve)
28import qualified Type.State as TS
29import qualified Type.State as TS
29−import Transform.SortDefinitions
30+import qualified Transform.SortDefinitions as SD
30
31
31test str =
32test str =
32 case iParse expr "" str of
33 case iParse expr "" str of
@@ -34,7 +35,7 @@ test str =
34 Right expression -> do
35 Right expression -> do
35 env <- Env.initialEnvironment
36 env <- Env.initialEnvironment
36 var <- flexibleVar
37 var <- flexibleVar
37− let expr = sortDefs expression
38+ let expr = SD.sortDefs expression
38 print (pretty expr)
39 print (pretty expr)
39 constraint <- constrain env expr (VarN var)
40 constraint <- constrain env expr (VarN var)
40 print =<< extraPretty constraint
41 print =<< extraPretty constraint
@@ -214,6 +215,7 @@ constrainDef env info (pattern, expr, maybeTipe) =
214 , c /\ c2
215 , c /\ c2
215 , c1 )
216 , c1 )
216
217
218+
217instantiateType :: SrcT.Type -> IO Type
219instantiateType :: SrcT.Type -> IO Type
218instantiateType sourceType = instantiateTypeWithContext sourceType Map.empty
220instantiateType sourceType = instantiateTypeWithContext sourceType Map.empty
219
221
@@ -243,8 +245,20 @@ instantiateTypeWithContext sourceType dict = evalStateT (go sourceType) dict
243 SrcT.Record fields ext ->
245 SrcT.Record fields ext ->
244 TermN <$> (Record1 <$> traverse (mapM go) fields <*> go ext)
246 TermN <$> (Record1 <$> traverse (mapM go) fields <*> go ext)
245
247
248+expandPattern :: (Pattern, LExpr t v, Maybe SrcT.Type)
249+ -> [(Pattern, LExpr t v, Maybe SrcT.Type)]
250+expandPattern triple@(pattern, lexpr, maybeType) =
251+ case pattern of
252+ PVar _ -> [triple]
253+ _ -> (PVar x, lexpr, maybeType) : map toDef vars
254+ where
255+ vars = Set.toList $ SD.boundVars pattern
256+ x = concat vars
257+ var = Loc.none . Var
258+ toDef y = (PVar y, Loc.none $ Case (var x) [(pattern, var y)], Nothing)
259+
246collapseDefs :: [Def t v] -> [(Pattern, LExpr t v, Maybe SrcT.Type)]
260collapseDefs :: [Def t v] -> [(Pattern, LExpr t v, Maybe SrcT.Type)]
247−collapseDefs = go [] Map.empty Map.empty
261+collapseDefs = concatMap expandPattern . go [] Map.empty Map.empty
248 where
262 where
249 go output defs typs [] =
263 go output defs typs [] =
250 output ++ concatMap Map.elems [
264 output ++ concatMap Map.elems [