4cbe6e3 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Use monad-unify 0.2.0

commit4cbe6e390583cbc26b12452b64f997aa1ad651e2 authorPhil Freeman <paf31@cantab.net> dateTue 4 Feb 2014, 11:31 (13 years ago) parent8ecd1e9

8 files changed+102−92

compare with golang

unifiedsplit

purescript.cabal+1−1 src/Language/PureScript/Kinds.hs+2−2 src/Language/PureScript/Pretty/Kinds.hs+1−1 src/Language/PureScript/Pretty/Types.hs+2−2 src/Language/PureScript/TypeChecker/Kinds.hs+28−22 src/Language/PureScript/TypeChecker/Monad.hs+4−4 src/Language/PureScript/TypeChecker/Types.hs+63−59 src/Language/PureScript/Types.hs+1−1

purescript.cabal+1−1

@@ -1,5 +1,5 @@

11name: purescript

2−version: 0.3.8

2+version: 0.3.8.1

33cabal-version: >=1.8

44build-type: Simple

55license: MIT

src/Language/PureScript/Kinds.hs+2−2

@@ -18,7 +18,7 @@ module Language.PureScript.Kinds where

1818

1919import Data.Data

2020

21−import Control.Monad.Unify (TypedUnknown(..))

21+import Control.Monad.Unify (Unknown)

2222

2323-- |

2424-- The data type of kinds

@@ -27,7 +27,7 @@ data Kind

2727 -- |

2828 -- Unification variable of type Kind

2929 --

30− = KUnknown (TypedUnknown Kind)

30+ = KUnknown Unknown

3131 -- |

3232 -- The kind of types

3333 --

src/Language/PureScript/Pretty/Kinds.hs+1−1

@@ -31,7 +31,7 @@ typeLiterals = mkPattern match

3131 where

3232 match Star = Just "*"

3333 match Bang = Just "!"

34− match (KUnknown (TypedUnknown (Unknown u))) = Just $ 'u' : show u

34+ match (KUnknown (Unknown u)) = Just $ 'u' : show u

3535 match _ = Nothing

3636

3737matchRow :: Pattern () Kind ((), Kind)

src/Language/PureScript/Pretty/Types.hs+2−2

@@ -35,7 +35,7 @@ typeLiterals = mkPattern match

3535 match (TypeVar var) = Just var

3636 match (TypeApp arr ty) | arr == tyArray = Just $ "[" ++ prettyPrintType ty ++ "]"

3737 match (TypeConstructor ctor) = Just $ show ctor

38− match (TUnknown (TypedUnknown (Unknown u))) = Just $ 'u' : show u

38+ match (TUnknown (Unknown u)) = Just $ 'u' : show u

3939 match (Skolem s) = Just $ 's' : show s

4040 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate "," (map (\(pn, ty') -> show pn ++ " (" ++ prettyPrintType ty' ++ ")") deps) ++ ") => " ++ prettyPrintType ty

4141 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintType args) ++ ">"

@@ -54,7 +54,7 @@ prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs

5454 nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty

5555 tailToPs :: Type -> String

5656 tailToPs REmpty = ""

57− tailToPs (TUnknown (TypedUnknown (Unknown u))) = " | u" ++ show u

57+ tailToPs (TUnknown (Unknown u)) = " | u" ++ show u

5858 tailToPs (TypeVar var) = " | " ++ var

5959 tailToPs (Skolem s) = " | s" ++ show s

6060 tailToPs _ = error "Invalid row tail"

src/Language/PureScript/TypeChecker/Kinds.hs+28−22

@@ -38,37 +38,43 @@ import Control.Applicative

3838

3939import qualified Data.Map as M

4040

41−instance Unifiable Check Kind where

41+instance Partial Kind where

4242 unknown = KUnknown

4343 isUnknown (KUnknown u) = Just u

4444 isUnknown _ = Nothing

45− KUnknown u1 ?= KUnknown u2 | u1 == u2 = return ()

46− KUnknown u ?= k = replace u k

47− k ?= KUnknown u = replace u k

48− Star ?= Star = return ()

49− Bang ?= Bang = return ()

50− Row k1 ?= Row k2 = k1 ?= k2

51− FunKind k1 k2 ?= FunKind k3 k4 = do

52− k1 ?= k3

53− k2 ?= k4

54− k1 ?= k2 = UnifyT . lift . throwError $ "Cannot unify " ++ prettyPrintKind k1 ++ " with " ++ prettyPrintKind k2 ++ "."

