git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Combine Type and Row types to facilitate kind-checking effects later.
9aa9339Phil Freeman
src/Language/PureScript/BindingGroups.hs+1−1
compare with golang
unifiedsplit
@@ -93,6 +93,6 @@ fromValueDecl (ValueDeclaration ident [] Nothing val) = (ident, val)
93fromValueDecl (ValueDeclaration _ _ _ _) = error "Binders should have been desugared"
93fromValueDecl (ValueDeclaration _ _ _ _) = error "Binders should have been desugared"
94fromValueDecl _ = error "Expected ValueDeclaration"
94fromValueDecl _ = error "Expected ValueDeclaration"
95
95
96−fromDataDecl :: Declaration -> (ProperName, [String], [(ProperName, Maybe PolyType)])
96+fromDataDecl :: Declaration -> (ProperName, [String], [(ProperName, Maybe Type)])
97fromDataDecl (DataDeclaration pn args ctors) = (pn, args, ctors)
97fromDataDecl (DataDeclaration pn args ctors) = (pn, args, ctors)
98fromDataDecl _ = error "Expected DataDeclaration"
98fromDataDecl _ = error "Expected DataDeclaration"
src/Language/PureScript/Declarations.hs+6−6
@@ -32,14 +32,14 @@ data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable
32data Module = Module ProperName [Declaration] deriving (Show, D.Data, D.Typeable)
32data Module = Module ProperName [Declaration] deriving (Show, D.Data, D.Typeable)
33
33
34data Declaration
34data Declaration
35− = DataDeclaration ProperName [String] [(ProperName, Maybe PolyType)]
35+ = DataDeclaration ProperName [String] [(ProperName, Maybe Type)]
36− | DataBindingGroupDeclaration [(ProperName, [String], [(ProperName, Maybe PolyType)])]
36+ | DataBindingGroupDeclaration [(ProperName, [String], [(ProperName, Maybe Type)])]
37− | TypeSynonymDeclaration ProperName [String] PolyType
37+ | TypeSynonymDeclaration ProperName [String] Type
38− | TypeDeclaration Ident PolyType
38+ | TypeDeclaration Ident Type
39 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
39 | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
40 | BindingGroupDeclaration [(Ident, Value)]
40 | BindingGroupDeclaration [(Ident, Value)]
41− | ExternDeclaration Ident PolyType
41+ | ExternDeclaration Ident Type
42− | ExternMemberDeclaration String Ident PolyType
42+ | ExternMemberDeclaration String Ident Type
43 | ExternDataDeclaration ProperName Kind
43 | ExternDataDeclaration ProperName Kind
44 | FixityDeclaration Fixity String
44 | FixityDeclaration Fixity String
45 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
45 | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
src/Language/PureScript/Parser/Types.hs+5−5
@@ -84,7 +84,7 @@ parseType = do
84 unless (isMonoType ty) $ P.unexpected "polymorphic type"
84 unless (isMonoType ty) $ P.unexpected "polymorphic type"
85 return ty
85 return ty
86
86
87−parsePolyType :: P.Parsec String ParseState PolyType
87+parsePolyType :: P.Parsec String ParseState Type
88parsePolyType = do
88parsePolyType = do
89 ty <- parseAnyType
89 ty <- parseAnyType
90 unless (isPolyType ty) $ P.unexpected "polymorphic type"
90 unless (isPolyType ty) $ P.unexpected "polymorphic type"
@@ -93,12 +93,12 @@ parsePolyType = do
93parseNameAndType :: P.Parsec String ParseState (String, Type)
93parseNameAndType :: P.Parsec String ParseState (String, Type)
94parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parsePolyType
94parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parsePolyType
95
95
96−parseRowEnding :: P.Parsec String ParseState Row
96+parseRowEnding :: P.Parsec String ParseState Type
97−parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
97+parseRowEnding = P.option REmpty (TypeVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
98
98
99−parseRow :: P.Parsec String ParseState Row
99+parseRow :: P.Parsec String ParseState Type
100parseRow = (fromList <$> (commaSep parseNameAndType) <*> parseRowEnding) P.<?> "row"
100parseRow = (fromList <$> (commaSep parseNameAndType) <*> parseRowEnding) P.<?> "row"
101 where
101 where
102− fromList :: [(String, Type)] -> Row -> Row
102+ fromList :: [(String, Type)] -> Type -> Type
103 fromList [] r = r
103 fromList [] r = r
104 fromList ((name, t):ts) r = RCons name t (fromList ts r)
104 fromList ((name, t):ts) r = RCons name t (fromList ts r)
src/Language/PureScript/Pretty/Types.hs+6−6
@@ -41,18 +41,18 @@ typeLiterals = mkPattern match
41 match (ForAll ident ty) = Just $ "forall " ++ ident ++ ". " ++ prettyPrintType ty
41 match (ForAll ident ty) = Just $ "forall " ++ ident ++ ". " ++ prettyPrintType ty
42 match _ = Nothing
42 match _ = Nothing
43
43
44−prettyPrintRow :: Row -> String
44+prettyPrintRow :: Type -> String
45prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs rest) . toList []
45prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs rest) . toList []
46 where
46 where
47 nameAndTypeToPs :: String -> Type -> String
47 nameAndTypeToPs :: String -> Type -> String
48 nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty
48 nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty
49− tailToPs :: Row -> String
49+ tailToPs :: Type -> String
50 tailToPs REmpty = ""
50 tailToPs REmpty = ""
51− tailToPs (RUnknown (Unknown u)) = " | u" ++ show u
51+ tailToPs (TUnknown (Unknown u)) = " | u" ++ show u
52− tailToPs (RowVar var) = " | " ++ var
52+ tailToPs (TypeVar var) = " | " ++ var
53− tailToPs (RSkolem s) = " | s" ++ show s
53+ tailToPs (Skolem s) = " | s" ++ show s
54 tailToPs _ = error "Invalid row tail"
54 tailToPs _ = error "Invalid row tail"
55− toList :: [(String, Type)] -> Row -> ([(String, Type)], Row)
55+ toList :: [(String, Type)] -> Type -> ([(String, Type)], Type)
56 toList tys (RCons name ty row) = toList ((name, ty):tys) row
56 toList tys (RCons name ty row) = toList ((name, ty):tys) row
57 toList tys r = (tys, r)
57 toList tys r = (tys, r)
58
58
src/Language/PureScript/Pretty/Values.hs+1−1
@@ -82,7 +82,7 @@ lam = mkPattern match
82 match (Abs args val) = Just (map show args, val)
82 match (Abs args val) = Just (map show args, val)
83 match _ = Nothing
83 match _ = Nothing
84
84
85−typed :: Pattern () Value (PolyType, Value)
85+typed :: Pattern () Value (Type, Value)
86typed = mkPattern match
86typed = mkPattern match
87 where
87 where
88 match (TypedValue val ty) = Just (ty, val)
88 match (TypedValue val ty) = Just (ty, val)
src/Language/PureScript/TypeChecker/Kinds.hs+10−13
@@ -59,7 +59,7 @@ instance Unifiable Kind where
59kindOf :: ModuleName -> Type -> Check Kind
59kindOf :: ModuleName -> Type -> Check Kind
60kindOf moduleName ty = fmap (\(k, _, _) -> k) . runSubst (SubstContext moduleName) $ starIfUnknown <$> infer ty
60kindOf moduleName ty = fmap (\(k, _, _) -> k) . runSubst (SubstContext moduleName) $ starIfUnknown <$> infer ty
61
61
62−kindsOf :: ModuleName -> ProperName -> [String] -> [PolyType] -> Check Kind
62+kindsOf :: ModuleName -> ProperName -> [String] -> [Type] -> Check Kind
63kindsOf moduleName name args ts = fmap (starIfUnknown . (\(k, _, _) -> k)) . runSubst (SubstContext moduleName) $ do
63kindsOf moduleName name args ts = fmap (starIfUnknown . (\(k, _, _) -> k)) . runSubst (SubstContext moduleName) $ do
64 tyCon <- fresh
64 tyCon <- fresh
65 kargs <- replicateM (length args) fresh
65 kargs <- replicateM (length args) fresh
@@ -67,7 +67,7 @@ kindsOf moduleName name args ts = fmap (starIfUnknown . (\(k, _, _) -> k)) . run
67 bindLocalTypeVariables moduleName dict $
67 bindLocalTypeVariables moduleName dict $
68 solveTypes ts kargs tyCon
68 solveTypes ts kargs tyCon
69
69
70−kindsOfAll :: ModuleName -> [(ProperName, [String], [PolyType])] -> Check [Kind]
70+kindsOfAll :: ModuleName -> [(ProperName, [String], [Type])] -> Check [Kind]
71kindsOfAll moduleName tys = fmap (map starIfUnknown . (\(ks, _, _) -> ks)) . runSubst (SubstContext moduleName) $ do
71kindsOfAll moduleName tys = fmap (map starIfUnknown . (\(ks, _, _) -> ks)) . runSubst (SubstContext moduleName) $ do
72 tyCons <- replicateM (length tys) fresh
72 tyCons <- replicateM (length tys) fresh
73 let dict = zipWith (\(name, _, _) tyCon -> (name, tyCon)) tys tyCons
73 let dict = zipWith (\(name, _, _) tyCon -> (name, tyCon)) tys tyCons
@@ -91,12 +91,15 @@ starIfUnknown (FunKind k1 k2) = FunKind (starIfUnknown k1) (starIfUnknown k2)
91starIfUnknown k = k
91starIfUnknown k = k
92
92
93infer :: Type -> Subst Kind
93infer :: Type -> Subst Kind
94+infer Number = return Star
95+infer String = return Star
96+infer Boolean = return Star
94infer (Array t) = do
97infer (Array t) = do
95 k <- infer t
98 k <- infer t
96 k ~~ Star
99 k ~~ Star
97 return Star
100 return Star
98infer (Object row) = do
101infer (Object row) = do
99− k <- inferRow row
102+ k <- infer row
100 k ~~ Row
103 k ~~ Row
101 return Star
104 return Star
102infer (Function args ret) = do
105infer (Function args ret) = do
@@ -124,17 +127,11 @@ infer (ForAll ident ty) = do
124 k <- fresh
127 k <- fresh
125 moduleName <- substCurrentModule <$> ask
128 moduleName <- substCurrentModule <$> ask
126 bindLocalTypeVariables moduleName [(ProperName ident, k)] $ infer ty
129 bindLocalTypeVariables moduleName [(ProperName ident, k)] $ infer ty
127−infer _ = return Star
128−
129−inferRow :: Row -> Subst Kind
130−inferRow (RowVar v) = do
131− moduleName <- substCurrentModule <$> ask
132− lookupTypeVariable moduleName (Qualified Nothing (ProperName v))
133−inferRow REmpty = return Row
130+infer REmpty = return Row
134−inferRow (RCons _ ty row) = do
131+infer (RCons _ ty row) = do
135 k1 <- infer ty
132 k1 <- infer ty
136− k2 <- inferRow row
133+ k2 <- infer row
137 k1 ~~ Star
134 k1 ~~ Star
138 k2 ~~ Row
135 k2 ~~ Row
139 return Row
136 return Row
140−inferRow _ = error "Invalid row in inferRow"
137+infer _ = error "Invalid argument to infer"
src/Language/PureScript/TypeChecker/Types.hs+41−57
@@ -57,6 +57,7 @@ instance Unifiable Type where
57 apply s (Object r) = Object (apply s r)
57 apply s (Object r) = Object (apply s r)
58 apply s (Function args ret) = Function (map (apply s) args) (apply s ret)
58 apply s (Function args ret) = Function (map (apply s) args) (apply s ret)
59 apply s (TypeApp t1 t2) = TypeApp (apply s t1) (apply s t2)
59 apply s (TypeApp t1 t2) = TypeApp (apply s t1) (apply s t2)
60+ apply s (RCons name ty r) = RCons name (apply s ty) (apply s r)
60 apply _ t = t
61 apply _ t = t
61 unknowns (TUnknown (Unknown u)) = [u]
62 unknowns (TUnknown (Unknown u)) = [u]
62 unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys
63 unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys
@@ -65,40 +66,6 @@ instance Unifiable Type where
65 unknowns (Object r) = unknowns r
66 unknowns (Object r) = unknowns r
66 unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret
67 unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret
67 unknowns (TypeApp t1 t2) = unknowns t1 ++ unknowns t2
68 unknowns (TypeApp t1 t2) = unknowns t1 ++ unknowns t2
68− unknowns _ = []
69−
70−instance Unifiable Row where
71− unknown = RUnknown
72− isUnknown (RUnknown u) = Just u
73− isUnknown _ = Nothing
74− r1 ~~ r2 =
75− let
76− (s1, r1') = rowToList r1
77− (s2, r2') = rowToList r2
78− int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]
79− sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]
80− sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]
81− in do
82− forM_ int (uncurry (~~))
83− unifyRows sd1 r1' sd2 r2'
84− where
85− unifyRows :: [(String, Type)] -> Row -> [(String, Type)] -> Row -> Subst ()
86− unifyRows [] (RUnknown u) sd r = replace u (rowFromList (sd, r))
87− unifyRows sd r [] (RUnknown u) = replace u (rowFromList (sd, r))
88− unifyRows ((name, ty):row) r others u@(RUnknown un) = do
89− occursCheck un ty
90− forM row $ \(_, t) -> occursCheck un t
91− u' <- fresh
92− u ~~ RCons name ty u'
93− unifyRows row r others u'
94− unifyRows [] REmpty [] REmpty = return ()
95− unifyRows [] (RowVar v1) [] (RowVar v2) | v1 == v2 = return ()
96− unifyRows [] (RSkolem s1) [] (RSkolem s2) | s1 == s2 = return ()
97− unifyRows sd3 r3 sd4 r4 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd3, r3)) ++ " with " ++ prettyPrintRow (rowFromList (sd4, r4)) ++ "."
98− apply s (RUnknown u) = runSubstitution s u
99− apply s (RCons name ty r) = RCons name (apply s ty) (apply s r)
100− apply _ r = r
101− unknowns (RUnknown (Unknown u)) = [u]
102 unknowns (RCons _ ty r) = unknowns ty ++ unknowns r
69 unknowns (RCons _ ty r) = unknowns ty ++ unknowns r
103 unknowns _ = []
70 unknowns _ = []
104
71
@@ -141,8 +108,38 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +
141 t3 `unifyTypes` t5
108 t3 `unifyTypes` t5
142 t4 `unifyTypes` t6
109 t4 `unifyTypes` t6
143 unifyTypes' (Skolem s1) (Skolem s2) | s1 == s2 = return ()
110 unifyTypes' (Skolem s1) (Skolem s2) | s1 == s2 = return ()
111+ unifyTypes' r1@(RCons _ _ _) r2 = unifyRows r1 r2
112+ unifyTypes' r1 r2@(RCons _ _ _) = unifyRows r1 r2
113+ unifyTypes' r1@REmpty r2 = unifyRows r1 r2
114+ unifyTypes' r1 r2@REmpty = unifyRows r1 r2
144 unifyTypes' t3 t4 = throwError $ "Cannot unify " ++ prettyPrintType t3 ++ " with " ++ prettyPrintType t4 ++ "."
115 unifyTypes' t3 t4 = throwError $ "Cannot unify " ++ prettyPrintType t3 ++ " with " ++ prettyPrintType t4 ++ "."
145
116
117+unifyRows :: Type -> Type -> Subst ()
118+unifyRows r1 r2 =
119+ let
120+ (s1, r1') = rowToList r1
121+ (s2, r2') = rowToList r2
122+ int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]
123+ sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]
124+ sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]
125+ in do
126+ forM_ int (uncurry (~~))
127+ unifyRows' sd1 r1' sd2 r2'
128+ where
129+ unifyRows' :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Subst ()
130+ unifyRows' [] (TUnknown u) sd r = replace u (rowFromList (sd, r))
131+ unifyRows' sd r [] (TUnknown u) = replace u (rowFromList (sd, r))
132+ unifyRows' ((name, ty):row) r others u@(TUnknown un) = do
133+ occursCheck un ty
134+ forM row $ \(_, t) -> occursCheck un t
135+ u' <- fresh
136+ u ~~ RCons name ty u'
137+ unifyRows' row r others u'
138+ unifyRows' [] REmpty [] REmpty = return ()
139+ unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()
140+ unifyRows' [] (Skolem s1) [] (Skolem s2) | s1 == s2 = return ()
141+ unifyRows' sd3 r3 sd4 r4 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd3, r3)) ++ " with " ++ prettyPrintRow (rowFromList (sd4, r4)) ++ "."
142+
146typeConstructorsAreEqual :: Environment -> ModuleName -> Qualified ProperName -> Qualified ProperName -> Bool
143typeConstructorsAreEqual :: Environment -> ModuleName -> Qualified ProperName -> Qualified ProperName -> Bool
147typeConstructorsAreEqual env moduleName c1 c2 =
144typeConstructorsAreEqual env moduleName c1 c2 =
148 let
145 let
@@ -198,16 +195,14 @@ escapeCheck checks ty sub =
198
195
199skolemEscapeCheck :: Type -> Check ()
196skolemEscapeCheck :: Type -> Check ()
200skolemEscapeCheck ty =
197skolemEscapeCheck ty =
201− case something (extQ (mkQ Nothing findSkolems) findRSkolems) ty of
198+ case something (mkQ Nothing findSkolems) ty of
202 Nothing -> return ()
199 Nothing -> return ()
203 Just _ -> throwError "Skolem variables cannot escape. Consider adding a type signature."
200 Just _ -> throwError "Skolem variables cannot escape. Consider adding a type signature."
204 where
201 where
205 findSkolems (Skolem _) = return ()
202 findSkolems (Skolem _) = return ()
206 findSkolems _ = mzero
203 findSkolems _ = mzero
207− findRSkolems (RSkolem _) = return ()
208− findRSkolems _ = mzero
209
204
210−setify :: Row -> Row
205+setify :: Type -> Type
211setify = rowFromList . first (M.toList . M.fromList) . rowToList
206setify = rowFromList . first (M.toList . M.fromList) . rowToList
212
207
213setifyAll :: (D.Data d) => d -> d
208setifyAll :: (D.Data d) => d -> d
@@ -217,13 +212,10 @@ varIfUnknown :: Type -> Type
217varIfUnknown ty =
212varIfUnknown ty =
218 let unks = nub $ unknowns ty
213 let unks = nub $ unknowns ty
219 toName = (:) 't' . show
214 toName = (:) 't' . show
220− ty' = everywhere (mkT rowToVar) . everywhere (mkT typeToVar) $ ty
215+ ty' = everywhere (mkT typeToVar) $ ty
221 typeToVar :: Type -> Type
216 typeToVar :: Type -> Type
222 typeToVar (TUnknown (Unknown u)) = TypeVar (toName u)
217 typeToVar (TUnknown (Unknown u)) = TypeVar (toName u)
223 typeToVar t = t
218 typeToVar t = t
224− rowToVar :: Row -> Row
225− rowToVar (RUnknown (Unknown u)) = RowVar (toName u)
226− rowToVar t = t
227 in mkForAll (sort . map toName $ unks) ty'
219 in mkForAll (sort . map toName $ unks) ty'
228
220
229replaceAllTypeVars :: (D.Data d) => [(String, Type)] -> d -> d
221replaceAllTypeVars :: (D.Data d) => [(String, Type)] -> d -> d
@@ -237,12 +229,6 @@ replaceTypeVars name t = everywhereBut (mkQ False isShadowed) (mkT replaceTypeVa
237 isShadowed (ForAll v _) | v == name = True
229 isShadowed (ForAll v _) | v == name = True
238 isShadowed _ = False
230 isShadowed _ = False
239
231
240−replaceRowVars :: (D.Data d) => String -> Row -> d -> d
241−replaceRowVars name r = everywhere (mkT replaceRowVar)
242− where
243− replaceRowVar (RowVar v) | v == name = r
244− replaceRowVar other = other
245−
246replaceAllVarsWithUnknowns :: Type -> Subst Type
232replaceAllVarsWithUnknowns :: Type -> Subst Type
247replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarWithUnknown ident ty >>= replaceAllVarsWithUnknowns
233replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarWithUnknown ident ty >>= replaceAllVarsWithUnknowns
248replaceAllVarsWithUnknowns ty = return ty
234replaceAllVarsWithUnknowns ty = return ty
@@ -250,8 +236,7 @@ replaceAllVarsWithUnknowns ty = return ty
250replaceVarWithUnknown :: String -> Type -> Subst Type
236replaceVarWithUnknown :: String -> Type -> Subst Type
251replaceVarWithUnknown ident ty = do
237replaceVarWithUnknown ident ty = do
252 tu <- fresh
238 tu <- fresh
253− ru <- fresh
254− return $ replaceRowVars ident ru . replaceTypeVars ident tu $ ty
239+ return $ replaceTypeVars ident tu $ ty
255
240
256replaceAllTypeSynonyms :: (Functor m, MonadState CheckState m, MonadReader SubstContext m, MonadError String m) => (D.Data d) => d -> m d
241replaceAllTypeSynonyms :: (Functor m, MonadState CheckState m, MonadReader SubstContext m, MonadError String m) => (D.Data d) => d -> m d
257replaceAllTypeSynonyms d = do
242replaceAllTypeSynonyms d = do
@@ -488,7 +473,7 @@ inferBinder val (ObjectBinder props) = do
488 val ~~ Object row
473 val ~~ Object row
489 return m1
474 return m1
490 where
475 where
491− inferRowProperties :: Row -> Row -> [(String, Binder)] -> Subst (M.Map Ident Type)
476+ inferRowProperties :: Type -> Type -> [(String, Binder)] -> Subst (M.Map Ident Type)
492 inferRowProperties nrow row [] = nrow ~~ row >> return M.empty
477 inferRowProperties nrow row [] = nrow ~~ row >> return M.empty
493 inferRowProperties nrow row ((name, binder):binders) = do
478 inferRowProperties nrow row ((name, binder):binders) = do
494 propTy <- fresh
479 propTy <- fresh
@@ -598,8 +583,7 @@ checkBlock mass ret (s:ss) = do
598skolemize :: String -> Type -> Subst Type
583skolemize :: String -> Type -> Subst Type
599skolemize ident ty = do
584skolemize ident ty = do
600 tsk <- Skolem <$> fresh'
585 tsk <- Skolem <$> fresh'
601− rsk <- RSkolem <$> fresh'
602− return $ replaceRowVars ident rsk $ replaceTypeVars ident tsk ty
586+ return $ replaceTypeVars ident tsk ty
603
587
604check :: Value -> Type -> Subst ()
588check :: Value -> Type -> Subst ()
605check val ty = rethrow errorMessage $ check' val ty
589check val ty = rethrow errorMessage $ check' val ty
@@ -684,15 +668,15 @@ check' val (SaturatedTypeSynonym name args) = do
684 check val ty
668 check val ty
685check' val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ prettyPrintType ty
669check' val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ prettyPrintType ty
686
670
687−checkProperties :: [(String, Value)] -> Row -> Bool -> Subst ()
671+checkProperties :: [(String, Value)] -> Type -> Bool -> Subst ()
688checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where
672checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where
689 go [] [] REmpty = return ()
673 go [] [] REmpty = return ()
690− go [] [] u@(RUnknown _) = u ~~ REmpty
674+ go [] [] u@(TUnknown _) = u ~~ REmpty
691− go [] [] (RSkolem _) | lax = return ()
675+ go [] [] (Skolem _) | lax = return ()
692 go [] ((p, _): _) _ | lax = return ()
676 go [] ((p, _): _) _ | lax = return ()
693 | otherwise = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have property " ++ p
677 | otherwise = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have property " ++ p
694 go ((p,_):_) [] REmpty = throwError $ "Property " ++ p ++ " is not present in closed object type " ++ prettyPrintRow row
678 go ((p,_):_) [] REmpty = throwError $ "Property " ++ p ++ " is not present in closed object type " ++ prettyPrintRow row
695− go ((p,v):ps') [] u@(RUnknown _) = do
679+ go ((p,v):ps') [] u@(TUnknown _) = do
696 ty <- infer v
680 ty <- infer v
697 rest <- fresh
681 rest <- fresh
698 u ~~ RCons p ty rest
682 u ~~ RCons p ty rest
src/Language/PureScript/Types.hs+7−14
@@ -26,30 +26,23 @@ data Type
26 | String
26 | String
27 | Boolean
27 | Boolean
28 | Array Type
28 | Array Type
29− | Object Row
29+ | Object Type
30− | Function [PolyType] Type
30+ | Function [Type] Type
31 | TypeVar String
31 | TypeVar String
32 | TypeConstructor (Qualified ProperName)
32 | TypeConstructor (Qualified ProperName)
33 | TypeApp Type Type
33 | TypeApp Type Type
34 | SaturatedTypeSynonym (Qualified ProperName) [Type]
34 | SaturatedTypeSynonym (Qualified ProperName) [Type]
35 | ForAll String Type
35 | ForAll String Type
36− | Skolem Int deriving (Show, Eq, Data, Typeable)
36+ | Skolem Int
37−
38−type PolyType = Type
39−
40−data Row
41− = RUnknown (Unknown Row)
42− | RowVar String
43 | REmpty
37 | REmpty
44− | RCons String Type Row
45− | RSkolem Int deriving (Show, Eq, Data, Typeable)
38+ | RCons String Type Type deriving (Show, Eq, Data, Typeable)
46
39
47−rowToList :: Row -> ([(String, Type)], Row)
40+rowToList :: Type -> ([(String, Type)], Type)
48rowToList (RCons name ty row) = let (tys, rest) = rowToList row
41rowToList (RCons name ty row) = let (tys, rest) = rowToList row
49− in ((name, ty):tys, rest)
42+ in ((name, ty):tys, rest)
50rowToList r = ([], r)
43rowToList r = ([], r)
51
44
52−rowFromList :: ([(String, Type)], Row) -> Row
45+rowFromList :: ([(String, Type)], Type) -> Type
53rowFromList ([], r) = r
46rowFromList ([], r) = r
54rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
47rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
55
48
src/Language/PureScript/Values.hs+1−1
@@ -70,7 +70,7 @@ data Value
70 | Block [Statement]
70 | Block [Statement]
71 | Constructor (Qualified ProperName)
71 | Constructor (Qualified ProperName)
72 | Case [Value] [([Binder], Maybe Guard, Value)]
72 | Case [Value] [([Binder], Maybe Guard, Value)]
73− | TypedValue Value PolyType deriving (Show, Data, Typeable)
73+ | TypedValue Value Type deriving (Show, Data, Typeable)
74
74
75data Statement
75data Statement
76 = VariableIntroduction Ident Value
76 = VariableIntroduction Ident Value