674d94d · rowtype-yoga/purescript-native

examples/passing/Monad.psnew file+15

compare with golang

unifiedsplit

@@ -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 }

3+

4+data Id a = Id a

5+

6+id :: Monad Id

7+id = { ret : Id

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

9+

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

92 return ty

93

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

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

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

96

97parseRowEnding :: P.Parsec String ParseState Row

98parseRowEnding = 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)

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

242 replace t = t

243

244+expandAllTypeSynonyms :: Type -> Subst Check Type

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

246+expandAllTypeSynonyms ty = return ty

247+

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

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

245expandTypeSynonym name args = do

249expandTypeSynonym name args = do

246 env <- lift getEnv

250 env <- lift getEnv

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

294 check m val (Array el)

298 check m val (Array el)

295 return el

299 return el

296infer' m (Accessor prop val) = do

300infer' m (Accessor prop val) = do

297− field <- fresh

301+ obj <- infer m val

298− rest <- fresh

302+ propTy <- inferProperty obj prop

303+ case propTy of

304+ Nothing -> do

305+ field <- fresh

306+ rest <- fresh

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

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

300− return field

308+ return field

309+ Just ty -> return ty

301infer' m (Abs args ret) = do

310infer' m (Abs args ret) = do

302 ts <- replicateM (length args) fresh

311 ts <- replicateM (length args) fresh

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

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

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

352 check m val ty'

361 check m val ty'

353 return ty'

362 return ty'

354

363

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+

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

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

356inferUnary op val =

377inferUnary op val =

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

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

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

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

63

64isPolyType :: Type -> Bool

65isPolyType (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)

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

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

69isPolyType (SaturatedTypeSynonym _ args) = all isMonoType args