45+

46+instance Unifiable Check Kind where

47+ KUnknown u1 =?= KUnknown u2 | u1 == u2 = return ()

48+ KUnknown u =?= k = u =:= k

49+ k =?= KUnknown u = u =:= k

50+ Star =?= Star = return ()

51+ Bang =?= Bang = return ()

52+ Row k1 =?= Row k2 = k1 =?= k2

53+ FunKind k1 k2 =?= FunKind k3 k4 = do

54+ k1 =?= k3

55+ k2 =?= k4

56+ k1 =?= k2 = UnifyT . lift . throwError $ "Cannot unify " ++ prettyPrintKind k1 ++ " with " ++ prettyPrintKind k2 ++ "."

5557

5658-- |

5759-- Infer the kind of a single type

5860--

5961kindOf :: ModuleName -> Type -> Check Kind

60−kindOf moduleName ty = liftUnify $ starIfUnknown <$> infer ty

62+kindOf moduleName ty = fmap tidyUp . liftUnify $ starIfUnknown <$> infer ty

63+ where

64+ tidyUp (k, sub) = sub $? k

6165

6266-- |

6367-- Infer the kind of a type constructor with a collection of arguments and a collection of associated data constructors

6468--

6569kindsOf :: ModuleName -> ProperName -> [String] -> [Type] -> Check Kind

66−kindsOf moduleName name args ts = fmap starIfUnknown . liftUnify $ do

70+kindsOf moduleName name args ts = fmap tidyUp . liftUnify $ do

6771 tyCon <- fresh

6872 kargs <- replicateM (length args) fresh

6973 let dict = (name, tyCon) : zip (map ProperName args) kargs

7074 bindLocalTypeVariables moduleName dict $

7175 solveTypes ts kargs tyCon

76+ where

77+ tidyUp (k, sub) = sub $? k

7278

7379-- |

7480-- Simultaneously infer the kinds of several mutually recursive type constructors

@@ -93,16 +99,16 @@ kindsOfAll moduleName syns tys = fmap tidyUp . liftUnify $ do

9399 solveTypes [ty] kargs synVar) synVars syns

94100 return (syn_ks, data_ks)

95101 where

96− tidyUp (ks1, ks2) = (map starIfUnknown ks1, map starIfUnknown ks2)

102+ tidyUp ((ks1, ks2), sub) = (map (starIfUnknown . (sub $?)) ks1, map (starIfUnknown . (sub $?)) ks2)

97103

98104-- |

99105-- Solve the set of kind constraints associated with the data constructors for a type constructor

100106--

101−solveTypes :: [Type] -> [Kind] -> Kind -> UnifyT Check Kind

107+solveTypes :: [Type] -> [Kind] -> Kind -> UnifyT Kind Check Kind

102108solveTypes ts kargs tyCon = do

103109 ks <- mapM infer ts

104− tyCon ?= foldr FunKind Star kargs

105− forM_ ks $ \k -> k ?= Star

110+ tyCon =?= foldr FunKind Star kargs

111+ forM_ ks $ \k -> k =?= Star

106112 return tyCon

107113

108114-- |

@@ -116,10 +122,10 @@ starIfUnknown k = k

116122-- |

117123-- Infer a kind for a type

118124--

119−infer :: Type -> UnifyT Check Kind

125+infer :: Type -> UnifyT Kind Check Kind

120126infer (Object row) = do

121127 k <- infer row

122− k ?= Row Star

128+ k =?= Row Star

123129 return Star

124130infer (TypeVar v) = do

125131 Just moduleName <- checkCurrentModule <$> get

@@ -134,7 +140,7 @@ infer (TypeApp t1 t2) = do

134140 k0 <- fresh

135141 k1 <- infer t1

136142 k2 <- infer t2

137− k1 ?= FunKind k2 k0

143+ k1 =?= FunKind k2 k0

138144 return k0

139145infer (ForAll ident ty) = do

140146 k <- fresh

@@ -146,11 +152,11 @@ infer REmpty = do

146152infer (RCons _ ty row) = do

147153 k1 <- infer ty

148154 k2 <- infer row

149− k2 ?= Row k1

155+ k2 =?= Row k1

150156 return $ Row k1

151157infer (ConstrainedType deps ty) = do

152158 mapM_ (infer . snd) deps

153159 k <- infer ty

154− k ?= Star

160+ k =?= Star

