8506ed8 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Assume arguments match the type annotations

8506ed8Evan Czaplicki10 years ago

src/Reporting/Error/Type.hs+18−5

compare with master

unifiedsplit

@@ -69,7 +69,7 @@ data Hint

69 | Function (Maybe Var.Canonical)

70 | UnexpectedArg (Maybe Var.Canonical) Int Int Region.Region

71 | FunctionArity (Maybe Var.Canonical) Int Int Region.Region

72− | BadTypeAnnotation String

72+ | ReturnType String Int

73 | Instance String

74 | Literal String

75 | Pattern Pattern

@@ -366,13 +366,26 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

366 )

367 (text "Maybe you forgot some parentheses? Or a comma?")

368

369− BadTypeAnnotation name ->

369+ ReturnType name 0 ->

370− report

370+ report

371 Nothing

372 ("The type annotation for " ++ Help.functionName name ++ " does not match its definition.")

373 ( cmpHint

374− "The type annotation is saying:"

374+ ( "The type annotation says " ++ Help.functionName name

375+ ++ " should be a:"

376+ )

377+ "But the value you defined has this type:"

378+ []

379+ )

380+

381+ ReturnType name arity ->

382+ report

383+ Nothing

384+ ("The " ++ Help.functionName name ++ " function does not match the type annotation.")

385+ ( cmpHint

375− "But I am inferring that the definition has this type:"

386+ "The definition produces values of this type:"

387+ ( "But type annotation says " ++ Help.functionName name ++ " should return:"

388+ )

376 []

389 []

377 )

390 )

378

391

src/Type/Constrain/Expression.hs+58−47

@@ -491,14 +491,12 @@ data Info = Info

491

492constrainDef :: Env.Env -> Info -> Canonical.Def -> IO Info

493constrainDef env info (Canonical.Def _ (A.A patternRegion pattern) expr maybeTipe) =

494− let qs = [] -- should come from the def, but I'm not sure what would live there...

495− in

496 case (pattern, maybeTipe) of

494 case (pattern, maybeTipe) of

497 (P.Var name, Nothing) ->

495 (P.Var name, Nothing) ->

498− constrainUnannotatedDef env info qs patternRegion name expr

496+ constrainUnannotatedDef env patternRegion name expr info

499

497

500− (P.Var name, Just (A.A typeRegion tipe)) ->

498+ (P.Var name, Just (A.A _ tipe)) ->

501− constrainAnnotatedDef env info qs patternRegion typeRegion name expr tipe

499+ constrainAnnotatedDef env patternRegion name expr tipe info

502

500

503 _ ->

501 _ ->

504 error "canonical definitions must not have complex patterns as names in the contstraint generation phase"

502 error "canonical definitions must not have complex patterns as names in the contstraint generation phase"

