0b8a09f · rowtype-yoga/purescript-native

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

Fix #1315

commit0b8a09f58a16f598d90bfd2d2927421abff8b825 authorPhil Freeman <paf31@cantab.net> dateSun 25 Oct 2015, 17:34 (11 years ago) parent16c3bc6

4 files changed+19−18

compare with golang

unifiedsplit

examples/failing/MissingRecordField.purs+1−2 src/Language/PureScript/Errors.hs+6−12 src/Language/PureScript/TypeChecker/Subsumption.hs+10−2 src/Language/PureScript/TypeChecker/Types.hs+2−2

examples/failing/MissingRecordField.purs+1−2

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

1−-- @shouldFailWith TypesDoNotUnify

2−-- TODO: Update type checker to make this fail with PropertyIsMissing instead.

1+-- @shouldFailWith PropertyIsMissing

32module MissingRecordField where

54import Prelude ((>))

src/Language/PureScript/Errors.hs+6−12

@@ -126,8 +126,8 @@ data SimpleErrorMessage

126126 | ExpectedType Type Kind

127127 | IncorrectConstructorArity (Qualified ProperName)

128128 | ExprDoesNotHaveType Expr Type

129− | PropertyIsMissing String Expr

130− | AdditionalProperty String Expr

129+ | PropertyIsMissing String

130+ | AdditionalProperty String

131131 | CannotApplyFunction Type Expr

132132 | TypeSynonymInstance

133133 | OrphanInstance Ident (Qualified ProperName) [Type]

@@ -618,16 +618,10 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

618618 , line "does not have type"

619619 , indent $ typeAsBox ty

620620 ]

621− renderSimpleErrorMessage (PropertyIsMissing prop expr) =

622− paras [ line "Row type"

623− , indent $ prettyPrintValue expr

624− , line $ "lacks required label " ++ show prop

625− ]

626− renderSimpleErrorMessage (AdditionalProperty prop expr) =

627− paras [ line "Type of expression"

628− , indent $ prettyPrintValue expr

629− , line $ "contains additional label " ++ show prop

630− ]

621+ renderSimpleErrorMessage (PropertyIsMissing prop) =

622+ line $ "Type of expression lacks required label " ++ show prop ++ "."

623+ renderSimpleErrorMessage (AdditionalProperty prop) =

624+ line $ "Type of expression contains additional label " ++ show prop ++ "."

631625 renderSimpleErrorMessage (CannotApplyFunction fn arg) =

632626 paras [ line "A function of type"

633627 , indent $ typeAsBox fn

src/Language/PureScript/TypeChecker/Subsumption.hs+10−2

@@ -21,6 +21,7 @@ import Data.List (sortBy)

2121import Data.Ord (comparing)

2222

2323import Control.Monad.Unify

24+import Control.Monad.Error.Class (throwError)

2425

2526import Language.PureScript.Crash

2627import Language.PureScript.AST

@@ -77,10 +78,17 @@ subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyObject && f2 == tyObject

7778 | p1 == p2 = do _ <- subsumes Nothing ty1 ty2

7879 go ts1 ts2 r1' r2'

7980 | p1 < p2 = do rest <- fresh

80− r2' =?= RCons p1 ty1 rest

81+ -- What happens next is a bit of a hack.

82+ -- TODO: in the new type checker, object properties will probably be restricted to being monotypes

83+ -- in which case, this branch of the subsumes function should not even be necessary.

84+ case r2' of

85+ REmpty -> throwError . errorMessage $ AdditionalProperty p1

86+ _ -> r2' =?= RCons p1 ty1 rest

8187 go ts1 ((p2, ty2) : ts2) r1' rest

8288 | otherwise = do rest <- fresh

83− r1' =?= RCons p2 ty2 rest

89+ case r1' of

90+ REmpty -> throwError . errorMessage $ PropertyIsMissing p2

91+ _ -> r1' =?= RCons p2 ty2 rest

8492 go ((p1, ty1) : ts1) ts2 rest r2'

8593subsumes' val ty1 ty2@(TypeApp obj _) | obj == tyObject = subsumes val ty2 ty1

8694subsumes' val ty1 ty2 = do

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

@@ -595,8 +595,8 @@ checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' wh

595595 return []

596596 go [] [] Skolem{} | lax = return []

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

598− | otherwise = throwError . errorMessage $ PropertyIsMissing p expr

599− go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty p expr

598+ | otherwise = throwError . errorMessage $ PropertyIsMissing p

599+ go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty p

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

601601 case lookup p ts of

602602 Nothing -> do