packages feed

purescript 0.2.3 → 0.2.4

raw patch · 16 files changed

+119/−132 lines, 16 files

Files

purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.2.3+version: 0.2.4 cabal-version: >=1.8 build-type: Simple license: MIT
src/Language/PureScript/BindingGroups.hs view
@@ -93,6 +93,6 @@ fromValueDecl (ValueDeclaration _ _ _ _) = error "Binders should have been desugared" fromValueDecl _ = error "Expected ValueDeclaration" -fromDataDecl :: Declaration -> (ProperName, [String], [(ProperName, Maybe PolyType)])+fromDataDecl :: Declaration -> (ProperName, [String], [(ProperName, Maybe Type)]) fromDataDecl (DataDeclaration pn args ctors) = (pn, args, ctors) fromDataDecl _ = error "Expected DataDeclaration"
src/Language/PureScript/CodeGen/JS.hs view
@@ -43,9 +43,6 @@   ]  declToJs :: ModuleName -> Declaration -> Environment -> Maybe [JS]-declToJs mp (ValueDeclaration ident _ _ (Abs args ret)) e =-  Just [ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp e ret)]),-         setProperty (identToJs ident) (JSVar ident) mp ] declToJs mp (ValueDeclaration ident _ _ val) e =   Just [ JSVariableIntroduction ident (Just (valueToJs mp e val)),          setProperty (identToJs ident) (JSVar ident) mp ]
src/Language/PureScript/Declarations.hs view
@@ -32,14 +32,14 @@ data Module = Module ProperName [Declaration] deriving (Show, D.Data, D.Typeable)  data Declaration-  = DataDeclaration ProperName [String] [(ProperName, Maybe PolyType)]-  | DataBindingGroupDeclaration [(ProperName, [String], [(ProperName, Maybe PolyType)])]-  | TypeSynonymDeclaration ProperName [String] PolyType-  | TypeDeclaration Ident PolyType+  = DataDeclaration ProperName [String] [(ProperName, Maybe Type)]+  | DataBindingGroupDeclaration [(ProperName, [String], [(ProperName, Maybe Type)])]+  | TypeSynonymDeclaration ProperName [String] Type+  | TypeDeclaration Ident Type   | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value   | BindingGroupDeclaration [(Ident, Value)]-  | ExternDeclaration Ident PolyType-  | ExternMemberDeclaration String Ident PolyType+  | ExternDeclaration Ident Type+  | ExternMemberDeclaration String Ident Type   | ExternDataDeclaration ProperName Kind   | FixityDeclaration Fixity String   | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])
src/Language/PureScript/Kinds.hs view
@@ -22,5 +22,6 @@ data Kind   = KUnknown (Unknown Kind)   | Star-  | Row+  | Bang+  | Row Kind   | FunKind Kind Kind deriving (Show, Eq, Data, Typeable)
src/Language/PureScript/Parser/Common.hs view
@@ -77,10 +77,10 @@                   , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!" ]  reservedOpNames :: [String]-reservedOpNames = builtInOperators ++ [ "->", "=", "." ]+reservedOpNames = builtInOperators ++ [ "->", "=", ".", "\\" ]  identStart :: P.Parsec String u Char-identStart = P.lower <|> P.oneOf "_$"+identStart = P.lower <|> P.oneOf "_"  properNameStart :: P.Parsec String u Char properNameStart = P.upper@@ -89,10 +89,10 @@ identLetter = P.alphaNum <|> P.oneOf "_'"  opStart :: P.Parsec String u Char-opStart = P.oneOf ":.!#%&*+/<=>?@^|~"+opStart = P.oneOf ":!#$%&*+./<=>?@\\^|-~"  opLetter :: P.Parsec String u Char-opLetter = P.oneOf ":.#$%&*+./<=>?@^|"+opLetter = P.oneOf ":!#$%&*+./<=>?@\\^|-~"  langDef :: PT.GenLanguageDef String u Identity langDef = PT.LanguageDef
src/Language/PureScript/Parser/Kinds.hs view
@@ -26,16 +26,17 @@ parseStar :: P.Parsec String ParseState Kind parseStar = const Star <$> lexeme (P.char '*') -parseRow :: P.Parsec String ParseState Kind-parseRow = const Row <$> lexeme (P.char '#')+parseBang :: P.Parsec String ParseState Kind+parseBang = const Bang <$> lexeme (P.char '!')  parseTypeAtom :: P.Parsec String ParseState Kind parseTypeAtom = indented *> P.choice (map P.try             [ parseStar-            , parseRow+            , parseBang             , parens parseKind ])  parseKind :: P.Parsec String ParseState Kind parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"   where-  operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return FunKind) P.AssocRight ] ]+  operators = [ [ P.Prefix (lexeme (P.char '#') >> return Row) ]+              , [ P.Infix (lexeme (P.try (P.string "->")) >> return FunKind) P.AssocRight ] ]
src/Language/PureScript/Parser/Types.hs view
@@ -69,6 +69,7 @@             , parseTypeVariable             , parseTypeConstructor             , parseForAll+            , parens parseRow             , parens parseType ])  parseAnyType :: P.Parsec String ParseState Type@@ -84,21 +85,21 @@   unless (isMonoType ty) $ P.unexpected "polymorphic type"   return ty -parsePolyType :: P.Parsec String ParseState PolyType+parsePolyType :: P.Parsec String ParseState Type parsePolyType = do   ty <- parseAnyType   unless (isPolyType ty) $ P.unexpected "polymorphic type"   return ty -parseNameAndType :: P.Parsec String ParseState (String, Type)-parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parsePolyType+parseNameAndType :: P.Parsec String ParseState t -> P.Parsec String ParseState (String, t)+parseNameAndType p = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> p -parseRowEnding :: P.Parsec String ParseState Row-parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))+parseRowEnding :: P.Parsec String ParseState Type+parseRowEnding = P.option REmpty (TypeVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier)) -parseRow :: P.Parsec String ParseState Row-parseRow = (fromList <$> (commaSep parseNameAndType) <*> parseRowEnding) P.<?> "row"+parseRow :: P.Parsec String ParseState Type+parseRow = (fromList <$> (commaSep $ parseNameAndType parsePolyType) <*> parseRowEnding) P.<?> "row"   where-  fromList :: [(String, Type)] -> Row -> Row+  fromList :: [(String, Type)] -> Type -> Type   fromList [] r = r   fromList ((name, t):ts) r = RCons name t (fromList ts r)
src/Language/PureScript/Parser/Values.hs view
@@ -51,9 +51,9 @@  parseAbs :: P.Parsec String ParseState Value parseAbs = do-  C.lexeme $ P.char '\\'+  C.reservedOp "\\"   args <- P.many (C.indented *> (P.try singleArg <|> manyArgs))-  C.lexeme $ C.indented *> P.string "->"+  C.indented *> C.reservedOp "->"   value <- parseValue   return $ toFunction args value   where@@ -80,7 +80,7 @@ parseCaseAlternative :: P.Parsec String ParseState ([Binder], Maybe Guard, Value) parseCaseAlternative = (,,) <$> (return <$> parseBinder)                             <*> P.optionMaybe parseGuard-                            <*> (C.lexeme (P.string "->") *> parseValue)+                            <*> (C.indented *> C.reservedOp "->" *> parseValue)                             P.<?> "case alternative"  parseIfThenElse :: P.Parsec String ParseState Value
src/Language/PureScript/Pretty/Kinds.hs view
@@ -27,10 +27,16 @@ typeLiterals = mkPattern match   where   match Star = Just "*"-  match Row = Just "#"+  match Bang = Just "!"   match (KUnknown (Unknown u)) = Just $ 'u' : show u   match _ = Nothing +matchRow :: Pattern () Kind ((), Kind)+matchRow = mkPattern match+  where+  match (Row k) = Just ((), k)+  match _ = Nothing+ funKind :: Pattern () Kind (Kind, Kind) funKind = mkPattern match   where@@ -44,4 +50,5 @@   matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchKind)   operators :: OperatorTable () Kind String   operators =-    OperatorTable [ [ AssocR funKind $ \arg ret -> arg ++ " -> " ++ ret ] ]+    OperatorTable [ [ Wrap matchRow $ \_ k -> "# " ++ k]+                  , [ AssocR funKind $ \arg ret -> arg ++ " -> " ++ ret ] ]
src/Language/PureScript/Pretty/Types.hs view
@@ -32,27 +32,29 @@   match String = Just "String"   match Boolean = Just "Boolean"   match (Array ty) = Just $ "[" ++ prettyPrintType ty ++ "]"-  match (Object row) = Just $ "{ " ++ prettyPrintRow row ++ " }"+  match (Object row) = Just $ "{ " ++ prettyPrintType row ++ " }"   match (TypeVar var) = Just var   match (TypeConstructor ctor) = Just $ show ctor   match (TUnknown (Unknown u)) = Just $ 'u' : show u   match (Skolem s) = Just $ 's' : show s   match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintType args) ++ ">"   match (ForAll ident ty) = Just $ "forall " ++ ident ++ ". " ++ prettyPrintType ty+  match REmpty = Just $ prettyPrintRow REmpty+  match row@(RCons _ _ _) = Just $ prettyPrintRow row   match _ = Nothing -prettyPrintRow :: Row -> String+prettyPrintRow :: Type -> String prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs rest) . toList []   where   nameAndTypeToPs :: String -> Type -> String   nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty-  tailToPs :: Row -> String+  tailToPs :: Type -> String   tailToPs REmpty = ""-  tailToPs (RUnknown (Unknown u)) = " | u" ++ show u-  tailToPs (RowVar var) = " | " ++ var-  tailToPs (RSkolem s) = " | s" ++ show s+  tailToPs (TUnknown (Unknown u)) = " | u" ++ show u+  tailToPs (TypeVar var) = " | " ++ var+  tailToPs (Skolem s) = " | s" ++ show s   tailToPs _ = error "Invalid row tail"-  toList :: [(String, Type)] -> Row -> ([(String, Type)], Row)+  toList :: [(String, Type)] -> Type -> ([(String, Type)], Type)   toList tys (RCons name ty row) = toList ((name, ty):tys) row   toList tys r = (tys, r)
src/Language/PureScript/Pretty/Values.hs view
@@ -82,7 +82,7 @@   match (Abs args val) = Just (map show args, val)   match _ = Nothing -typed :: Pattern () Value (PolyType, Value)+typed :: Pattern () Value (Type, Value) typed = mkPattern match   where   match (TypedValue val ty) = Just (ty, val)
src/Language/PureScript/TypeChecker/Kinds.hs view
@@ -12,6 +12,7 @@ -- ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE DeriveDataTypeable #-}  module Language.PureScript.TypeChecker.Kinds (@@ -43,7 +44,8 @@   KUnknown u ~~ k = replace u k   k ~~ KUnknown u = replace u k   Star ~~ Star = return ()-  Row ~~ Row = return ()+  Bang ~~ Bang = return ()+  Row k1 ~~ Row k2 = k1 ~~ k2   FunKind k1 k2 ~~ FunKind k3 k4 = do     k1 ~~ k3     k2 ~~ k4@@ -58,7 +60,7 @@ kindOf :: ModuleName -> Type -> Check Kind kindOf moduleName ty = fmap (\(k, _, _) -> k) . runSubst (SubstContext moduleName) $ starIfUnknown <$> infer ty -kindsOf :: ModuleName -> ProperName -> [String] -> [PolyType] -> Check Kind+kindsOf :: ModuleName -> ProperName -> [String] -> [Type] -> Check Kind kindsOf moduleName name args ts = fmap (starIfUnknown . (\(k, _, _) -> k)) . runSubst (SubstContext moduleName) $ do   tyCon <- fresh   kargs <- replicateM (length args) fresh@@ -66,7 +68,7 @@   bindLocalTypeVariables moduleName dict $     solveTypes ts kargs tyCon -kindsOfAll :: ModuleName -> [(ProperName, [String], [PolyType])] -> Check [Kind]+kindsOfAll :: ModuleName -> [(ProperName, [String], [Type])] -> Check [Kind] kindsOfAll moduleName tys = fmap (map starIfUnknown . (\(ks, _, _) -> ks)) . runSubst (SubstContext moduleName) $ do   tyCons <- replicateM (length tys) fresh   let dict = zipWith (\(name, _, _) tyCon -> (name, tyCon)) tys tyCons@@ -90,13 +92,16 @@ starIfUnknown k = k  infer :: Type -> Subst Kind+infer Number = return Star+infer String = return Star+infer Boolean = return Star infer (Array t) = do   k <- infer t   k ~~ Star   return Star infer (Object row) = do-  k <- inferRow row-  k ~~ Row+  k <- infer row+  k ~~ Row Star   return Star infer (Function args ret) = do   ks <- mapM infer args@@ -123,17 +128,12 @@   k <- fresh   moduleName <- substCurrentModule <$> ask   bindLocalTypeVariables moduleName [(ProperName ident, k)] $ infer ty-infer _ = return Star--inferRow :: Row -> Subst Kind-inferRow (RowVar v) = do-  moduleName <- substCurrentModule <$> ask-  lookupTypeVariable moduleName (Qualified Nothing (ProperName v))-inferRow REmpty = return Row-inferRow (RCons _ ty row) = do+infer REmpty = do+  k <- fresh+  return $ Row k+infer (RCons _ ty row) = do   k1 <- infer ty-  k2 <- inferRow row-  k1 ~~ Star-  k2 ~~ Row-  return Row-inferRow _ = error "Invalid row in inferRow"+  k2 <- infer row+  k2 ~~ Row k1+  return $ Row k1+infer _ = error "Invalid argument to infer"
src/Language/PureScript/TypeChecker/Types.hs view
@@ -12,6 +12,7 @@ -- ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}  module Language.PureScript.TypeChecker.Types (@@ -23,7 +24,7 @@ import Data.Either (lefts, rights) import qualified Data.Data as D import Data.Generics-       (mkT, something, everywhere, everywhereBut, mkQ, extQ)+       (mkT, something, everywhere, everywhereBut, mkQ)  import Language.PureScript.Values import Language.PureScript.Types@@ -56,6 +57,7 @@   apply s (Object r) = Object (apply s r)   apply s (Function args ret) = Function (map (apply s) args) (apply s ret)   apply s (TypeApp t1 t2) = TypeApp (apply s t1) (apply s t2)+  apply s (RCons name ty r) = RCons name (apply s ty) (apply s r)   apply _ t = t   unknowns (TUnknown (Unknown u)) = [u]   unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys@@ -64,40 +66,6 @@   unknowns (Object r) = unknowns r   unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret   unknowns (TypeApp t1 t2) = unknowns t1 ++ unknowns t2-  unknowns _ = []--instance Unifiable Row where-  unknown = RUnknown-  isUnknown (RUnknown u) = Just u-  isUnknown _ = Nothing-  r1 ~~ r2 =-      let-        (s1, r1') = rowToList r1-        (s2, r2') = rowToList r2-        int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]-        sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]-        sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]-      in do-        forM_ int (uncurry (~~))-        unifyRows sd1 r1' sd2 r2'-      where-      unifyRows :: [(String, Type)] -> Row -> [(String, Type)] -> Row -> Subst ()-      unifyRows [] (RUnknown u) sd r = replace u (rowFromList (sd, r))-      unifyRows sd r [] (RUnknown u) = replace u (rowFromList (sd, r))-      unifyRows ((name, ty):row) r others u@(RUnknown un) = do-        occursCheck un ty-        forM row $ \(_, t) -> occursCheck un t-        u' <- fresh-        u ~~ RCons name ty u'-        unifyRows row r others u'-      unifyRows [] REmpty [] REmpty = return ()-      unifyRows [] (RowVar v1) [] (RowVar v2) | v1 == v2 = return ()-      unifyRows [] (RSkolem s1) [] (RSkolem s2) | s1 == s2 = return ()-      unifyRows sd3 r3 sd4 r4 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd3, r3)) ++ " with " ++ prettyPrintRow (rowFromList (sd4, r4)) ++ "."-  apply s (RUnknown u) = runSubstitution s u-  apply s (RCons name ty r) = RCons name (apply s ty) (apply s r)-  apply _ r = r-  unknowns (RUnknown (Unknown u)) = [u]   unknowns (RCons _ ty r) = unknowns ty ++ unknowns r   unknowns _ = [] @@ -140,8 +108,38 @@     t3 `unifyTypes` t5     t4 `unifyTypes` t6   unifyTypes' (Skolem s1) (Skolem s2) | s1 == s2 = return ()+  unifyTypes' r1@(RCons _ _ _) r2 = unifyRows r1 r2+  unifyTypes' r1 r2@(RCons _ _ _) = unifyRows r1 r2+  unifyTypes' r1@REmpty r2 = unifyRows r1 r2+  unifyTypes' r1 r2@REmpty = unifyRows r1 r2   unifyTypes' t3 t4 = throwError $ "Cannot unify " ++ prettyPrintType t3 ++ " with " ++ prettyPrintType t4 ++ "." +unifyRows :: Type -> Type -> Subst ()+unifyRows r1 r2 =+  let+    (s1, r1') = rowToList r1+    (s2, r2') = rowToList r2+    int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]+    sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]+    sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]+  in do+    forM_ int (uncurry (~~))+    unifyRows' sd1 r1' sd2 r2'+  where+  unifyRows' :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Subst ()+  unifyRows' [] (TUnknown u) sd r = replace u (rowFromList (sd, r))+  unifyRows' sd r [] (TUnknown u) = replace u (rowFromList (sd, r))+  unifyRows' ((name, ty):row) r others u@(TUnknown un) = do+    occursCheck un ty+    forM row $ \(_, t) -> occursCheck un t+    u' <- fresh+    u ~~ RCons name ty u'+    unifyRows' row r others u'+  unifyRows' [] REmpty [] REmpty = return ()+  unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()+  unifyRows' [] (Skolem s1) [] (Skolem s2) | s1 == s2 = return ()+  unifyRows' sd3 r3 sd4 r4 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd3, r3)) ++ " with " ++ prettyPrintRow (rowFromList (sd4, r4)) ++ "."+ typeConstructorsAreEqual :: Environment -> ModuleName -> Qualified ProperName -> Qualified ProperName -> Bool typeConstructorsAreEqual env moduleName c1 c2 =   let@@ -197,16 +195,14 @@  skolemEscapeCheck :: Type -> Check () skolemEscapeCheck ty =-  case something (extQ (mkQ Nothing findSkolems) findRSkolems) ty of+  case something (mkQ Nothing findSkolems) ty of     Nothing -> return ()     Just _ -> throwError "Skolem variables cannot escape. Consider adding a type signature."   where     findSkolems (Skolem _) = return ()     findSkolems _ = mzero-    findRSkolems (RSkolem _) = return ()-    findRSkolems _ = mzero -setify :: Row -> Row+setify :: Type -> Type setify = rowFromList . first (M.toList . M.fromList) . rowToList  setifyAll :: (D.Data d) => d -> d@@ -216,13 +212,10 @@ varIfUnknown ty =   let unks = nub $ unknowns ty       toName = (:) 't' . show-      ty' = everywhere (mkT rowToVar) . everywhere (mkT typeToVar) $ ty+      ty' = everywhere (mkT typeToVar) $ ty       typeToVar :: Type -> Type       typeToVar (TUnknown (Unknown u)) = TypeVar (toName u)       typeToVar t = t-      rowToVar :: Row -> Row-      rowToVar (RUnknown (Unknown u)) = RowVar (toName u)-      rowToVar t = t   in mkForAll (sort . map toName $ unks) ty'  replaceAllTypeVars :: (D.Data d) => [(String, Type)] -> d -> d@@ -236,12 +229,6 @@   isShadowed (ForAll v _) | v == name = True   isShadowed _ = False -replaceRowVars :: (D.Data d) => String -> Row -> d -> d-replaceRowVars name r = everywhere (mkT replaceRowVar)-  where-  replaceRowVar (RowVar v) | v == name = r-  replaceRowVar other = other- replaceAllVarsWithUnknowns :: Type -> Subst Type replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarWithUnknown ident ty >>= replaceAllVarsWithUnknowns replaceAllVarsWithUnknowns ty = return ty@@ -249,8 +236,7 @@ replaceVarWithUnknown :: String -> Type -> Subst Type replaceVarWithUnknown ident ty = do   tu <- fresh-  ru <- fresh-  return $ replaceRowVars ident ru . replaceTypeVars ident tu $ ty+  return $ replaceTypeVars ident tu $ ty  replaceAllTypeSynonyms :: (Functor m, MonadState CheckState m, MonadReader SubstContext m, MonadError String m) => (D.Data d) => d -> m d replaceAllTypeSynonyms d = do@@ -487,7 +473,7 @@   val ~~ Object row   return m1   where-  inferRowProperties :: Row -> Row -> [(String, Binder)] -> Subst (M.Map Ident Type)+  inferRowProperties :: Type -> Type -> [(String, Binder)] -> Subst (M.Map Ident Type)   inferRowProperties nrow row [] = nrow ~~ row >> return M.empty   inferRowProperties nrow row ((name, binder):binders) = do     propTy <- fresh@@ -597,8 +583,7 @@ skolemize :: String -> Type -> Subst Type skolemize ident ty = do   tsk <- Skolem <$> fresh'-  rsk <- RSkolem <$> fresh'-  return $ replaceRowVars ident rsk $ replaceTypeVars ident tsk ty+  return $ replaceTypeVars ident tsk ty  check :: Value -> Type -> Subst () check val ty = rethrow errorMessage $ check' val ty@@ -683,15 +668,15 @@   check val ty check' val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ prettyPrintType ty -checkProperties :: [(String, Value)] -> Row -> Bool -> Subst ()+checkProperties :: [(String, Value)] -> Type -> Bool -> Subst () checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where   go [] [] REmpty = return ()-  go [] [] u@(RUnknown _) = u ~~ REmpty-  go [] [] (RSkolem _) | lax = return ()+  go [] [] u@(TUnknown _) = u ~~ REmpty+  go [] [] (Skolem _) | lax = return ()   go [] ((p, _): _) _ | lax = return ()                       | otherwise = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have property " ++ p   go ((p,_):_) [] REmpty = throwError $ "Property " ++ p ++ " is not present in closed object type " ++ prettyPrintRow row-  go ((p,v):ps') [] u@(RUnknown _) = do+  go ((p,v):ps') [] u@(TUnknown _) = do     ty <- infer v     rest <- fresh     u ~~ RCons p ty rest
src/Language/PureScript/Types.hs view
@@ -26,30 +26,23 @@   | String   | Boolean   | Array Type-  | Object Row-  | Function [PolyType] Type+  | Object Type+  | Function [Type] Type   | TypeVar String   | TypeConstructor (Qualified ProperName)   | TypeApp Type Type   | SaturatedTypeSynonym (Qualified ProperName) [Type]   | ForAll String Type-  | Skolem Int deriving (Show, Eq, Data, Typeable)--type PolyType = Type--data Row-  = RUnknown (Unknown Row)-  | RowVar String+  | Skolem Int   | REmpty-  | RCons String Type Row-  | RSkolem Int deriving (Show, Eq, Data, Typeable)+  | RCons String Type Type deriving (Show, Eq, Data, Typeable) -rowToList :: Row -> ([(String, Type)], Row)+rowToList :: Type -> ([(String, Type)], Type) rowToList (RCons name ty row) = let (tys, rest) = rowToList row-                               in ((name, ty):tys, rest)+                                in ((name, ty):tys, rest) rowToList r = ([], r) -rowFromList :: ([(String, Type)], Row) -> Row+rowFromList :: ([(String, Type)], Type) -> Type rowFromList ([], r) = r rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
src/Language/PureScript/Values.hs view
@@ -70,7 +70,7 @@   | Block [Statement]   | Constructor (Qualified ProperName)   | Case [Value] [([Binder], Maybe Guard, Value)]-  | TypedValue Value PolyType deriving (Show, Data, Typeable)+  | TypedValue Value Type deriving (Show, Data, Typeable)  data Statement   = VariableIntroduction Ident Value