674d94d · rowtype-yoga/purescript-native

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

Polytypes in record fields, another example

commit674d94d6cf01a5918d58ffba84f397daefd5d2d6 authorPhil Freeman <paf31@cantab.net> dateTue 26 Nov 2013, 14:43 (13 years ago) parentd9e64f0

4 files changed+42−6

compare with golang

unifiedsplit

examples/passing/Monad.ps+15 src/Language/PureScript/Parser/Types.hs+1−1 src/Language/PureScript/TypeChecker/Types.hs+25−4 src/Language/PureScript/Types.hs+1−1

examples/passing/Monad.psnew file+15

@@ -0,0 +1,15 @@

1+type Monad m = { ret :: forall a. a -> m a

2+ , bind :: forall a b. m a -> (a -> m b) -> m b }

4+data Id a = Id a

6+id :: Monad Id

7+id = { ret : Id

8+ , bind : \ma f -> case ma of Id a -> f a }

10+test :: forall m. Monad m -> m Number

11+test = \m -> m.bind (m.ret 1) (\n1 ->

12+ m.bind (m.ret "Test") (\n2 ->

13+ m.ret n1))

14+

15+test1 = test id

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

@@ -92,7 +92,7 @@ parsePolyType = do

9292 return ty

9393

9494parseNameAndType :: P.Parsec String ParseState (String, Type)

95−parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType

95+parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parsePolyType

9696

9797parseRowEnding :: P.Parsec String ParseState Row

9898parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))

src/Language/PureScript/TypeChecker/Types.hs+25−4

@@ -241,6 +241,10 @@ desaturateAllTypeSynonyms = everywhere (mkT replace)

241241 replace (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args

242242 replace t = t

243243

244+expandAllTypeSynonyms :: Type -> Subst Check Type

245+expandAllTypeSynonyms (SaturatedTypeSynonym name args) = expandTypeSynonym name args >>= expandAllTypeSynonyms

246+expandAllTypeSynonyms ty = return ty

247+

244248expandTypeSynonym :: Qualified ProperName -> [Type] -> Subst Check Type

245249expandTypeSynonym name args = do

246250 env <- lift getEnv

@@ -294,10 +298,15 @@ infer' m (Indexer index val) = do

294298 check m val (Array el)

295299 return el

296300infer' m (Accessor prop val) = do

297− field <- fresh

298− rest <- fresh

299− check m val (Object (RCons prop field rest))

300− return field

301+ obj <- infer m val

302+ propTy <- inferProperty obj prop

303+ case propTy of

304+ Nothing -> do

305+ field <- fresh

306+ rest <- fresh

307+ obj `subsumes` Object (RCons prop field rest)

308+ return field

309+ Just ty -> return ty

301310infer' m (Abs args ret) = do

302311 ts <- replicateM (length args) fresh

303312 let m' = m `M.union` M.fromList (zip args ts)

@@ -352,6 +361,18 @@ infer' m (TypedValue val ty) = do

352361 check m val ty'

353362 return ty'

354363

364+inferProperty :: Type -> String -> Subst Check (Maybe Type)

365+inferProperty (Object row) prop = do

366+ let (props, _) = rowToList row

367+ return $ lookup prop props

368+inferProperty (SaturatedTypeSynonym name args) prop = do

369+ replaced <- expandTypeSynonym name args

370+ inferProperty replaced prop

371+inferProperty (ForAll ident ty) prop = do

372+ replaced <- replaceVarsWithUnknowns [ident] ty

373+ inferProperty replaced prop

374+inferProperty _ prop = return Nothing

375+

355376inferUnary :: UnaryOperator -> Type -> Subst Check Type

356377inferUnary op val =

357378 case fromMaybe (error "Invalid operator") $ lookup op unaryOps of

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

@@ -63,7 +63,7 @@ isMonoType ty = isPolyType ty

6363

6464isPolyType :: Type -> Bool

6565isPolyType (Array ty) = isMonoType ty

66−isPolyType (Object ps) = all isMonoType (map snd . fst $ rowToList ps)

66+isPolyType (Object ps) = all isPolyType (map snd . fst $ rowToList ps)

6767isPolyType (Function args ret) = all isPolyType args && isMonoType ret

6868isPolyType (TypeApp t1 t2) = isMonoType t1 && isMonoType t2

6969isPolyType (SaturatedTypeSynonym _ args) = all isMonoType args