cfac1b7 · rowtype-yoga/purescript-native

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

on golang help sign in

Better error messages

cfac1b7Phil Freeman13 years ago

examples/failing/Arrays.ps+1−1

compare with golang

unifiedsplit

@@ -1 +1 @@

1−test = \arr -> arr ! 0 ! 0

1+test = \arr -> arr !! (0 !! 0)

src/Language/PureScript/TypeChecker.hs+7−7

@@ -42,14 +42,14 @@ import Control.Monad.Error

42typeCheckAll :: [Declaration] -> Check ()

43typeCheckAll [] = return ()

44typeCheckAll (DataDeclaration name args dctors : rest) = do

45− rethrow (("Error in type constructor " ++ show name ++ ": ") ++) $ do

45+ rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do

46 env <- getEnv

47 modulePath <- checkModulePath `fmap` get

48 guardWith (show name ++ " is already defined") $ not $ M.member (modulePath, name) (types env)

49 ctorKind <- kindsOf (Just name) args (mapMaybe snd dctors)

50 putEnv $ env { types = M.insert (modulePath, name) (ctorKind, Data) (types env) }

51 forM_ dctors $ \(dctor, maybeTy) ->

52− rethrow (("Error in data constructor " ++ show name ++ ": ") ++) $ do

52+ rethrow (("Error in data constructor " ++ show name ++ ":\n") ++) $ do

53 env' <- getEnv

54 guardWith (show dctor ++ " is already defined") $ not $ M.member (modulePath, dctor) (dataConstructors env')

55 let retTy = foldl TypeApp (TypeConstructor (Qualified modulePath name)) (map TypeVar args)

@@ -58,7 +58,7 @@ typeCheckAll (DataDeclaration name args dctors : rest) = do

58 putEnv $ env' { dataConstructors = M.insert (modulePath, dctor) polyType (dataConstructors env') }

59 typeCheckAll rest

60typeCheckAll (TypeSynonymDeclaration name args ty : rest) = do

61− rethrow (("Error in type synonym " ++ show name ++ ": ") ++) $ do

61+ rethrow (("Error in type synonym " ++ show name ++ ":\n") ++) $ do

62 env <- getEnv

63 modulePath <- checkModulePath `fmap` get

64 guardWith (show name ++ " is already defined") $ not $ M.member (modulePath, name) (types env)