155161 return Star

156162infer _ = error "Invalid argument to infer"

src/Language/PureScript/TypeChecker/Monad.hs+4−4

@@ -210,7 +210,7 @@ canonicalizeType _ _ (Qualified (Just mn) nm) = (mn, nm)

210210canonicalizeType mn env (Qualified Nothing nm) = case (mn, nm) `M.lookup` types env of

211211 Just (_, DataAlias mn' pn') -> (mn', pn')

212212 _ -> (mn, nm)

213−

213+

214214-- |

215215-- Canonicalize a data constructor by resolving any aliases introduced by module imports

216216--

@@ -299,13 +299,13 @@ freshDictionaryName = do

299299-- |

300300-- Lift a computation in the @Check@ monad into the substitution monad.

301301--

302−liftCheck :: Check a -> UnifyT Check a

302+liftCheck :: Check a -> UnifyT t Check a

303303liftCheck = UnifyT . lift . lift

304304

305305-- |

306306-- Run a computation in the substitution monad, generating a return value and the final substitution.

307307--

308−liftUnify :: (Data a) => UnifyT Check a -> Check a

308+liftUnify :: (Partial t) => UnifyT t Check a -> Check (a, Substitution t)

309309liftUnify unify = do

310310 st <- get

311311 e <- runUnify (defaultUnifyState { unifyNextVar = checkNextVar st }) unify

@@ -313,7 +313,7 @@ liftUnify unify = do

313313 Left err -> throwError err

314314 Right (a, ust) -> do

315315 modify $ \st -> st { checkNextVar = unifyNextVar ust }

316− return $ runSubstitution (unifyCurrentSubstitution ust) a

316+ return (a, unifyCurrentSubstitution ust)

317317

318318-- |

319319-- Replace any unqualified names in a type wit their qualified versionss

src/Language/PureScript/TypeChecker/Types.hs+63−59

@@ -67,22 +67,24 @@ import Control.Arrow (Arrow(..))

6767import qualified Data.Map as M

6868import Data.Function (on)

6969

70−instance Unifiable Check Type where

70+instance Partial Type where

7171 unknown = TUnknown

7272 isUnknown (TUnknown u) = Just u

7373 isUnknown _ = Nothing

74− (?=) = unifyTypes

74+

75+instance Unifiable Check Type where

76+ (=?=) = unifyTypes

7577

7678-- |

7779-- Unify two types, updating the current substitution

7880--

79−unifyTypes :: Type -> Type -> UnifyT Check ()

81+unifyTypes :: Type -> Type -> UnifyT Type Check ()

8082unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 ++ " with type " ++ prettyPrintType t2 ++ ":\n" ++ e) $ do

8183 unifyTypes' t1 t2

8284 where

8385 unifyTypes' (TUnknown u1) (TUnknown u2) | u1 == u2 = return ()

84− unifyTypes' (TUnknown u) t = replace u t

85− unifyTypes' t (TUnknown u) = replace u t

86+ unifyTypes' (TUnknown u) t = u =:= t

87+ unifyTypes' t (TUnknown u) = u =:= t

8688 unifyTypes' (SaturatedTypeSynonym name args) ty = do

8789 ty1 <- expandTypeSynonym name args

8890 ty1 `unifyTypes` ty

@@ -95,7 +97,7 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +

9597 sk <- skolemize ident ty1

9698 sk `unifyTypes` ty2

9799 unifyTypes' ty f@(ForAll _ _) = f `unifyTypes` ty

98− unifyTypes' (Object row1) (Object row2) = row1 ?= row2

100+ unifyTypes' (Object row1) (Object row2) = row1 =?= row2

99101 unifyTypes' (TypeVar v1) (TypeVar v2) | v1 == v2 = return ()

100102 unifyTypes' (TypeConstructor c1) (TypeConstructor c2) = do

101103 env <- getEnv

@@ -118,7 +120,7 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +

118120-- trailing row unification variable, if appropriate, otherwise leftover labels result in a unification

119121-- error.

120122--

121−unifyRows :: Type -> Type -> UnifyT Check ()

123+unifyRows :: Type -> Type -> UnifyT Type Check ()

122124unifyRows r1 r2 =

123125 let