@@ -506,66 +504,79 @@ constrainDef env info (Canonical.Def _ (A.A patternRegion pattern) expr maybeTip

506

504

507constrainUnannotatedDef

505constrainUnannotatedDef

508 :: Env.Env

506 :: Env.Env

509− -> Info

510− -> [String]

511 -> R.Region

507 -> R.Region

512 -> String

508 -> String

513 -> Canonical.Expr

509 -> Canonical.Expr

510+ -> Info

514 -> IO Info

511 -> IO Info

515−constrainUnannotatedDef env info qs patternRegion name expr =

512+constrainUnannotatedDef env patternRegion name expr info =

516− do -- Some mistake may be happening here. Currently, qs is always [].

517− rigidVars <- mapM mkRigid qs

518−

519− v <- mkVar Nothing

513+ do v <- mkVar Nothing

520−

521 let tipe = VarN v

514 let tipe = VarN v

522−

523− let env' = Env.addValues env (zip qs rigidVars)

524−

525− con <- constrain env' expr tipe

515+ defCon <- constrain env expr tipe

526−

527 return $ info

516 return $ info

528− { iRigid = rigidVars ++ iRigid info

529− , iFlex = v : iFlex info

517+ { iFlex = v : iFlex info

530 , iHeaders = Map.insert name (A.A patternRegion tipe) (iHeaders info)

518 , iHeaders = Map.insert name (A.A patternRegion tipe) (iHeaders info)

531− , iC2 = con /\ iC2 info

519+ , iC2 = defCon /\ iC2 info

532 }

520 }

533

521

534

522

535−constrainAnnotatedDef

523+constrainAnnotatedDef :: Env.Env -> R.Region -> String -> Canonical.Expr -> ST.Canonical -> Info -> IO Info

536− :: Env.Env

537− -> Info

538− -> [String]

539− -> R.Region

540− -> R.Region

541− -> String

542− -> Canonical.Expr

543− -> ST.Canonical

544− -> IO Info

545−constrainAnnotatedDef env info qs patternRegion typeRegion name expr tipe =

524+constrainAnnotatedDef env region name expr tipe info =

546− do -- Some mistake may be happening here. Currently, qs is always [].

547− rigidVars <- mapM mkRigid qs

548−

549− flexiVars <- mapM mkNamedVar qs

550−

551− let env' = Env.addValues env (zip qs flexiVars)

552−

553− (vars, typ) <- Env.instantiateType env tipe Map.empty

525+ do (flexType, flexVars) <- Env.instantiateType Flex env tipe

554

526

555 let scheme =

527 let scheme =

556 Scheme

528 Scheme

557 { _rigidQuantifiers = []

529 { _rigidQuantifiers = []

558− , _flexibleQuantifiers = flexiVars ++ vars

530+ , _flexibleQuantifiers = Map.elems flexVars

559 , _constraint = CTrue

531 , _constraint = CTrue

560− , _header = Map.singleton name (A.A patternRegion typ)

532+ , _header = Map.singleton name (A.A region flexType)

561 }

533 }

562

534

563− var <- mkVar Nothing

535+ defCon <- constrainAnnDefHelp name expr tipe (ArgInfo env [] [])

564− defCon <- constrain env' expr (VarN var)

565− let annCon =

566− CEqual (Error.BadTypeAnnotation name) typeRegion typ (VarN var)

567

536

568 return $ info

537 return $ info

569 { iSchemes = scheme : iSchemes info

538 { iSchemes = scheme : iSchemes info

570− , iC1 = iC1 info /\ ex [var] (defCon /\ fl rigidVars annCon)

539+ , iC1 = iC1 info /\ defCon

571 }

540 }

541+

542+

543+

544+data ArgInfo =

545+ ArgInfo

546+ { _env :: Env.Env

547+ , _args :: [(P.Canonical, Type)]

548+ , _vars :: [Variable]

549+ }

550+

551+

552+constrainAnnDefHelp :: String -> Canonical.Expr -> ST.Canonical -> ArgInfo -> IO TypeConstraint

553+constrainAnnDefHelp name expr tipe (ArgInfo env args vars) =

554+ case (expr, tipe) of

555+ (A.A _ (E.Lambda arg result), ST.Lambda argType resultType) ->

556+ do (rigidArgType, newVars) <- Env.instantiateType Rigid env argType

557+

558+ constrainAnnDefHelp name result resultType $

559+ ArgInfo

560+ { _env = Env.addValues newVars env

561+ , _args = (arg, rigidArgType) : args

562+ , _vars = Map.elems newVars ++ vars

563+ }

564+

565+ (A.A region _, _) ->

566+ do (rigidType, newVars) <- Env.instantiateType Rigid env tipe

567+

568+ let finalEnv = Env.addValues newVars env

569+ let finalArgs = reverse args

570+ let rigidVars = Map.elems newVars ++ vars

571+

572+ (Pattern.Info headers argVars argCons) <-

573+ Pattern.joinInfos <$> mapM (uncurry (Pattern.constrain finalEnv)) finalArgs

574+

575+ resultVar <- mkVar Nothing

576+ let resultType = VarN resultVar

577+ defCon <- constrain finalEnv expr resultType

578+ let resultCon =

579+ CEqual (Error.ReturnType name (length args)) region resultType rigidType

580+

581+ return $ forall rigidVars $ ex (resultVar : argVars) $ CLet [monoscheme headers] $

582+ CAnd [ argCons, defCon, resultCon ]

src/Type/Constrain/Pattern.hs+1−1

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

1{-# OPTIONS_GHC -Wall #-}

2−module Type.Constrain.Pattern (Info(..), infoToScheme, constrain) where

2+module Type.Constrain.Pattern (Info(..), joinInfos, infoToScheme, constrain) where

4import Control.Arrow (second)

5import qualified Control.Monad as Monad

src/Type/Environment.hs+28−30

@@ -9,7 +9,6 @@ module Type.Environment

9 where

11import qualified Control.Monad.State as State

12−import qualified Data.List as List

13import Data.Map ((!))

12import Data.Map ((!))

14import qualified Data.Map as Map

13import qualified Data.Map as Map

15import qualified Data.Set as Set

14import qualified Data.Set as Set

@@ -114,8 +113,8 @@ ctorToType env (name, (tvars, ctors)) =

114

113

115 go :: (V.Canonical, [T.Canonical]) -> State.StateT VarDict IO ([Type], Type)

114 go :: (V.Canonical, [T.Canonical]) -> State.StateT VarDict IO ([Type], Type)

116 go (_, args) =

115 go (_, args) =

117− do types <- mapM (instantiator env) args

116+ do types <- mapM (instantiator Flex env) args

118− returnType <- instantiator env (T.App (T.Type name) (map T.Var tvars))

117+ returnType <- instantiator Flex env (T.App (T.Type name) (map T.Var tvars))

119 return (types, returnType)

118 return (types, returnType)

120

119

121

120

@@ -145,40 +144,34 @@ ctorNames env =

145 Map.keys (_constructor env)

144 Map.keys (_constructor env)

146

145

147

146

147+

148-- UPDATE ENVIRONMENT

149

150

151−addValues :: Env -> [(String, Variable)] -> Env

151+addValues :: VarDict -> Env -> Env

152−addValues env newValues =

152+addValues newValues env =

153− env

153+ env { _value = Map.union (_value env) (Map.map VarN newValues) }

154− { _value =

155− List.foldl'

156− (\dict (name, var) -> Map.insert name (VarN var) dict)

157− (_value env)

158− newValues

159− }

160

154

161

155

162

156

163-- INSTANTIATE TYPES

157-- INSTANTIATE TYPES

164

158

165

159

166−instantiateType :: Env -> T.Canonical -> VarDict -> IO ([Variable], Type)

160+instantiateType :: Flex -> Env -> T.Canonical -> IO (Type, VarDict)

167−instantiateType env sourceType dict =

161+instantiateType flex env sourceType =

168− do (tipe, dict') <- State.runStateT (instantiator env sourceType) dict

162+ State.runStateT (instantiator flex env sourceType) Map.empty

169− return (Map.elems dict', tipe)

170

163

171

164

172−instantiator :: Env -> T.Canonical -> State.StateT VarDict IO Type

165+instantiator :: Flex -> Env -> T.Canonical -> State.StateT VarDict IO Type

173−instantiator env sourceType =

166+instantiator flex env sourceType =

174− instantiatorHelp env Set.empty sourceType

167+ instantiatorHelp flex env Set.empty sourceType

175

168

176

169

177−instantiatorHelp :: Env -> Set.Set String -> T.Canonical -> State.StateT VarDict IO Type

170+instantiatorHelp :: Flex -> Env -> Set.Set String -> T.Canonical -> State.StateT VarDict IO Type

178−instantiatorHelp env aliasVars sourceType =

171+instantiatorHelp flex env aliasVars sourceType =

179 let

172 let

180 go =

173 go =

181− instantiatorHelp env aliasVars

174+ instantiatorHelp flex env aliasVars

182 in

175 in

183 case sourceType of

176 case sourceType of

184 T.Lambda t1 t2 ->

177 T.Lambda t1 t2 ->

@@ -190,24 +183,29 @@ instantiatorHelp env aliasVars sourceType =

190

183

191 else

184 else

192 do dict <- State.get

185 do dict <- State.get

193− case Map.lookup name dict of

186+ case Map.lookup name (_value env) of

194− Just variable ->

187+ Just tipe ->

195− return (VarN variable)

188+ return tipe

196

189

197 Nothing ->

190 Nothing ->

191+ case Map.lookup name dict of

192+ Just variable ->

193+ return (VarN variable)

194+

195+ Nothing ->

198− do variable <- State.liftIO (mkNamedVar name)

196+ do variable <- State.liftIO (mkNamedVar flex name)

199− State.put (Map.insert name variable dict)

197+ State.put (Map.insert name variable dict)

200− return (VarN variable)

198+ return (VarN variable)

201

199

202 T.Aliased name args aliasType ->

200 T.Aliased name args aliasType ->

203 do targs <- mapM (\(arg,tipe) -> (,) arg <$> go tipe) args

201 do targs <- mapM (\(arg,tipe) -> (,) arg <$> go tipe) args

204 realType <-

202 realType <-

205 case aliasType of

203 case aliasType of

206 T.Filled tipe ->

204 T.Filled tipe ->

207− instantiatorHelp env Set.empty tipe

205+ instantiatorHelp flex env Set.empty tipe

208

206

209 T.Holey tipe ->

207 T.Holey tipe ->

210− instantiatorHelp env (Set.fromList (map fst args)) tipe

208+ instantiatorHelp flex env (Set.fromList (map fst args)) tipe

211

209

212 return (AliasN name targs realType)

210 return (AliasN name targs realType)

213

211

src/Type/Inference.hs+5−3

@@ -72,11 +72,13 @@ canonicalizeValues

72 -> (ModuleName.Canonical, Module.Interface)

73 -> IO [(String, ([T.Variable], T.Type))]

74canonicalizeValues env (moduleName, iface) =

75− forM (Map.toList (Module.iTypes iface)) $ \(name,tipe) ->

75+ forM (Map.toList (Module.iTypes iface)) $ \(name, tipe) ->

76− do tipe' <- Env.instantiateType env tipe Map.empty

76+ do (flexType, flexVars) <- Env.instantiateType T.Flex env tipe

77 return

78 ( ModuleName.canonicalToString moduleName ++ "." ++ name

79− , tipe'

79+ , ( Map.elems flexVars

80+ , flexType

81+ )

80 )

82 )

src/Type/Type.hs+10−10

@@ -183,14 +183,15 @@ mkVar maybeSuper =

183 UF.fresh $ mkDescriptor (Var Flex maybeSuper Nothing)

184

185

186−mkNamedVar :: String -> IO Variable

186+mkNamedVar :: Flex -> String -> IO Variable

187−mkNamedVar name =

187+mkNamedVar flex name =

188− UF.fresh $ mkDescriptor (Var Flex (toSuper name) Nothing)

188+ UF.fresh $ mkDescriptor $ Var flex (toSuper name) $

189+ case flex of

190+ Flex ->

191+ Nothing

189

192

190−

193+ Rigid ->

191−mkRigid :: String -> IO Variable

194+ Just name

192−mkRigid name =

193− UF.fresh $ mkDescriptor (Var Rigid (toSuper name) (Just name))

194

195

196

196toSuper :: String -> Maybe Super

197toSuper :: String -> Maybe Super

@@ -233,9 +234,8 @@ ex fqs constraint =

233 CLet [Scheme [] fqs constraint Map.empty] CTrue

234 CLet [Scheme [] fqs constraint Map.empty] CTrue

234

235

236

236−-- fl qs constraint == forall qs. constraint

237−fl :: [Variable] -> TypeConstraint -> TypeConstraint

237+forall :: [Variable] -> TypeConstraint -> TypeConstraint

238−fl rqs constraint =

238+forall rqs constraint =

239 CLet [Scheme rqs [] constraint Map.empty] CTrue

240

241