@@ -70,7 +70,7 @@ typeCheckAll (TypeDeclaration name ty : ValueDeclaration name' val : rest) | nam

70 typeCheckAll (ValueDeclaration name (TypedValue val ty) : rest)

71typeCheckAll (TypeDeclaration name _ : _) = throwError $ "Orphan type declaration for " ++ show name

72typeCheckAll (ValueDeclaration name val : rest) = do

73− rethrow (("Error in declaration " ++ show name ++ ": ") ++) $ do

73+ rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do

74 env <- getEnv

75 modulePath <- checkModulePath `fmap` get

76 case M.lookup (modulePath, name) (names env) of

@@ -86,7 +86,7 @@ typeCheckAll (ExternDataDeclaration name kind : rest) = do

86 putEnv $ env { types = M.insert (modulePath, name) (kind, TypeSynonym) (types env) }

87 typeCheckAll rest

88typeCheckAll (ExternMemberDeclaration member name ty : rest) = do

89− rethrow (("Error in foreign import member declaration " ++ show name ++ ": ") ++) $ do

89+ rethrow (("Error in foreign import member declaration " ++ show name ++ ":\n") ++) $ do

90 env <- getEnv

91 modulePath <- checkModulePath `fmap` get

92 kind <- kindOf ty

@@ -100,7 +100,7 @@ typeCheckAll (ExternMemberDeclaration member name ty : rest) = do

100 _ -> throwError "Foreign member declarations must have function types, with an single argument."

101 typeCheckAll rest

102typeCheckAll (ExternDeclaration name ty : rest) = do

103− rethrow (("Error in foreign import declaration " ++ show name ++ ": ") ++) $ do

103+ rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do

104 env <- getEnv

105 modulePath <- checkModulePath `fmap` get

106 kind <- kindOf ty

@@ -126,7 +126,7 @@ typeCheckAll (ImportDeclaration modulePath idents : rest) = do

126 Nothing -> bindIdents (map snd $ filterModule env) currentModule env

127 Just idents -> bindIdents idents currentModule env

128 typeCheckAll rest

129− where errorMessage = (("Error in import declaration " ++ show modulePath ++ ": ") ++)

129+ where errorMessage = (("Error in import declaration " ++ show modulePath ++ ":\n") ++)

130 filterModule = filter ((== modulePath) . fst) . M.keys . names

131 moduleExists env = not $ null $ filterModule env

132 bindIdents idents currentModule env =

src/Language/PureScript/TypeChecker/Types.hs+29−36

@@ -289,27 +289,29 @@ ensureNoDuplicateProperties :: [(String, Value)] -> Check ()

289ensureNoDuplicateProperties ps = guardWith "Duplicate property names" $ length (nub . map fst $ ps) == length ps

290

291infer :: M.Map Ident Type -> Value -> Subst Check Type

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

293+

292−infer _ (NumericLiteral _) = return Number

294+infer' _ (NumericLiteral _) = return Number

293−infer _ (StringLiteral _) = return String

295+infer' _ (StringLiteral _) = return String

294−infer _ (BooleanLiteral _) = return Boolean

296+infer' _ (BooleanLiteral _) = return Boolean

295−infer m (ArrayLiteral vals) = do

297+infer' m (ArrayLiteral vals) = do

296 ts <- mapM (infer m) vals

298 ts <- mapM (infer m) vals

297 arr <- fresh

299 arr <- fresh

298 forM_ ts $ \t -> arr ~~ Array t

300 forM_ ts $ \t -> arr ~~ Array t

299 return arr

301 return arr

300−infer m (Unary op val) = do

302+infer' m (Unary op val) = do

301 t <- infer m val

303 t <- infer m val

302 inferUnary op t

304 inferUnary op t

303−infer m (Binary op left right) = do

305+infer' m (Binary op left right) = do

304 t1 <- infer m left

306 t1 <- infer m left

305 t2 <- infer m right

307 t2 <- infer m right

306 inferBinary op t1 t2

308 inferBinary op t1 t2

307−infer m (ObjectLiteral ps) = do

309+infer' m (ObjectLiteral ps) = do

308 lift $ ensureNoDuplicateProperties ps

310 lift $ ensureNoDuplicateProperties ps

309 ts <- mapM (infer m . snd) ps

311 ts <- mapM (infer m . snd) ps

310 let fields = zipWith (\(name, _) t -> (name, t)) ps ts

312 let fields = zipWith (\(name, _) t -> (name, t)) ps ts

311 return $ Object $ typesToRow fields

313 return $ Object $ typesToRow fields

312−infer m (ObjectUpdate o ps) = do

314+infer' m (ObjectUpdate o ps) = do

313 lift $ ensureNoDuplicateProperties ps

315 lift $ ensureNoDuplicateProperties ps

314 obj <- infer m o

316 obj <- infer m o

315 row <- fresh

317 row <- fresh

@@ -317,29 +319,27 @@ infer m (ObjectUpdate o ps) = do

317 let tys = zipWith (\(name, _) t -> (name, t)) ps ts

319 let tys = zipWith (\(name, _) t -> (name, t)) ps ts

318 obj ~~ Object (rowFromList (tys, row))

320 obj ~~ Object (rowFromList (tys, row))

319 return obj

321 return obj

320−infer m (Indexer index val) = do

322+infer' m (Indexer index val) = do

321 el <- fresh

323 el <- fresh

322 check m index Number

324 check m index Number

323− t2 <- infer m val

324− t2 ~~ Array el

325+ check m val (Array el)

325 return el

326 return el

326−infer m (Accessor prop val) = do

327+infer' m (Accessor prop val) = do

327− obj <- infer m val

328 field <- fresh

329 rest <- fresh

330− obj ~~ Object (RCons prop field rest)

330+ check m val (Object (RCons prop field rest))

331 return field

332−infer m v@(Abs args ret) = do

332+infer' m v@(Abs args ret) = do

333 ts <- replicateM (length args) fresh

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

335 body <- infer m' ret

336 return $ Function ts body

337−infer m v@(App f xs) = do

337+infer' m v@(App f xs) = do

338 t1 <- infer m f

339 ret <- fresh

340 checkFunctionApplication m t1 xs ret

341 return ret

342−infer m v@(Var var@(Qualified mp name)) = do

342+infer' m v@(Var var@(Qualified mp name)) = do

343 case mp of

344 ModulePath [] ->

345 case M.lookup name m of

@@ -353,29 +353,29 @@ infer m v@(Var var@(Qualified mp name)) = do

353 case M.lookup (qualify modulePath var) (names env) of

354 Nothing -> throwError $ show var ++ " is undefined"

355 Just (ty, _) -> lift $ replaceAllTypeSynonyms ty

356−infer m (Block ss) = do

356+infer' m (Block ss) = do

357 ret <- fresh

358 (allCodePathsReturn, _) <- checkBlock m M.empty ret ss

359 guardWith "Block is missing a return statement" allCodePathsReturn

360 return ret

361−infer m v@(Constructor c) = do

361+infer' m v@(Constructor c) = do

362 env <- lift getEnv

363 modulePath <- checkModulePath `fmap` lift get

364 case M.lookup (qualify modulePath c) (dataConstructors env) of

365 Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"

366 Just ty -> lift $ replaceAllTypeSynonyms ty

367−infer m (Case val binders) = do

367+infer' m (Case val binders) = do

368 t1 <- infer m val

369 ret <- fresh

370 checkBinders m t1 ret binders

371 return ret

372−infer m v@(IfThenElse cond th el) = do

372+infer' m v@(IfThenElse cond th el) = do

373 check m cond Boolean

374 t2 <- infer m th

375 t3 <- infer m el

376 t2 ~~ t3

377 return t2

378−infer m v@(TypedValue val ty) = do

378+infer' m v@(TypedValue val ty) = do

379 kind <- lift $ kindOf ty

380 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star

381 ty' <- lift $ replaceAllTypeSynonyms ty

@@ -514,8 +514,7 @@ checkBinders :: M.Map Ident Type -> Type -> Type -> [(Binder, Value)] -> Subst C

514checkBinders _ _ _ [] = return ()

515checkBinders m nval ret ((binder, val):bs) = do

516 m1 <- inferGuardedBinder m nval binder

517− t <- infer (m `M.union` m1) val

517+ check (m `M.union` m1) val ret

518− t ~~ ret

519 checkBinders m nval ret bs

518 checkBinders m nval ret bs

520

519

521assignVariable :: Ident -> M.Map Ident Type -> Subst Check ()

520assignVariable :: Ident -> M.Map Ident Type -> Subst Check ()

@@ -536,8 +535,7 @@ checkStatement m mass ret (Assignment ident val) = do

536 Just ty -> do t ~~ ty

535 Just ty -> do t ~~ ty

537 return (False, mass)

536 return (False, mass)

538checkStatement m mass ret (While val inner) = do

537checkStatement m mass ret (While val inner) = do

539− t1 <- infer m val

540− t1 ~~ Boolean

538+ check m val Boolean

541 (allCodePathsReturn, _) <- checkBlock m mass ret inner

539 (allCodePathsReturn, _) <- checkBlock m mass ret inner

542 return (allCodePathsReturn, mass)

540 return (allCodePathsReturn, mass)

543checkStatement m mass ret (If ifst) = do

541checkStatement m mass ret (If ifst) = do

@@ -545,18 +543,15 @@ checkStatement m mass ret (If ifst) = do

545 return (allCodePathsReturn, mass)

543 return (allCodePathsReturn, mass)

546checkStatement m mass ret (For ident start end inner) = do

544checkStatement m mass ret (For ident start end inner) = do

547 assignVariable ident (m `M.union` mass)

545 assignVariable ident (m `M.union` mass)

548− t1 <- infer (m `M.union` mass) start

546+ check (m `M.union` mass) start Number

549− t1 ~~ Number

550− t2 <- infer (m `M.union` mass) end

547+ check (m `M.union` mass) end Number

551− t2 ~~ Number

552 let mass1 = M.insert ident Number mass

548 let mass1 = M.insert ident Number mass

553 (allCodePathsReturn, _) <- checkBlock (m `M.union` mass1) mass1 ret inner

549 (allCodePathsReturn, _) <- checkBlock (m `M.union` mass1) mass1 ret inner

554 return (allCodePathsReturn, mass)

550 return (allCodePathsReturn, mass)

555checkStatement m mass ret (ForEach ident vals inner) = do

551checkStatement m mass ret (ForEach ident vals inner) = do

556 assignVariable ident (m `M.union` mass)

552 assignVariable ident (m `M.union` mass)

557 val <- fresh

553 val <- fresh

558− t1 <- infer (m `M.union` mass) vals

554+ check (m `M.union` mass) vals (Array val)

559− t1 ~~ Array val

560 let mass1 = M.insert ident val mass

555 let mass1 = M.insert ident val mass

561 (allCodePathsReturn, _) <- checkBlock (m `M.union` mass1) mass1 ret inner

556 (allCodePathsReturn, _) <- checkBlock (m `M.union` mass1) mass1 ret inner

562 guardWith "Cannot return from within a foreach block" $ not allCodePathsReturn

557 guardWith "Cannot return from within a foreach block" $ not allCodePathsReturn

@@ -567,13 +562,11 @@ checkStatement m mass ret (Return val) = do

567

562

568checkIfStatement :: M.Map Ident Type -> M.Map Ident Type -> Type -> IfStatement -> Subst Check Bool

563checkIfStatement :: M.Map Ident Type -> M.Map Ident Type -> Type -> IfStatement -> Subst Check Bool

569checkIfStatement m mass ret (IfStatement val thens Nothing) = do

564checkIfStatement m mass ret (IfStatement val thens Nothing) = do

570− t1 <- infer m val

571− t1 ~~ Boolean

565+ check m val Boolean

572 _ <- checkBlock m mass ret thens

566 _ <- checkBlock m mass ret thens

573 return False

567 return False

574checkIfStatement m mass ret (IfStatement val thens (Just elses)) = do

568checkIfStatement m mass ret (IfStatement val thens (Just elses)) = do

575− t1 <- infer m val

576− t1 ~~ Boolean

569+ check m val Boolean

577 (allCodePathsReturn1, _) <- checkBlock m mass ret thens

570 (allCodePathsReturn1, _) <- checkBlock m mass ret thens

578 allCodePathsReturn2 <- checkElseStatement m mass ret elses

571 allCodePathsReturn2 <- checkElseStatement m mass ret elses

579 return $ allCodePathsReturn1 && allCodePathsReturn2

572 return $ allCodePathsReturn1 && allCodePathsReturn2