124126 (s1, r1') = rowToList r1

@@ -127,17 +129,17 @@ unifyRows r1 r2 =

127129 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

128130 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

129131 in do

130− forM_ int (uncurry (?=))

132+ forM_ int (uncurry (=?=))

131133 unifyRows' sd1 r1' sd2 r2'

132134 where

133− unifyRows' :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> UnifyT Check ()

134− unifyRows' [] (TUnknown u) sd r = replace u (rowFromList (sd, r))

135− unifyRows' sd r [] (TUnknown u) = replace u (rowFromList (sd, r))

135+ unifyRows' :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> UnifyT Type Check ()

136+ unifyRows' [] (TUnknown u) sd r = u =:= rowFromList (sd, r)

137+ unifyRows' sd r [] (TUnknown u) = u =:= rowFromList (sd, r)

136138 unifyRows' ((name, ty):row) r others u@(TUnknown un) = do

137139 occursCheck un ty

138140 forM_ row $ \(_, t) -> occursCheck un t

139141 u' <- fresh

140− u ?= RCons name ty u'

142+ u =?= RCons name ty u'

141143 unifyRows' row r others u'

142144 unifyRows' [] REmpty [] REmpty = return ()

143145 unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()

@@ -156,7 +158,7 @@ typeConstructorsAreEqual env moduleName = (==) `on` canonicalizeType moduleName

156158--

157159typesOf :: ModuleName -> [(Ident, Value)] -> Check [(Ident, (Value, Type))]

158160typesOf moduleName vals = do

159− tys <- liftUnify $ do

161+ tys <- fmap tidyUp . liftUnify $ do

160162 let es = map isTyped vals

161163 typed = filter (isJust . snd . snd) es

162164 untyped = filter (isNothing . snd . snd) es

@@ -174,11 +176,11 @@ typesOf moduleName vals = do

174176 return (ident, (val', ty'))

175177 (ident, (val, Nothing)) -> do

176178 TypedValue _ val' ty <- bindNames dict $ infer val

177− ty ?= fromMaybe (error "name not found in dictionary") (lookup ident untypedDict)

179+ ty =?= fromMaybe (error "name not found in dictionary") (lookup ident untypedDict)

178180 return (ident, (val', ty))

179181 when (moduleName == ModuleName (ProperName "Main") && fst e == Ident "main") $ do

180182 [eff, a] <- replicateM 2 fresh

181− ty ?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName (ProperName "Eff"))) (ProperName "Eff"))) eff) a

183+ ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName (ProperName "Eff"))) (ProperName "Eff"))) eff) a

182184 escapeCheck val ty

183185 return triple

184186 forM_ tys $ skolemEscapeCheck . snd . snd

@@ -186,6 +188,8 @@ typesOf moduleName vals = do

186188 val' <- replaceTypeClassDictionaries moduleName val

187189 return (ident, (overTypes (desaturateAllTypeSynonyms . setifyAll) $ val'

188190 , varIfUnknown . desaturateAllTypeSynonyms . setifyAll $ ty))

191+ where

192+ tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (sub $?) val, sub $? ty))) ts

189193

190194-- |

191195-- Check if a value contains a type annotation

@@ -257,14 +261,14 @@ typeHeadsAreEqual _ _ _ _ = Nothing

257261-- |

258262-- Ensure unsolved unification variables do not escape

259263--

260−escapeCheck :: Value -> Type -> UnifyT Check ()

264+escapeCheck :: Value -> Type -> UnifyT Type Check ()

261265escapeCheck value ty = do

262266 subst <- unifyCurrentSubstitution <$> UnifyT get

263− let visibleUnknowns = nub $ unknowns $ runSubstitution subst ty

267+ let visibleUnknowns = nub $ unknowns $ subst $? ty

264268 let allUnknowns = findAllTypes value

265269 forM_ allUnknowns $ \t -> do

266− let unsolvedUnknowns = nub . unknowns $ runSubstitution subst t

267− guardWith ("Escape check fails" ++ show ( runSubstitution subst ty, runSubstitution subst t)) $ null $ unsolvedUnknowns \\ visibleUnknowns

270+ let unsolvedUnknowns = nub . unknowns $ subst $? t

271+ guardWith ("Escape check fails" ++ show (subst $? ty, subst $? t)) $ null $ unsolvedUnknowns \\ visibleUnknowns

268272

269273-- |

270274-- Find all type annotations occuring inside a value

@@ -308,7 +312,7 @@ varIfUnknown ty =

308312 toName = (:) 't' . show

309313 ty' = everywhere (mkT typeToVar) $ ty

310314 typeToVar :: Type -> Type

