5b97210 · rowtype-yoga/purescript-native

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

on golang help sign in

Fix #377, fix #378

5b97210Phil Freeman13 years ago

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

compare with golang

unifiedsplit

@@ -677,6 +677,8 @@ inferLetBinding :: [Declaration] -> [Declaration] -> Value -> (Value -> UnifyT T

677inferLetBinding seen [] ret j = (,) seen <$> j ret

678inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing tv@(TypedValue checkType val ty) : rest) ret j = do

679 Just moduleName <- checkCurrentModule <$> get

680+ kind <- liftCheck $ kindOf moduleName ty

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

680 let dict = if isFunction val then M.singleton (moduleName, ident) (ty, nameKind) else M.empty

682 let dict = if isFunction val then M.singleton (moduleName, ident) (ty, nameKind) else M.empty

681 TypedValue _ val' ty' <- if checkType then bindNames dict (check val ty) else return tv

683 TypedValue _ val' ty' <- if checkType then bindNames dict (check val ty) else return tv

682 bindNames (M.singleton (moduleName, ident) (ty', nameKind)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing (TypedValue checkType val' ty')]) rest ret j

684 bindNames (M.singleton (moduleName, ident) (ty', nameKind)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing (TypedValue checkType val' ty')]) rest ret j

@@ -694,7 +696,7 @@ inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do

694 (ident, (val', _)) <- typeForBindingGroupElement moduleName e dict untypedDict

696 (ident, (val', _)) <- typeForBindingGroupElement moduleName e dict untypedDict

695 return $ (ident, LocalVariable, val')

697 return $ (ident, LocalVariable, val')

696 bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

698 bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

697−inferLetBinding seen (PositionedDeclaration pos d : ds) ret j = do

699+inferLetBinding seen (PositionedDeclaration pos d : ds) ret j = rethrowWithPosition pos $ do

698 ((d' : ds'), val') <- inferLetBinding seen (d : ds) ret j

700 ((d' : ds'), val') <- inferLetBinding seen (d : ds) ret j

699 return (PositionedDeclaration pos d' : ds', val')

701 return (PositionedDeclaration pos d' : ds', val')

700inferLetBinding _ _ _ _ = error "Invalid argument to inferLetBinding"

702inferLetBinding _ _ _ _ = error "Invalid argument to inferLetBinding"

tests/Main.hs−1

@@ -60,7 +60,6 @@ assertCompiles preludeJs preludeExterns inputFile = do

60 let options = P.defaultOptions { P.optionsMain = Just "Main", P.optionsModules = ["Main"], P.optionsCodeGenModules = ["Main"], P.optionsBrowserNamespace = Just "Tests" }

61 assert preludeExterns options inputFile $ either (return . Just) $ \(js, _, _) -> do

62 process <- findNodeProcess

63− putStrLn $ preludeJs ++ js

64 result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process

63 result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process

65 case result of

64 case result of

66 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing

65 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing