@@ -2,6 +2,7 @@ module Type.Constrain.Expression where
22
33import qualified Data.List as List
44import qualified Data.Map as Map
5+import qualified Data.Set as Set
56import Data.Map ((!))
67import Control.Arrow (second)
78import Control.Applicative ((<$>),(<*>))
@@ -26,7 +27,7 @@ import Parse.Expression
2627import Parse.Helpers (iParse)
2728import Type.Solve (solve)
2829import qualified Type.State as TS
29−import Transform.SortDefinitions
30+import qualified Transform.SortDefinitions as SD
3031
3132test str =
3233 case iParse expr "" str of
@@ -34,7 +35,7 @@ test str =
3435 Right expression -> do
3536 env <- Env.initialEnvironment
3637 var <- flexibleVar
37− let expr = sortDefs expression
38+ let expr = SD.sortDefs expression
3839 print (pretty expr)
3940 constraint <- constrain env expr (VarN var)
4041 print =<< extraPretty constraint
@@ -214,6 +215,7 @@ constrainDef env info (pattern, expr, maybeTipe) =
214215 , c /\ c2
215216 , c1 )
216217
218+
217219instantiateType :: SrcT.Type -> IO Type
218220instantiateType sourceType = instantiateTypeWithContext sourceType Map.empty
219221
@@ -243,8 +245,20 @@ instantiateTypeWithContext sourceType dict = evalStateT (go sourceType) dict
243245 SrcT.Record fields ext ->
244246 TermN <$> (Record1 <$> traverse (mapM go) fields <*> go ext)
245247
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+
246260collapseDefs :: [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
248262 where
249263 go output defs typs [] =
250264 output ++ concatMap Map.elems [