311− typeToVar (TUnknown (TypedUnknown (Unknown u))) = TypeVar (toName u)

315+ typeToVar (TUnknown (Unknown u)) = TypeVar (toName u)

312316 typeToVar t = t

313317 in mkForAll (sort . map (toName . runUnknown) $ unks) ty'

314318

@@ -321,14 +325,14 @@ replaceAllTypeVars = foldl' (\f (name, ty) -> replaceTypeVars name ty . f) id

321325-- |

322326-- Replace named type variables with new unification variables

323327--

324−replaceAllVarsWithUnknowns :: Type -> UnifyT Check Type

328+replaceAllVarsWithUnknowns :: Type -> UnifyT Type Check Type

325329replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarWithUnknown ident ty >>= replaceAllVarsWithUnknowns

326330replaceAllVarsWithUnknowns ty = return ty

327331

328332-- |

329333-- Replace a single type variable with a new unification variable

330334--

331−replaceVarWithUnknown :: String -> Type -> UnifyT Check Type

335+replaceVarWithUnknown :: String -> Type -> UnifyT Type Check Type

332336replaceVarWithUnknown ident ty = do

333337 tu <- fresh

334338 return $ replaceTypeVars ident tu $ ty

@@ -356,7 +360,7 @@ desaturateAllTypeSynonyms = everywhere (mkT replaceSaturatedTypeSynonym)

356360-- |

357361-- Replace a type synonym and its arguments with the aliased type

358362--

359−expandTypeSynonym :: Qualified ProperName -> [Type] -> UnifyT Check Type

363+expandTypeSynonym :: Qualified ProperName -> [Type] -> UnifyT Type Check Type

360364expandTypeSynonym name args = do

361365 env <- getEnv

362366 Just moduleName <- checkCurrentModule <$> get

@@ -373,20 +377,20 @@ ensureNoDuplicateProperties ps = guardWith "Duplicate property names" $ length (

373377-- |

374378-- Infer a type for a value, rethrowing any error to provide a more useful error message

375379--

376−infer :: Value -> UnifyT Check Value

380+infer :: Value -> UnifyT Type Check Value

377381infer val = rethrow (\e -> "Error inferring type of term " ++ prettyPrintValue val ++ ":\n" ++ e) $ infer' val

378382

379383-- |

380384-- Infer a type for a value

381385--

382−infer' :: Value -> UnifyT Check Value

386+infer' :: Value -> UnifyT Type Check Value

383387infer' v@(NumericLiteral _) = return $ TypedValue True v tyNumber

384388infer' v@(StringLiteral _) = return $ TypedValue True v tyString

385389infer' v@(BooleanLiteral _) = return $ TypedValue True v tyBoolean

386390infer' (ArrayLiteral vals) = do

387391 ts <- mapM infer vals

388392 els <- fresh

389− forM_ ts $ \(TypedValue _ _ t) -> els ?= TypeApp tyArray t

393+ forM_ ts $ \(TypedValue _ _ t) -> els =?= TypeApp tyArray t

390394 return $ TypedValue True (ArrayLiteral ts) els

391395infer' (ObjectLiteral ps) = do

392396 ensureNoDuplicateProperties ps

@@ -454,7 +458,7 @@ infer' (IfThenElse cond th el) = do

454458 cond' <- check cond tyBoolean

455459 v2@(TypedValue _ _ t2) <- infer th

456460 v3@(TypedValue _ _ t3) <- infer el

457− t2 ?= t3

461+ t2 =?= t3

458462 return $ TypedValue True (IfThenElse cond' v2 v3) t2

459463infer' (TypedValue checkType val ty) = do

460464 Just moduleName <- checkCurrentModule <$> get

@@ -468,7 +472,7 @@ infer' _ = error "Invalid argument to infer"

468472-- |

469473-- Infer the type of a property inside a record with a given type

470474--

471−inferProperty :: Type -> String -> UnifyT Check (Maybe Type)

475+inferProperty :: Type -> String -> UnifyT Type Check (Maybe Type)

472476inferProperty (Object row) prop = do

473477 let (props, _) = rowToList row

474478 return $ lookup prop props

@@ -483,11 +487,11 @@ inferProperty _ _ = return Nothing

483487-- |

484488-- Infer the types of variables brought into scope by a binder

485489--

486−inferBinder :: Type -> Binder -> UnifyT Check (M.Map Ident Type)

490+inferBinder :: Type -> Binder -> UnifyT Type Check (M.Map Ident Type)

487491inferBinder _ NullBinder = return M.empty

488−inferBinder val (StringBinder _) = val ?= tyString >> return M.empty

489−inferBinder val (NumberBinder _) = val ?= tyNumber >> return M.empty

490−inferBinder val (BooleanBinder _) = val ?= tyBoolean >> return M.empty

492+inferBinder val (StringBinder _) = val =?= tyString >> return M.empty

493+inferBinder val (NumberBinder _) = val =?= tyNumber >> return M.empty

494+inferBinder val (BooleanBinder _) = val =?= tyBoolean >> return M.empty

491495inferBinder val (VarBinder name) = return $ M.singleton name val

492496inferBinder val (NullaryBinder ctor) = do

493497 env <- getEnv

@@ -513,11 +517,11 @@ inferBinder val (ObjectBinder props) = do

513517 row <- fresh

514518 rest <- fresh

515519 m1 <- inferRowProperties row rest props

516− val ?= Object row

520+ val =?= Object row

517521 return m1

518522 where

519− inferRowProperties :: Type -> Type -> [(String, Binder)] -> UnifyT Check (M.Map Ident Type)

520− inferRowProperties nrow row [] = nrow ?= row >> return M.empty

523+ inferRowProperties :: Type -> Type -> [(String, Binder)] -> UnifyT Type Check (M.Map Ident Type)

524+ inferRowProperties nrow row [] = nrow =?= row >> return M.empty

521525 inferRowProperties nrow row ((name, binder):binders) = do

522526 propTy <- fresh

523527 m1 <- inferBinder propTy binder

@@ -526,13 +530,13 @@ inferBinder val (ObjectBinder props) = do

526530inferBinder val (ArrayBinder binders) = do

527531 el <- fresh

528532 m1 <- M.unions <$> mapM (inferBinder el) binders

529− val ?= TypeApp tyArray el

533+ val =?= TypeApp tyArray el

530534 return m1

531535inferBinder val (ConsBinder headBinder tailBinder) = do

532536 el <- fresh

533537 m1 <- inferBinder el headBinder

534538 m2 <- inferBinder val tailBinder

535− val ?= TypeApp tyArray el

539+ val =?= TypeApp tyArray el

536540 return $ m1 `M.union` m2

537541inferBinder val (NamedBinder name binder) = do

538542 m <- inferBinder val binder

@@ -541,7 +545,7 @@ inferBinder val (NamedBinder name binder) = do

541545-- |

542546-- Check the types of the return values in a set of binders in a case statement

543547--

544−checkBinders :: [Type] -> Type -> [([Binder], Maybe Guard, Value)] -> UnifyT Check [([Binder], Maybe Guard, Value)]

548+checkBinders :: [Type] -> Type -> [([Binder], Maybe Guard, Value)] -> UnifyT Type Check [([Binder], Maybe Guard, Value)]

545549checkBinders _ _ [] = return []

546550checkBinders nvals ret ((binders, grd, val):bs) = do

547551 Just moduleName <- checkCurrentModule <$> get

@@ -559,7 +563,7 @@ checkBinders nvals ret ((binders, grd, val):bs) = do

559563-- |

560564-- Check that a local variable name is not already used

561565--

562−assignVariable :: Ident -> UnifyT Check ()

566+assignVariable :: Ident -> UnifyT Type Check ()

563567assignVariable name = do

564568 env <- checkEnv <$> get

565569 Just moduleName <- checkCurrentModule <$> get

@@ -571,7 +575,7 @@ assignVariable name = do

571575-- Check the type of the return values of a statement, returning whether or not the statement returns on

572576-- all code paths

573577--

574−checkStatement :: M.Map Ident Type -> Type -> Statement -> UnifyT Check (Bool, M.Map Ident Type, Statement)

578+checkStatement :: M.Map Ident Type -> Type -> Statement -> UnifyT Type Check (Bool, M.Map Ident Type, Statement)

575579checkStatement mass _ (VariableIntroduction name val) = do

576580 assignVariable name

577581 val'@(TypedValue _ _ t) <- infer val

@@ -580,7 +584,7 @@ checkStatement mass _ (Assignment ident val) = do

580584 val'@(TypedValue _ _ t) <- infer val

581585 case M.lookup ident mass of

582586 Nothing -> throwError $ "No local variable with name " ++ show ident

583− Just ty -> do t ?= ty

587+ Just ty -> do t =?= ty

584588 return (False, mass, Assignment ident val')

585589checkStatement mass ret (While val inner) = do

586590 val' <- check val tyBoolean

@@ -603,7 +607,7 @@ checkStatement mass ret (Return val) = do

603607-- |

604608-- Check the type of an if-then-else statement

605609--

606−checkIfStatement :: M.Map Ident Type -> Type -> IfStatement -> UnifyT Check (Bool, IfStatement)

610+checkIfStatement :: M.Map Ident Type -> Type -> IfStatement -> UnifyT Type Check (Bool, IfStatement)

607611checkIfStatement mass ret (IfStatement val thens Nothing) = do

608612 val' <- check val tyBoolean

609613 (_, _, thens') <- checkBlock mass ret thens

@@ -617,7 +621,7 @@ checkIfStatement mass ret (IfStatement val thens (Just elses)) = do

617621-- |

618622-- Check the type of an else statement

619623--

620−checkElseStatement :: M.Map Ident Type -> Type -> ElseStatement -> UnifyT Check (Bool, ElseStatement)

624+checkElseStatement :: M.Map Ident Type -> Type -> ElseStatement -> UnifyT Type Check (Bool, ElseStatement)

621625checkElseStatement mass ret (Else elses) = do

622626 (allCodePathsReturn, _, elses') <- checkBlock mass ret elses

623627 return (allCodePathsReturn, Else elses')

@@ -626,7 +630,7 @@ checkElseStatement mass ret (ElseIf ifst) = (id *** ElseIf) <$> checkIfStatement

626630-- |

627631-- Check the type of the return value of a block of statements

628632--

629−checkBlock :: M.Map Ident Type -> Type -> [Statement] -> UnifyT Check (Bool, M.Map Ident Type, [Statement])

633+checkBlock :: M.Map Ident Type -> Type -> [Statement] -> UnifyT Type Check (Bool, M.Map Ident Type, [Statement])

630634checkBlock mass _ [] = return (False, mass, [])

631635checkBlock mass ret (s:ss) = do

632636 Just moduleName <- checkCurrentModule <$> get

@@ -641,7 +645,7 @@ checkBlock mass ret (s:ss) = do

641645-- |

642646-- Skolemize a type variable by replacing its instances with fresh skolem constants

643647--

644−skolemize :: String -> Type -> UnifyT Check Type

648+skolemize :: String -> Type -> UnifyT Type Check Type

645649skolemize ident ty = do

646650 tsk <- Skolem . runUnknown <$> fresh'

647651 return $ replaceTypeVars ident tsk ty

@@ -649,7 +653,7 @@ skolemize ident ty = do

649653-- |

650654-- Check the type of a value, rethrowing errors to provide a better error message

651655--

652−check :: Value -> Type -> UnifyT Check Value

656+check :: Value -> Type -> UnifyT Type Check Value

653657check val ty = rethrow errorMessage $ check' val ty

654658 where

655659 errorMessage msg =

@@ -663,7 +667,7 @@ check val ty = rethrow errorMessage $ check' val ty

663667-- |

664668-- Check the type of a value

665669--

666−check' :: Value -> Type -> UnifyT Check Value

670+check' :: Value -> Type -> UnifyT Type Check Value

667671check' val (ForAll idents ty) = do

668672 sk <- skolemize idents ty

669673 check val sk

@@ -682,7 +686,7 @@ check' val u@(TUnknown _) = do

682686 val'@(TypedValue _ _ ty) <- infer val

683687 -- Don't unify an unknown with an inferred polytype

684688 ty' <- replaceAllVarsWithUnknowns ty

685− ty' ?= u

689+ ty' =?= u

686690 return val'

687691check' v@(NumericLiteral _) t | t == tyNumber = return v

688692check' v@(StringLiteral _) t | t == tyString = return v

@@ -765,10 +769,10 @@ check' val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ p

765769--

766770-- The @lax@ parameter controls whether or not every record member has to be provided. For object updates, this is not the case.

767771--

768−checkProperties :: [(String, Value)] -> Type -> Bool -> UnifyT Check [(String, Value)]

772+checkProperties :: [(String, Value)] -> Type -> Bool -> UnifyT Type Check [(String, Value)]

769773checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where

770774 go [] [] REmpty = return []

771− go [] [] u@(TUnknown _) = do u ?= REmpty

775+ go [] [] u@(TUnknown _) = do u =?= REmpty

772776 return []

773777 go [] [] (Skolem _) | lax = return []

774778 go [] ((p, _): _) _ | lax = return []

@@ -777,7 +781,7 @@ checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where

777781 go ((p,v):ps') [] u@(TUnknown _) = do

778782 v'@(TypedValue _ _ ty) <- infer v

779783 rest <- fresh

780− u ?= RCons p ty rest

784+ u =?= RCons p ty rest

781785 ps'' <- go ps' [] rest

782786 return $ (p, v') : ps''

783787 go ((p,v):ps') ts r =

@@ -785,7 +789,7 @@ checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where

785789 Nothing -> do

786790 v'@(TypedValue _ _ ty) <- infer v

787791 rest <- fresh

788− r ?= RCons p ty rest

792+ r =?= RCons p ty rest

789793 ps'' <- go ps' ts rest

790794 return $ (p, v') : ps''

791795 Just ty -> do

@@ -797,7 +801,7 @@ checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where

797801-- |

798802-- Check the type of a function application, rethrowing errors to provide a better error message

799803--

800−checkFunctionApplication :: Value -> Type -> Value -> Type -> UnifyT Check Value

804+checkFunctionApplication :: Value -> Type -> Value -> Type -> UnifyT Type Check Value

801805checkFunctionApplication fn fnTy arg ret = rethrow errorMessage $ checkFunctionApplication' fn fnTy arg ret

802806 where

803807 errorMessage msg = "Error applying function of type "

@@ -808,9 +812,9 @@ checkFunctionApplication fn fnTy arg ret = rethrow errorMessage $ checkFunctionA

808812-- |

809813-- Check the type of a function application

810814--

811−checkFunctionApplication' :: Value -> Type -> Value -> Type -> UnifyT Check Value

815+checkFunctionApplication' :: Value -> Type -> Value -> Type -> UnifyT Type Check Value

812816checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do

813− tyFunction' ?= tyFunction

817+ tyFunction' =?= tyFunction

814818 arg' <- check arg argTy

815819 _ <- subsumes Nothing retTy ret

816820 return $ App fn arg'

@@ -822,7 +826,7 @@ checkFunctionApplication' fn u@(TUnknown _) arg ret = do

822826 TypedValue _ v t <- infer arg

823827 TypedValue True v <$> replaceAllVarsWithUnknowns t

824828 let ty = (\(TypedValue _ _ t) -> t) arg'

825− u ?= function ty ret

829+ u =?= function ty ret

826830 return $ App fn arg'

827831checkFunctionApplication' fn (SaturatedTypeSynonym name tyArgs) arg ret = do

828832 ty <- expandTypeSynonym name tyArgs

@@ -840,7 +844,7 @@ checkFunctionApplication' _ fnTy arg ret = throwError $ "Applying a function of

840844-- |

841845-- Check whether one type subsumes another, rethrowing errors to provide a better error message

842846--

843−subsumes :: Maybe Value -> Type -> Type -> UnifyT Check (Maybe Value)

847+subsumes :: Maybe Value -> Type -> Type -> UnifyT Type Check (Maybe Value)

844848subsumes val ty1 ty2 = rethrow errorMessage $ subsumes' val ty1 ty2

845849 where

846850 errorMessage msg = "Error checking that type "

@@ -852,7 +856,7 @@ subsumes val ty1 ty2 = rethrow errorMessage $ subsumes' val ty1 ty2

852856-- |

853857-- Check whether one type subsumes another

854858--

855−subsumes' :: Maybe Value -> Type -> Type -> UnifyT Check (Maybe Value)

859+subsumes' :: Maybe Value -> Type -> Type -> UnifyT Type Check (Maybe Value)

856860subsumes' val (ForAll ident ty1) ty2 = do

857861 replaced <- replaceVarWithUnknown ident ty1

858862 subsumes val replaced ty2

@@ -873,6 +877,6 @@ subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do

873877 _ <- subsumes' Nothing ty1 ty2

874878 return . Just $ foldl App val (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))

875879subsumes' val ty1 ty2 = do

876− ty1 ?= ty2

880+ ty1 =?= ty2

877881 return val

878882

src/Language/PureScript/Types.hs+1−1

@@ -31,7 +31,7 @@ data Type

3131 -- |

3232 -- A unification variable of type Type

3333 --

34− = TUnknown (TypedUnknown Type)

34+ = TUnknown Unknown

3535 -- |

3636 -- Javascript numbers

3737 --