version 0.1.110.1.11

33 files changed, 724 insertions, 974 deletions

diff --git a/purescript.cabal b/purescript.cabal
index 2d03365..c36b879 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.2.2
+version: 0.1.11
 cabal-version: >=1.8
 build-type: Simple
 license: MIT
@@ -14,48 +14,46 @@ author: Phil Freeman <paf31@cantab.net>
 data-dir: ""
 
 library
-    build-depends: base >=4 && <5, cmdtheline -any, containers -any,
-                   directory -any, filepath -any, mtl -any, parsec -any, syb -any,
-                   transformers -any, utf8-string -any
-    exposed-modules: Language.PureScript.Scope Data.Generics.Extras
-                     Language.PureScript Language.PureScript.CodeGen
-                     Language.PureScript.CodeGen.Externs Language.PureScript.CodeGen.JS
-                     Language.PureScript.CodeGen.JS.AST
-                     Language.PureScript.CodeGen.Monad Language.PureScript.Declarations
-                     Language.PureScript.Kinds Language.PureScript.Names
-                     Language.PureScript.Operators Language.PureScript.Optimize
+    build-depends: base >=4 && <5, syb -any, cmdtheline -any,
+                   containers -any, mtl -any, transformers -any, parsec -any,
+                   utf8-string -any
+    exposed-modules: Data.Generics.Extras Language.PureScript.Operators
+                     Language.PureScript.Optimize Language.PureScript.Pretty.JS
+                     Language.PureScript.CodeGen.JS.AST Main Language.PureScript
+                     Language.PureScript.Declarations Language.PureScript.Names
+                     Language.PureScript.Types Language.PureScript.Values
+                     Language.PureScript.Kinds Language.PureScript.Pretty
+                     Language.PureScript.Pretty.Common Language.PureScript.Pretty.Values
+                     Language.PureScript.Pretty.Types Language.PureScript.Pretty.Kinds
+                     Language.PureScript.CodeGen Language.PureScript.CodeGen.Externs
+                     Language.PureScript.CodeGen.JS Language.PureScript.CodeGen.Monad
                      Language.PureScript.Parser Language.PureScript.Parser.Common
                      Language.PureScript.Parser.Declarations
-                     Language.PureScript.Parser.Kinds Language.PureScript.Parser.State
                      Language.PureScript.Parser.Types Language.PureScript.Parser.Values
-                     Language.PureScript.Pretty Language.PureScript.Pretty.Common
-                     Language.PureScript.Pretty.JS Language.PureScript.Pretty.Kinds
-                     Language.PureScript.Pretty.Types Language.PureScript.Pretty.Values
+                     Language.PureScript.Parser.State Language.PureScript.Parser.Kinds
                      Language.PureScript.TypeChecker
                      Language.PureScript.TypeChecker.Kinds
                      Language.PureScript.TypeChecker.Monad
+                     Language.PureScript.TypeChecker.Types
                      Language.PureScript.TypeChecker.Synonyms
-                     Language.PureScript.TypeChecker.Types Language.PureScript.Types
-                     Language.PureScript.Unknown Language.PureScript.Values Main
-                     Language.PureScript.CaseDeclarations
+                     Language.PureScript.Unknown
     exposed: True
     buildable: True
     hs-source-dirs: src
 
 executable psc
     build-depends: base >=4 && <5, cmdtheline -any, containers -any,
-                   directory -any, filepath -any, mtl -any, parsec -any,
-                   purescript -any, syb -any, transformers -any, utf8-string -any
+                   mtl -any, transformers -any, parsec -any, utf8-string -any,
+                   syb -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: src
     other-modules:
-    ghc-options: -Wall -O2 -fno-warn-unused-do-bind
 
 test-suite tests
-    build-depends: base >=4 && <5, cmdtheline -any, containers -any,
-                   directory -any, filepath -any, mtl -any, parsec -any,
-                   purescript -any, syb -any, transformers -any, utf8-string -any
+    build-depends: base >=4 && <5, syb -any, directory -any,
+                   filepath -any, containers -any, mtl -any, transformers -any,
+                   parsec -any, utf8-string -any, purescript -any
     type: exitcode-stdio-1.0
     main-is: Main.hs
     buildable: True
diff --git a/src/Data/Generics/Extras.hs b/src/Data/Generics/Extras.hs
index 02db199..89d05f0 100644
--- a/src/Data/Generics/Extras.hs
+++ b/src/Data/Generics/Extras.hs
@@ -18,7 +18,7 @@ module Data.Generics.Extras where
 
 import Data.Data
 
-everywhereM' :: (Monad m, Data d) => (forall d1. (Data d1) => d1 -> m d1) -> d -> m d
+everywhereM' :: (Monad m, Data d) => (forall d. (Data d) => d -> m d) -> d -> m d
 everywhereM' f x = do
   y <- f x
   gmapM (everywhereM' f) y
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index 4df2b55..9a40e30 100644
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -25,7 +25,6 @@ import Language.PureScript.TypeChecker as P
 import Language.PureScript.Pretty as P
 import Language.PureScript.Optimize as P
 import Language.PureScript.Operators as P
-import Language.PureScript.CaseDeclarations as P
 
 import Data.List (intercalate)
 import Data.Maybe (mapMaybe)
@@ -33,8 +32,7 @@ import Data.Maybe (mapMaybe)
 compile :: [Declaration] -> Either String (String, String, Environment)
 compile decls = do
   bracketted <- rebracket decls
-  desugared <- desugarCases bracketted
-  (_, env) <- runCheck (typeCheckAll desugared)
-  let js = prettyPrintJS . map optimize . concat . mapMaybe (\decl -> declToJs Nothing global decl env) $ desugared
-  let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ desugared
+  (_, env) <- runCheck (typeCheckAll bracketted)
+  let js = prettyPrintJS . map optimize . concat . mapMaybe (\decl -> declToJs Nothing global decl env) $ bracketted
+  let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ bracketted
   return (js, exts, env)
diff --git a/src/Language/PureScript/CaseDeclarations.hs b/src/Language/PureScript/CaseDeclarations.hs
deleted file mode 100644
index 5e597cf..0000000
--- a/src/Language/PureScript/CaseDeclarations.hs
+++ /dev/null
@@ -1,65 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.CaseDeclarations
--- Copyright   :  (c) Phil Freeman 2013
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Language.PureScript.CaseDeclarations (
-    desugarCases
-) where
-
-import Data.List (groupBy)
-import Control.Monad (join, unless)
-import Control.Monad.Error.Class
-
-import Language.PureScript.Names
-import Language.PureScript.Values
-import Language.PureScript.Declarations
-import Language.PureScript.Scope
-
-desugarCases :: [Declaration] -> Either String [Declaration]
-desugarCases = fmap join . mapM toDecls . groupBy inSameGroup
-
-inSameGroup :: Declaration -> Declaration -> Bool
-inSameGroup (ValueDeclaration ident1 _ _ _) (ValueDeclaration ident2 _ _ _) = ident1 == ident2
-inSameGroup _ _ = False
-
-toDecls :: [Declaration] -> Either String [Declaration]
-toDecls d@[ValueDeclaration _ [] Nothing _] = return d
-toDecls ds@(ValueDeclaration ident bs _ _ : _) = do
-  let tuples = map toTuple ds
-  unless (all ((== map length bs) . map length . fst) tuples) $
-      throwError $ "Argument list lengths differ in declaration " ++ show ident
-  return [makeCaseDeclaration ident tuples]
-toDecls [ModuleDeclaration name decls] = do
-  desugared <- desugarCases decls
-  return [ModuleDeclaration name desugared]
-toDecls ds = return ds
-
-toTuple :: Declaration -> ([[Binder]], (Maybe Guard, Value))
-toTuple (ValueDeclaration _ bs g val) = (bs, (g, val))
-toTuple _ = error "Not a value declaration"
-
-makeCaseDeclaration :: Ident -> [([[Binder]], (Maybe Guard, Value))] -> Declaration
-makeCaseDeclaration ident alternatives =
-  let
-    argPattern = map length . fst . head $ alternatives
-    args = take (sum argPattern) $ unusedNames (ident, alternatives)
-    vars = map (\arg -> Var (Qualified global arg)) args
-    binders = [ (join bs, g, val) | (bs, (g, val)) <- alternatives ]
-    value = foldr (\args' ret -> Abs args' ret) (Case vars binders) (rearrange argPattern args)
-  in
-    ValueDeclaration ident [] Nothing value
-
-rearrange :: [Int] -> [a] -> [[a]]
-rearrange [] _ = []
-rearrange (n:ns) xs = take n xs : rearrange ns (drop n xs)
-
diff --git a/src/Language/PureScript/CodeGen/Externs.hs b/src/Language/PureScript/CodeGen/Externs.hs
index 1375d85..eacd224 100644
--- a/src/Language/PureScript/CodeGen/Externs.hs
+++ b/src/Language/PureScript/CodeGen/Externs.hs
@@ -16,6 +16,7 @@ module Language.PureScript.CodeGen.Externs (
     externToPs
 ) where
 
+import Data.List (intercalate)
 import Data.Maybe (mapMaybe)
 import qualified Data.Map as M
 import Language.PureScript.Declarations
@@ -24,17 +25,17 @@ import Language.PureScript.Pretty
 import Language.PureScript.Names
 
 externToPs :: Int -> ModulePath -> Environment -> Declaration -> Maybe String
-externToPs indent path env (ValueDeclaration name _ _ _) = do
+externToPs indent path env (ValueDeclaration name _) = do
   (ty, _) <- M.lookup (path, name) $ names env
   return $ replicate indent ' ' ++ "foreign import " ++ show name ++ " :: " ++ prettyPrintType ty
 externToPs indent path env (DataDeclaration name _ _) = do
   (kind, _) <- M.lookup (path, name) $ types env
   return $ replicate indent ' ' ++ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind
-externToPs indent _ _ (ExternMemberDeclaration member name ty) =
+externToPs indent path env (ExternMemberDeclaration member name ty) =
   return $ replicate indent ' ' ++ "foreign import member " ++ show member ++ " " ++ show name ++ " :: " ++ prettyPrintType ty
-externToPs indent _ _ (ExternDataDeclaration name kind) =
+externToPs indent path env (ExternDataDeclaration name kind) =
   return $ replicate indent ' ' ++ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind
-externToPs indent _ _ (TypeSynonymDeclaration name args ty) =
+externToPs indent path env (TypeSynonymDeclaration name args ty) =
   return $ replicate indent ' ' ++ "type " ++ show name ++ " " ++ unwords args ++ " = " ++ prettyPrintType ty
 externToPs indent path env (ModuleDeclaration name decls) =
   return $ replicate indent ' ' ++ "module " ++ show name ++ " where\n" ++ unlines (mapMaybe (externToPs (indent + 2) (subModule path name) env) decls)
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 9fbbfe4..720d197 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -17,32 +17,35 @@ module Language.PureScript.CodeGen.JS (
     declToJs
 ) where
 
-import Data.Maybe (mapMaybe)
+import Data.Char
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.List (intercalate)
 import qualified Data.Map as M
-import Control.Arrow (second)
-import Control.Monad (replicateM, forM)
+import qualified Control.Arrow as A
+import Control.Arrow ((<+>), second)
+import Control.Monad (forM)
+import Control.Applicative
 
 import Language.PureScript.TypeChecker (Environment, names)
+import Language.PureScript.Types
 import Language.PureScript.Values
 import Language.PureScript.Names
-import Language.PureScript.Scope
 import Language.PureScript.Declarations
 import Language.PureScript.Pretty.Common
 import Language.PureScript.CodeGen.Monad
 import Language.PureScript.CodeGen.JS.AST as AST
-import Language.PureScript.TypeChecker.Monad (NameKind(..))
 
 declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]
-declToJs curMod mp (ValueDeclaration ident _ _ (Abs args ret)) e =
-  Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp e ret)]) :
-         maybe [] (return . setProperty (identToJs ident) (JSVar ident)) curMod
-declToJs curMod mp (ValueDeclaration ident _ _ val) e =
-  Just $ JSVariableIntroduction ident (Just (valueToJs mp e val)) :
-         maybe [] (return . setProperty (identToJs ident) (JSVar ident)) curMod
-declToJs curMod _ (ExternMemberDeclaration member ident _) _ =
+declToJs mod mp (ValueDeclaration ident (Abs args ret)) _ =
+  Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp ret)]) :
+         maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
+declToJs mod mp (ValueDeclaration ident val) _ =
+  Just $ JSVariableIntroduction ident (Just (valueToJs mp val)) :
+         maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
+declToJs mod _ (ExternMemberDeclaration member ident _) _ =
   Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :
-         maybe [] (return . setProperty (show ident) (JSVar ident)) curMod
-declToJs curMod mp (DataDeclaration _ _ ctors) _ =
+         maybe [] (return . setProperty (show ident) (JSVar ident)) mod
+declToJs mod mp (DataDeclaration _ _ ctors) _ =
   Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->
     let
       ctorJs =
@@ -52,129 +55,121 @@ declToJs curMod mp (DataDeclaration _ _ ctors) _ =
                       (JSBlock [JSReturn
                         (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified mp pn)))
                                          , ("value", JSVar (Ident "value")) ])])
-    in ctorJs : maybe [] (return . setProperty ctor (JSVar (Ident ctor))) curMod
-declToJs curMod mp (ModuleDeclaration pn@(ProperName name) decls) env =
+    in ctorJs : maybe [] (return . setProperty ctor (JSVar (Ident ctor))) mod
+declToJs mod mp (ModuleDeclaration pn@(ProperName name) decls) env =
   Just $ [ JSVariableIntroduction (Ident name) Nothing
          , JSApp (JSFunction Nothing [Ident name]
                              (JSBlock (concat $ mapMaybe (\decl -> declToJs (Just (Ident name)) (subModule mp pn) decl env) decls)))
                  [JSAssignment (JSAssignVariable (Ident name))
                                (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++
-         maybe [] (return . setProperty name (JSVar (Ident name))) curMod
+         maybe [] (return . setProperty name (JSVar (Ident name))) mod
+declToJs mod omp (ImportDeclaration mp idents) env =
+  Just $ case idents of
+    Nothing ->
+      let idents = map snd  . filter ((== mp) . fst) . M.keys $ names env
+      in map mkLocal idents
+    Just idents -> map mkLocal idents
+ where mkLocal ident = JSVariableIntroduction ident (Just (qualifiedToJS identToJs (Qualified mp ident)))
 declToJs _ _ _ _ = Nothing
 
 setProperty :: String -> JS -> Ident -> JS
-setProperty prop val curMod = JSAssignment (JSAssignProperty prop (JSAssignVariable curMod)) val
+setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val
 
-valueToJs :: ModulePath -> Environment -> Value -> JS
-valueToJs _ _ (NumericLiteral n) = JSNumericLiteral n
-valueToJs _ _ (StringLiteral s) = JSStringLiteral s
-valueToJs _ _ (BooleanLiteral b) = JSBooleanLiteral b
-valueToJs m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m e) xs)
-valueToJs m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m e)) ps)
-valueToJs m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m e o, JSObjectLiteral (map (second (valueToJs m e)) ps)]
-valueToJs _ _ (Constructor name) = qualifiedToJS runProperName name
-valueToJs m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m e) sts))) []
-valueToJs m e (Case values binders) = runGen (bindersToJs m e binders (map (valueToJs m e) values))
-valueToJs m e (IfThenElse cond th el) = JSConditional (valueToJs m e cond) (valueToJs m e th) (valueToJs m e el)
-valueToJs m e (Accessor prop val) = JSAccessor prop (valueToJs m e val)
-valueToJs m e (Indexer index val) = JSIndexer (valueToJs m e index) (valueToJs m e val)
-valueToJs m e (App val args) = JSApp (valueToJs m e val) (map (valueToJs m e) args)
-valueToJs m e (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs m e val)])
-valueToJs m e (Unary op val) = JSUnary op (valueToJs m e val)
-valueToJs m e (Binary op v1 v2) = JSBinary op (valueToJs m e v1) (valueToJs m e v2)
-valueToJs m e (Var ident) = case M.lookup (qualify m ident) (names e) of
-  Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified aliasModule aliasIdent)
-  _ -> qualifiedToJS identToJs ident
-valueToJs m e (TypedValue val _) = valueToJs m e val
-valueToJs _ _ _ = error "Invalid argument to valueToJs"
+valueToJs :: ModulePath -> Value -> JS
+valueToJs _ (NumericLiteral n) = JSNumericLiteral n
+valueToJs _ (StringLiteral s) = JSStringLiteral s
+valueToJs _ (BooleanLiteral b) = JSBooleanLiteral b
+valueToJs m (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m) xs)
+valueToJs m (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m)) ps)
+valueToJs m (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m o, JSObjectLiteral (map (second (valueToJs m)) ps)]
+valueToJs m (Constructor name) = qualifiedToJS runProperName name
+valueToJs m (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m) sts))) []
+valueToJs m (Case value binders) = runGen (bindersToJs m binders (valueToJs m value))
+valueToJs m (IfThenElse cond th el) = JSConditional (valueToJs m cond) (valueToJs m th) (valueToJs m el)
+valueToJs m (Accessor prop val) = JSAccessor prop (valueToJs m val)
+valueToJs m (Indexer index val) = JSIndexer (valueToJs m index) (valueToJs m val)
+valueToJs m (App val args) = JSApp (valueToJs m val) (map (valueToJs m) args)
+valueToJs m (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs m val)])
+valueToJs m (Unary op val) = JSUnary op (valueToJs m val)
+valueToJs m (Binary op v1 v2) = JSBinary op (valueToJs m v1) (valueToJs m v2)
+valueToJs m (Var ident) = qualifiedToJS identToJs ident
+valueToJs m (TypedValue val _) = valueToJs m val
 
 qualifiedToJS :: (a -> String) -> Qualified a -> JS
 qualifiedToJS f (Qualified (ModulePath parts) a) =
   delimited (f a : reverse (map show parts))
  where delimited [part]       = JSVar (Ident (part))
-       delimited (part:parts') = JSAccessor part (delimited parts')
-       delimited _            = error "Invalid argument to delimited"
+       delimited (part:parts) = JSAccessor part (delimited parts)
 
-bindersToJs :: ModulePath -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> Gen JS
-bindersToJs m e binders vals = do
-  setNextName $ firstUnusedName (binders, vals)
-  valNames <- replicateM (length vals) fresh
-  jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs m e result)] bs grd
-  return $ JSApp (JSFunction Nothing (map Ident valNames) (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
-                 vals
-  where
-    go :: [String] -> [JS] -> [Binder] -> Maybe Guard -> Gen [JS]
-    go _ done [] Nothing = return done
-    go _ done [] (Just cond) = return [JSIfElse (valueToJs m e cond) (JSBlock done) Nothing]
-    go (v:vs) done' (b:bs) grd = do
-      done'' <- go vs done' bs grd
-      binderToJs m e v done'' b
-    go _ _ _ _ = error "Invalid arguments to bindersToJs"
+bindersToJs :: ModulePath -> [(Binder, Value)] -> JS -> Gen JS
+bindersToJs m binders val = do
+  valName <- fresh
+  jss <- forM binders $ \(binder, result) -> binderToJs m valName [JSReturn (valueToJs m result)] binder
+  return $ JSApp (JSFunction Nothing [Ident valName] (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
+                 [val]
 
-binderToJs :: ModulePath -> Environment -> String -> [JS] -> Binder -> Gen [JS]
-binderToJs _ _ _ done NullBinder = return done
-binderToJs _ _ varName done (StringBinder str) =
+binderToJs :: ModulePath -> String -> [JS] -> Binder -> Gen [JS]
+binderToJs _ varName done NullBinder = return done
+binderToJs _ varName done (StringBinder str) =
   return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]
-binderToJs _ _ varName done (NumberBinder num) =
+binderToJs _ varName done (NumberBinder num) =
   return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSNumericLiteral num)) (JSBlock done) Nothing]
-binderToJs _ _ varName done (BooleanBinder True) =
+binderToJs _ varName done (BooleanBinder True) =
   return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]
-binderToJs _ _ varName done (BooleanBinder False) =
+binderToJs _ varName done (BooleanBinder False) =
   return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]
-binderToJs _ _ varName done (VarBinder ident) =
+binderToJs _ varName done (VarBinder ident) =
   return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : done)
-binderToJs m _ varName done (NullaryBinder ctor) =
+binderToJs m varName done (NullaryBinder ctor) =
   return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock done) Nothing]
-binderToJs m e varName done (UnaryBinder ctor b) = do
+binderToJs m varName done (UnaryBinder ctor b) = do
   value <- fresh
-  js <- binderToJs m e value done b
+  js <- binderToJs m value done b
   return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock (JSVariableIntroduction (Ident value) (Just (JSAccessor "value" (JSVar (Ident varName)))) : js)) Nothing]
-binderToJs m e varName done (ObjectBinder bs) = go done bs
+binderToJs m varName done (ObjectBinder bs) = go done bs
   where
   go :: [JS] -> [(String, Binder)] -> Gen [JS]
-  go done' [] = return done'
-  go done' ((prop, binder):bs') = do
+  go done [] = return done
+  go done ((prop, binder):bs) = do
     propVar <- fresh
-    done'' <- go done' bs'
-    js <- binderToJs m e propVar done'' binder
+    done' <- go done bs
+    js <- binderToJs m propVar done' binder
     return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)
-binderToJs m e varName done (ArrayBinder bs) = do
-  js <- go done 0 bs
-  return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
+binderToJs m varName done (ArrayBinder bs rest) = do
+  js <- go done rest 0 bs
+  return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
   where
-  go :: [JS] -> Integer -> [Binder] -> Gen [JS]
-  go done' _ [] = return done'
-  go done' index (binder:bs') = do
+  cmp :: BinaryOperator
+  cmp = maybe EqualTo (const GreaterThanOrEqualTo) rest
+  go :: [JS] -> Maybe Binder -> Integer -> [Binder] -> Gen [JS]
+  go done Nothing _ [] = return done
+  go done (Just binder) index [] = do
+    restVar <- fresh
+    js <- binderToJs m restVar done binder
+    return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)
+  go done rest index (binder:bs) = do
     elVar <- fresh
-    done'' <- go done' (index + 1) bs'
-    js <- binderToJs m e elVar done'' binder
+    done' <- go done rest (index + 1) bs
+    js <- binderToJs m elVar done' binder
     return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)
-binderToJs m e varName done (ConsBinder headBinder tailBinder) = do
-  headVar <- fresh
-  tailVar <- fresh
-  js1 <- binderToJs m e headVar done headBinder
-  js2 <- binderToJs m e tailVar js1 tailBinder
-  return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left 0))) (JSBlock
-    ( JSVariableIntroduction (Ident headVar) (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar (Ident varName)))) :
-      JSVariableIntroduction (Ident tailVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left 1)])) :
-      js2
-    )) Nothing]
-binderToJs m e varName done (NamedBinder ident binder) = do
-  js <- binderToJs m e varName done binder
+binderToJs m varName done (NamedBinder ident binder) = do
+  js <- binderToJs m varName done binder
   return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js)
+binderToJs m varName done (GuardedBinder cond binder) = binderToJs m varName done' binder
+  where
+  done' = [JSIfElse (valueToJs m cond) (JSBlock done) Nothing]
 
-statementToJs :: ModulePath -> Environment -> Statement -> JS
-statementToJs m e (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs m e value))
-statementToJs m e (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs m e value)
-statementToJs m e (While cond sts) = JSWhile (valueToJs m e cond) (JSBlock (map (statementToJs m e) sts))
-statementToJs m e (For ident start end sts) = JSFor ident (valueToJs m e start) (valueToJs m e end) (JSBlock (map (statementToJs m e) sts))
-statementToJs m e (ForEach ident arr sts) = JSApp (JSAccessor "forEach" (valueToJs m e arr)) [JSFunction Nothing [ident] (JSBlock (map (statementToJs m e) sts))]
-statementToJs m e (If ifst) = ifToJs ifst
+statementToJs :: ModulePath -> Statement -> JS
+statementToJs m (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs m value))
+statementToJs m (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs m value)
+statementToJs m (While cond sts) = JSWhile (valueToJs m cond) (JSBlock (map (statementToJs m) sts))
+statementToJs m (For ident start end sts) = JSFor ident (valueToJs m start) (valueToJs m end) (JSBlock (map (statementToJs m) sts))
+statementToJs m (ForEach ident arr sts) = JSApp (JSAccessor "forEach" (valueToJs m arr)) [JSFunction Nothing [ident] (JSBlock (map (statementToJs m) sts))]
+statementToJs m (If ifst) = ifToJs ifst
   where
   ifToJs :: IfStatement -> JS
-  ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs m e cond) (JSBlock (map (statementToJs m e) thens)) (fmap elseToJs elses)
+  ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs m cond) (JSBlock (map (statementToJs m) thens)) (fmap elseToJs elses)
   elseToJs :: ElseStatement -> JS
-  elseToJs (Else sts) = JSBlock (map (statementToJs m e) sts)
-  elseToJs (ElseIf elif) = ifToJs elif
-statementToJs m e (ValueStatement val) = valueToJs m e val
-statementToJs m e (Return value) = JSReturn (valueToJs m e value)
+  elseToJs (Else sts) = JSBlock (map (statementToJs m) sts)
+  elseToJs (ElseIf ifst) = ifToJs ifst
+statementToJs m (Return value) = JSReturn (valueToJs m value)
diff --git a/src/Language/PureScript/CodeGen/JS/AST.hs b/src/Language/PureScript/CodeGen/JS/AST.hs
index ee8ad50..59d34b5 100644
--- a/src/Language/PureScript/CodeGen/JS/AST.hs
+++ b/src/Language/PureScript/CodeGen/JS/AST.hs
@@ -47,5 +47,3 @@ data JS
 data JSAssignment
   = JSAssignVariable Ident
   | JSAssignProperty String JSAssignment deriving (Show, Data, Typeable)
-
-
diff --git a/src/Language/PureScript/CodeGen/Monad.hs b/src/Language/PureScript/CodeGen/Monad.hs
index 0ea9f5d..5cf876e 100644
--- a/src/Language/PureScript/CodeGen/Monad.hs
+++ b/src/Language/PureScript/CodeGen/Monad.hs
@@ -19,7 +19,7 @@ module Language.PureScript.CodeGen.Monad where
 import Control.Monad.State
 import Control.Applicative
 
-newtype Gen a = Gen { unGen :: State Int a } deriving (Functor, Applicative, Monad, MonadState Int, MonadFix)
+newtype Gen a = Gen { unGen :: State Int a } deriving (Functor, Applicative, Monad, MonadState Int)
 
 runGen :: Gen a -> a
 runGen = flip evalState 0 . unGen
@@ -29,9 +29,3 @@ fresh = do
   n <- get
   modify (+ 1)
   return $ '_' : show n
-
-getNextName :: Gen Int
-getNextName = get
-
-setNextName :: Int -> Gen ()
-setNextName = put
diff --git a/src/Language/PureScript/Declarations.hs b/src/Language/PureScript/Declarations.hs
index 21242d2..5457a73 100644
--- a/src/Language/PureScript/Declarations.hs
+++ b/src/Language/PureScript/Declarations.hs
@@ -33,7 +33,7 @@ data Declaration
   = DataDeclaration ProperName [String] [(ProperName, Maybe PolyType)]
   | TypeSynonymDeclaration ProperName [String] PolyType
   | TypeDeclaration Ident PolyType
-  | ValueDeclaration Ident [[Binder]] (Maybe Guard) Value
+  | ValueDeclaration Ident Value
   | ExternDeclaration Ident PolyType
   | ExternMemberDeclaration String Ident PolyType
   | ExternDataDeclaration ProperName Kind
diff --git a/src/Language/PureScript/Names.hs b/src/Language/PureScript/Names.hs
index 714a027..7bb47b3 100644
--- a/src/Language/PureScript/Names.hs
+++ b/src/Language/PureScript/Names.hs
@@ -17,7 +17,7 @@
 module Language.PureScript.Names where
 
 import Data.Data
-import Data.List (inits, intercalate)
+import Data.List (intercalate)
 
 data Ident = Ident String | Op String deriving (Eq, Ord, Data, Typeable)
 
@@ -44,12 +44,8 @@ global = ModulePath []
 data Qualified a = Qualified ModulePath a deriving (Eq, Ord, Data, Typeable)
 
 instance (Show a) => Show (Qualified a) where
-  show (Qualified (ModulePath names) a) = intercalate "." (map show names ++ [show a])
+  show (Qualified (ModulePath names) a) = intercalate ":" (map show names ++ [show a])
 
 qualify :: ModulePath -> Qualified a -> (ModulePath, a)
 qualify mp (Qualified (ModulePath []) a) = (mp, a)
 qualify _ (Qualified mp a) = (mp, a)
-
-nameResolution :: ModulePath -> Qualified a -> [(ModulePath, a)]
-nameResolution (ModulePath mp) (Qualified (ModulePath []) a) = [ (ModulePath mp', a) | mp' <- reverse $ inits mp ]
-nameResolution _ (Qualified mp a) = [(mp, a)]
diff --git a/src/Language/PureScript/Operators.hs b/src/Language/PureScript/Operators.hs
index 295f775..f957315 100644
--- a/src/Language/PureScript/Operators.hs
+++ b/src/Language/PureScript/Operators.hs
@@ -22,6 +22,7 @@ import Language.PureScript.Names
 import Language.PureScript.Declarations
 import Language.PureScript.Values
 
+import qualified Data.Data as D
 import Data.Function (on)
 import Data.List (groupBy, sortBy)
 import qualified Data.Map as M
@@ -61,10 +62,10 @@ matchOperators ops val = G.everywhereM' (G.mkM parseChains) val
   where
   parseChains :: Value -> Either String Value
   parseChains b@(BinaryNoParens _ _ _) = bracketChain (extendChain b)
-  parseChains other = return other
+  parseChains val = return val
   extendChain :: Value -> Chain
   extendChain (BinaryNoParens name l r) = Left l : Right name : extendChain r
-  extendChain other = [Left other]
+  extendChain val = [Left val]
   bracketChain :: Chain -> Either String Value
   bracketChain = either (Left . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"
   opTable = map (map (\(name, f, a) -> P.Infix (P.try (matchOp name) >> return f) (toAssoc a))) ops
diff --git a/src/Language/PureScript/Optimize.hs b/src/Language/PureScript/Optimize.hs
index b9e2790..c14034c 100644
--- a/src/Language/PureScript/Optimize.hs
+++ b/src/Language/PureScript/Optimize.hs
@@ -17,7 +17,6 @@ module Language.PureScript.Optimize (
 ) where
 
 import Data.Data
-import Data.Maybe (fromMaybe)
 import Data.Generics
 
 import Language.PureScript.Names
@@ -30,13 +29,7 @@ replaceIdent :: (Data d) => Ident -> JS -> d -> d
 replaceIdent var1 js = everywhere (mkT replace)
   where
   replace (JSVar var2) | var1 == var2 = js
-  replace other = other
-
-replaceIdents :: (Data d) => [(Ident, JS)] -> d -> d
-replaceIdents vars = everywhere (mkT replace)
-  where
-  replace v@(JSVar var) = fromMaybe v $ lookup var vars
-  replace other = other
+  replace js = js
 
 isReassigned :: (Data d) => Ident -> d -> Bool
 isReassigned var1 = everything (||) (mkQ False check)
@@ -91,8 +84,7 @@ etaConvert :: JS -> JS
 etaConvert = everywhere (mkT convert)
   where
   convert :: JS -> JS
-  convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents (JSBlock body)) args)])
-    | all shouldInline args = JSBlock (replaceIdents (zip idents args) body)
+  convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [ident] (JSBlock body)) [arg])]) | shouldInline arg = JSBlock (replaceIdent ident arg body)
   convert js = js
 
 unThunk :: JS -> JS
diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs
index c21fa56..7f202de 100644
--- a/src/Language/PureScript/Parser/Common.hs
+++ b/src/Language/PureScript/Parser/Common.hs
@@ -16,11 +16,14 @@
 
 module Language.PureScript.Parser.Common where
 
-import Data.Functor.Identity
+import Data.Char (isSpace)
 import Control.Applicative
 import Control.Monad
+import Control.Monad.State
 import Language.PureScript.Parser.State
+import qualified Data.Map as M
 import qualified Text.Parsec as P
+import qualified Text.Parsec.Pos as P
 import qualified Text.Parsec.Token as PT
 
 import Language.PureScript.Names
@@ -77,7 +80,7 @@ builtInOperators = [ "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "
                   , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!" ]
 
 reservedOpNames :: [String]
-reservedOpNames = builtInOperators ++ [ "->", "=", "." ]
+reservedOpNames = builtInOperators ++ [ "->" ]
 
 identStart :: P.Parsec String u Char
 identStart = P.lower <|> P.oneOf "_$"
@@ -89,12 +92,11 @@ identLetter :: P.Parsec String u Char
 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
   { PT.reservedNames   = reservedNames
   , PT.reservedOpNames = reservedOpNames
@@ -109,80 +111,36 @@ langDef = PT.LanguageDef
   , PT.caseSensitive   = True
   }
 
-tokenParser :: PT.GenTokenParser String u Identity
 tokenParser = PT.makeTokenParser langDef
 
-lexeme :: P.Parsec String u a -> P.Parsec String u a
-lexeme = PT.lexeme tokenParser
+lexeme           = PT.lexeme            tokenParser
+identifier       = PT.identifier        tokenParser
+reserved         = PT.reserved          tokenParser
+reservedOp       = PT.reservedOp        tokenParser
+operator         = PT.operator          tokenParser
+stringLiteral    = PT.stringLiteral     tokenParser
+whiteSpace       = PT.whiteSpace        tokenParser
+squares          = PT.squares           tokenParser
+semi             = PT.semi              tokenParser
+comma            = PT.comma             tokenParser
+colon            = PT.colon             tokenParser
+dot              = PT.dot               tokenParser
+natural          = PT.natural           tokenParser
 
-identifier :: P.Parsec String u String
-identifier = PT.identifier tokenParser
-
-reserved :: String -> P.Parsec String u ()
-reserved = PT.reserved tokenParser
-
-reservedOp :: String -> P.Parsec String u ()
-reservedOp = PT.reservedOp tokenParser
-
-operator :: P.Parsec String u String
-operator = PT.operator tokenParser
-
-stringLiteral :: P.Parsec String u String
-stringLiteral = PT.stringLiteral tokenParser
-
-whiteSpace :: P.Parsec String u ()
-whiteSpace = PT.whiteSpace tokenParser
-
-semi :: P.Parsec String u String
-semi = PT.semi tokenParser
-
-colon :: P.Parsec String u String
-colon = PT.colon tokenParser
-
-dot :: P.Parsec String u String
-dot = PT.dot tokenParser
-
-comma :: P.Parsec String u String
-comma = PT.comma tokenParser
-
-tick :: P.Parsec String u Char
-tick = lexeme $ P.char '`'
-
-pipe :: P.Parsec String u Char
-pipe = lexeme $ P.char '|'
-
-natural :: P.Parsec String u Integer
-natural = PT.natural tokenParser
-
-squares :: P.Parsec String ParseState a -> P.Parsec String ParseState a
-squares = P.between (lexeme $ P.char '[') (lexeme $ indented *> P.char ']') . (indented *>)
-
-parens :: P.Parsec String ParseState a -> P.Parsec String ParseState a
 parens = P.between (lexeme $ P.char '(') (lexeme $ indented *> P.char ')') . (indented *>)
-
-braces :: P.Parsec String ParseState a -> P.Parsec String ParseState a
 braces = P.between (lexeme $ P.char '{') (lexeme $ indented *> P.char '}') . (indented *>)
-
-angles :: P.Parsec String ParseState a -> P.Parsec String ParseState a
 angles = P.between (lexeme $ P.char '<') (lexeme $ indented *> P.char '>') . (indented *>)
 
-sepBy :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
 sepBy p s = P.sepBy (indented *> p) (indented *> s)
-
-sepBy1 :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
 sepBy1 p s = P.sepBy1 (indented *> p) (indented *> s)
 
-semiSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-semiSep = flip sepBy semi
+semiSep          = flip sepBy semi
+semiSep1         = flip sepBy1 semi
+commaSep         = flip sepBy comma
+commaSep1        = flip sepBy1 comma
 
-semiSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-semiSep1 = flip sepBy1 semi
-
-commaSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-commaSep = flip sepBy comma
-
-commaSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
-commaSep1 = flip sepBy1 comma
+tick = lexeme $ P.char '`'
+pipe = lexeme $ P.char '|'
 
 properName :: P.Parsec String u ProperName
 properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
@@ -193,7 +151,7 @@ parseQualified parser = part global
   part path = (do name <- P.try (properName <* delimiter)
                   part (subModule path name))
               <|> (Qualified path <$> P.try parser)
-  delimiter = indented *> dot
+  delimiter = indented *> colon <* P.notFollowedBy colon
 
 integerOrFloat :: P.Parsec String u (Either Integer Double)
 integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>
@@ -208,16 +166,8 @@ fold first more combine = do
   bs <- P.many more
   return $ foldl combine a bs
 
-buildPostfixParser :: P.Stream s m t => [a -> P.ParsecT s u m a] -> P.ParsecT s u m a -> P.ParsecT s u m a
-buildPostfixParser fs first = do
-  a <- first
-  go a
-  where
-  go a = do
-    maybeA <- P.optionMaybe $ P.choice (map ($ a) fs)
-    case maybeA of
-      Nothing -> return a
-      Just a' -> go a'
+buildPostfixParser :: P.Stream s m t => [P.ParsecT s u m (a -> a)] -> P.ParsecT s u m a -> P.ParsecT s u m a
+buildPostfixParser f x = fold x (P.choice f) (flip ($))
 
 operatorOrBuiltIn :: P.Parsec String u String
 operatorOrBuiltIn = P.try operator <|> P.choice (map (\s -> P.try (reservedOp s) >> return s) builtInOperators)
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index 751d185..d8c270b 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -17,17 +17,26 @@ module Language.PureScript.Parser.Declarations (
     parseDeclarations
 ) where
 
+import Data.Char
+import Data.List
+import Data.Maybe
+import Data.Function
 import Control.Applicative
+import Control.Arrow (Arrow(..))
+import Control.Monad.State
+import qualified Data.Map as M
 import qualified Text.Parsec as P
+import qualified Text.Parsec.Pos as P
 
 import Language.PureScript.Names
+import Language.PureScript.Values
+import Language.PureScript.Types
 import Language.PureScript.Parser.State
 import Language.PureScript.Parser.Common
 import Language.PureScript.Declarations
 import Language.PureScript.Parser.Values
 import Language.PureScript.Parser.Types
 import Language.PureScript.Parser.Kinds
-import Language.PureScript.Values
 
 parseDataDeclaration :: P.Parsec String ParseState Declaration
 parseDataDeclaration = do
@@ -51,13 +60,8 @@ parseTypeSynonymDeclaration =
 
 parseValueDeclaration :: P.Parsec String ParseState Declaration
 parseValueDeclaration =
-  ValueDeclaration <$> parseIdent
-                   <*> P.many parseTopLevelBinder
-                   <*> P.optionMaybe parseGuard
-                   <*> ((lexeme (indented *> P.char '=')) *> parseValue)
-
-parseTopLevelBinder :: P.Parsec String ParseState [Binder]
-parseTopLevelBinder = return <$> P.try parseBinderNoParens <|> parens (commaSep parseBinder)
+  ValueDeclaration <$> P.try (parseIdent <* lexeme (indented *> P.char '='))
+                   <*> parseValue
 
 parseExternDeclaration :: P.Parsec String ParseState Declaration
 parseExternDeclaration = P.try (reserved "foreign") *> indented *> (reserved "import") *> indented *>
diff --git a/src/Language/PureScript/Parser/State.hs b/src/Language/PureScript/Parser/State.hs
index e20cb1d..94cf567 100644
--- a/src/Language/PureScript/Parser/State.hs
+++ b/src/Language/PureScript/Parser/State.hs
@@ -14,7 +14,11 @@
 
 module Language.PureScript.Parser.State where
 
+import Language.PureScript.Names
+import Language.PureScript.Declarations
+
 import qualified Text.Parsec as P
+import qualified Data.Map as M
 
 data ParseState = ParseState
   { indentationLevel :: P.Column } deriving Show
diff --git a/src/Language/PureScript/Parser/Types.hs b/src/Language/PureScript/Parser/Types.hs
index d2bb873..6fa2ba4 100644
--- a/src/Language/PureScript/Parser/Types.hs
+++ b/src/Language/PureScript/Parser/Types.hs
@@ -24,6 +24,7 @@ import Language.PureScript.Parser.Common
 import Control.Applicative
 import qualified Text.Parsec as P
 import qualified Text.Parsec.Expr as P
+import Control.Arrow (Arrow(..))
 import Control.Monad (unless)
 
 parseNumber :: P.Parsec String ParseState Type
@@ -74,8 +75,8 @@ parseTypeAtom = indented *> P.choice (map P.try
 parseAnyType :: P.Parsec String ParseState Type
 parseAnyType = (P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom) P.<?> "type"
   where
-  postfixTable :: [Type -> P.Parsec String ParseState Type]
-  postfixTable = [ \x -> TypeApp x <$> P.try (indented *> parseTypeAtom) ]
+  postfixTable :: [P.Parsec String ParseState (Type -> Type)]
+  postfixTable = [ flip TypeApp <$> P.try (indented *> parseTypeAtom) ]
   operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocRight ] ]
 
 parseType :: P.Parsec String ParseState Type
diff --git a/src/Language/PureScript/Parser/Values.hs b/src/Language/PureScript/Parser/Values.hs
index 465b5f2..d1ae1a8 100644
--- a/src/Language/PureScript/Parser/Values.hs
+++ b/src/Language/PureScript/Parser/Values.hs
@@ -14,18 +14,25 @@
 
 module Language.PureScript.Parser.Values (
     parseValue,
-    parseGuard,
-    parseBinder,
-    parseBinderNoParens
+    parseBinder
 ) where
 
 import Language.PureScript.Values
+import Language.PureScript.Names
+import Language.PureScript.Declarations
 import Language.PureScript.Parser.State
+import Data.Function (on)
+import Data.List
+import Data.Functor.Identity
+import qualified Data.Map as M
 import qualified Language.PureScript.Parser.Common as C
 import Control.Applicative
 import qualified Text.Parsec as P
 import Text.Parsec.Expr
+import Control.Monad
+import Control.Arrow (Arrow(..))
 import Language.PureScript.Parser.Types
+import Language.PureScript.Types
 
 booleanLiteral :: P.Parsec String ParseState Bool
 booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
@@ -67,6 +74,10 @@ parseAbs = do
   toFunction [] value = Abs [] value
   toFunction args value = foldr (($)) value args
 
+parseApp :: P.Parsec String ParseState Value
+parseApp = App <$> parseValue
+               <*> (C.indented *> C.parens (C.commaSep parseValue))
+
 parseVar :: P.Parsec String ParseState Value
 parseVar = Var <$> C.parseQualified C.parseIdent
 
@@ -74,14 +85,13 @@ parseConstructor :: P.Parsec String ParseState Value
 parseConstructor = Constructor <$> C.parseQualified C.properName
 
 parseCase :: P.Parsec String ParseState Value
-parseCase = Case <$> P.between (P.try (C.reserved "case")) (C.indented *> C.reserved "of") (return <$> parseValue)
+parseCase = Case <$> P.between (P.try (C.reserved "case")) (C.indented *> C.reserved "of") parseValue
                  <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))
 
-parseCaseAlternative :: P.Parsec String ParseState ([Binder], Maybe Guard, Value)
-parseCaseAlternative = (,,) <$> (return <$> parseBinder)
-                            <*> P.optionMaybe parseGuard
-                            <*> (C.lexeme (P.string "->") *> parseValue)
-                            P.<?> "case alternative"
+parseCaseAlternative :: P.Parsec String ParseState (Binder, Value)
+parseCaseAlternative = (,) <$> (parseGuardedBinder <* C.lexeme (P.string "->"))
+                           <*> parseValue
+                           P.<?> "case alternative"
 
 parseIfThenElse :: P.Parsec String ParseState Value
 parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parseValue)
@@ -89,23 +99,18 @@ parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parse
                              <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)
 
 parseBlock :: P.Parsec String ParseState Value
-parseBlock = Block <$> parseManyStatements
+parseBlock = Block <$> (P.try (C.reserved "do") *> parseManyStatements)
 
 parseManyStatements :: P.Parsec String ParseState [Statement]
-parseManyStatements = (do
-  C.lexeme $ P.char '{'
-  C.indented
-  sts <- C.mark (P.many (C.same *> C.mark parseStatement))
-  C.lexeme (P.char '}')
-  return sts) P.<?> "block"
+parseManyStatements = C.indented *> C.mark (P.many (C.same *> C.mark parseStatement)) P.<?> "block"
 
 parseValueAtom :: P.Parsec String ParseState Value
-parseValueAtom = P.choice
+parseValueAtom = C.indented *> P.choice
             [ P.try parseNumericLiteral
             , P.try parseStringLiteral
             , P.try parseBooleanLiteral
             , parseArrayLiteral
-            , P.try parseObjectLiteral
+            , parseObjectLiteral
             , parseAbs
             , P.try parseConstructor
             , P.try parseVar
@@ -121,10 +126,6 @@ parsePropertyUpdate = do
   value <- C.indented *> parseValue
   return (name, value)
 
-parseAccessor :: Value -> P.Parsec String ParseState Value
-parseAccessor (Constructor _) = P.unexpected "constructor"
-parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> C.identifier) <*> pure obj
-
 parseValue :: P.Parsec String ParseState Value
 parseValue =
   (buildExpressionParser operators
@@ -132,11 +133,11 @@ parseValue =
    $ indexersAndAccessors) P.<?> "expression"
   where
   indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom
-  postfixTable1 = [ parseAccessor
-                  , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> C.braces (C.commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]
-  postfixTable2 = [ \v -> P.try (C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2])) <*> pure v
-                  , \v -> P.try $ flip App <$> (C.indented *> C.parens (C.commaSep parseValue)) <*> pure v
-                  , \v -> flip TypedValue <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) <*> pure v ]
+  postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)
+                  , P.try $ flip ObjectUpdate <$> (C.indented *> C.braces (C.commaSep1 (C.indented *> parsePropertyUpdate))) ]
+  postfixTable2 = [ P.try (C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2]))
+                  , P.try $ flip App <$> (C.indented *> C.parens (C.commaSep parseValue))
+                  , flip TypedValue <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) ]
   operators = [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
                 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
                 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Unary Negate)
@@ -151,32 +152,28 @@ parseVariableIntroduction = do
   name <- C.indented *> C.parseIdent
   C.lexeme $ C.indented *> P.char '='
   value <- parseValue
-  C.indented *> C.semi
   return $ VariableIntroduction name value
 
 parseAssignment :: P.Parsec String ParseState Statement
 parseAssignment = do
-  tgt <- P.try $ do
-    tgt <- C.parseIdent
-    C.lexeme $ C.indented *> P.char '='
-    return tgt
+  tgt <- C.parseIdent
+  C.lexeme $ C.indented *> P.char '='
   value <- parseValue
-  C.indented *> C.semi
   return $ Assignment tgt value
 
 parseWhile :: P.Parsec String ParseState Statement
-parseWhile = While <$> (C.reserved "while" *> C.indented *> C.parens parseValue)
-                   <*> (C.indented *> parseManyStatements)
+parseWhile = While <$> (C.reserved "while" *> C.indented *> parseValue <* C.indented <* C.colon)
+                   <*> parseManyStatements
 
 parseFor :: P.Parsec String ParseState Statement
-parseFor = For <$> (C.reserved "for" *> C.indented *> C.lexeme (P.char '(') *> C.indented *> C.parseIdent)
+parseFor = For <$> (C.reserved "for" *> C.indented *> C.parseIdent)
                <*> (C.indented *> C.lexeme (P.string "<-") *> parseValue)
-               <*> (C.indented *> C.reserved "until" *> parseValue <* C.indented <* C.lexeme (P.char ')'))
+               <*> (C.indented *> C.reserved "until" *> parseValue <* C.colon)
                <*> parseManyStatements
 
 parseForEach :: P.Parsec String ParseState Statement
-parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.lexeme (P.char '(') *> C.indented *> C.parseIdent)
-                       <*> (C.indented *> C.reserved "in" *> parseValue <* C.lexeme (P.char ')'))
+parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.parseIdent)
+                       <*> (C.indented *> C.reserved "in" *> parseValue <* C.colon)
                        <*> parseManyStatements
 
 parseIf :: P.Parsec String ParseState Statement
@@ -184,30 +181,26 @@ parseIf = If <$> parseIfStatement
 
 parseIfStatement :: P.Parsec String ParseState IfStatement
 parseIfStatement =
-  IfStatement <$> (C.reserved "if" *> C.indented *> C.parens parseValue)
+  IfStatement <$> (C.reserved "if" *> C.indented *> parseValue <* C.indented <* C.colon)
               <*> parseManyStatements
-              <*> P.optionMaybe parseElseStatement
+              <*> P.optionMaybe (C.same *> parseElseStatement)
 
 parseElseStatement :: P.Parsec String ParseState ElseStatement
-parseElseStatement = C.reserved "else" >> (ElseIf <$> parseIfStatement
-                                           <|> Else <$> parseManyStatements)
-
-parseValueStatement :: P.Parsec String ParseState Statement
-parseValueStatement = ValueStatement <$> (parseValue <* C.semi)
+parseElseStatement = C.reserved "else" >> (ElseIf <$> (C.indented *> parseIfStatement)
+                                           <|> Else <$> (C.indented *> C.colon *> parseManyStatements))
 
 parseReturn :: P.Parsec String ParseState Statement
-parseReturn = Return <$> (C.reserved "return" *> parseValue <* C.indented <* C.semi)
+parseReturn = Return <$> (C.reserved "return" *> parseValue)
 
 parseStatement :: P.Parsec String ParseState Statement
-parseStatement = P.choice
+parseStatement = P.choice (map P.try
                  [ parseVariableIntroduction
                  , parseAssignment
                  , parseWhile
                  , parseFor
                  , parseForEach
                  , parseIf
-                 , parseValueStatement
-                 , parseReturn ] P.<?> "statement"
+                 , parseReturn ]) P.<?> "statement"
 
 parseStringBinder :: P.Parsec String ParseState Binder
 parseStringBinder = StringBinder <$> C.stringLiteral
@@ -232,6 +225,7 @@ parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep (C.indented *> parseId
 
 parseArrayBinder :: P.Parsec String ParseState Binder
 parseArrayBinder = C.squares $ ArrayBinder <$> (C.commaSep (C.indented *> parseBinder))
+                                           <*> P.optionMaybe (C.indented *> C.colon *> C.indented *> parseBinder)
 
 parseNamedBinder :: P.Parsec String ParseState Binder
 parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))
@@ -247,38 +241,19 @@ parseIdentifierAndBinder = do
   binder <- C.indented *> parseBinder
   return (name, binder)
 
-parseBinderAtom :: P.Parsec String ParseState Binder
-parseBinderAtom = P.choice (map P.try
-                  [ parseNullBinder
-                  , parseStringBinder
-                  , parseBooleanBinder
-                  , parseNumberBinder
-                  , parseNamedBinder
-                  , parseVarBinder
-                  , parseUnaryBinder
-                  , parseNullaryBinder
-                  , parseObjectBinder
-                  , parseArrayBinder
-                  , C.parens parseBinder ]) P.<?> "binder"
-
 parseBinder :: P.Parsec String ParseState Binder
-parseBinder = (buildExpressionParser operators parseBinderAtom) P.<?> "expression"
-  where
-  operators = [ [ Infix ( C.lexeme (P.try $ C.indented *> C.reservedOp ":") >> return ConsBinder) AssocRight ] ]
-
-parseBinderNoParens :: P.Parsec String ParseState Binder
-parseBinderNoParens = P.choice (map P.try
+parseBinder = P.choice (map P.try
                   [ parseNullBinder
                   , parseStringBinder
                   , parseBooleanBinder
                   , parseNumberBinder
                   , parseNamedBinder
                   , parseVarBinder
+                  , parseUnaryBinder
                   , parseNullaryBinder
                   , parseObjectBinder
                   , parseArrayBinder
                   , C.parens parseBinder ]) P.<?> "binder"
 
-parseGuard :: P.Parsec String ParseState Guard
-parseGuard = C.indented *> C.pipe *> C.indented *> parseValue
-
+parseGuardedBinder :: P.Parsec String ParseState Binder
+parseGuardedBinder = flip ($) <$> parseBinder <*> P.option id (GuardedBinder <$> (C.indented *> C.lexeme (P.char '|') *> C.indented *> parseValue))
diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs
index d9cf69d..602e5b6 100644
--- a/src/Language/PureScript/Pretty/Common.hs
+++ b/src/Language/PureScript/Pretty/Common.hs
@@ -17,13 +17,20 @@
 module Language.PureScript.Pretty.Common where
 
 import Data.Char
+import Data.Maybe (fromMaybe)
+import Data.List (nub, intersperse, intercalate)
+import Data.Function (fix)
 import Control.Monad.State
+import Control.Applicative (Applicative(..), Alternative(..))
 import qualified Control.Category as C
 import Control.Category ((>>>))
 import qualified Control.Arrow as A
 import Control.Arrow ((***), (<+>))
 
 import Language.PureScript.Names
+import Language.PureScript.Values
+import Language.PureScript.Types
+import Language.PureScript.Declarations
 
 identToJs :: Ident -> String
 identToJs (Ident name) = name
@@ -50,16 +57,16 @@ parens :: String -> String
 parens s = ('(':s) ++ ")"
 
 chainl :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r
-chainl g f p = fix $ \c -> g >>> ((c <+> p) *** p) >>> A.arr (uncurry f)
+chainl split f p = fix $ \c -> split >>> ((c <+> p) *** p) >>> A.arr (uncurry f)
 
 chainr :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r
-chainr g f p = fix $ \c -> g >>> (p *** (c <+> p)) >>> A.arr (uncurry f)
+chainr split f p = fix $ \c -> split >>> (p *** (c <+> p)) >>> A.arr (uncurry f)
 
 wrap :: Pattern u a (s, a) -> (s -> r -> r) -> Pattern u a r -> Pattern u a r
-wrap g f p = fix $ \c -> g >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f)
+wrap split f p = fix $ \c -> split >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f)
 
-split :: Pattern u a (s, t) -> (s -> t -> r) -> Pattern u a r
-split s f = s >>> A.arr (uncurry f)
+split :: Pattern u a (s, t) -> (s -> t -> r) -> Pattern u a r -> Pattern u a r
+split s f p = s >>> A.arr (uncurry f)
 
 data OperatorTable u a r = OperatorTable { runOperatorTable :: [ [Operator u a r] ] }
 
@@ -75,5 +82,5 @@ buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<+>) (flip map ops $ \op
     AssocL pat g -> chainl pat g p'
     AssocR pat g -> chainr pat g p'
     Wrap pat g -> wrap pat g p'
-    Split pat g -> split pat g
+    Split pat g -> split pat g p'
   ) <+> p') p $ runOperatorTable table
diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs
index 1f07652..5d33ab1 100644
--- a/src/Language/PureScript/Pretty/JS.hs
+++ b/src/Language/PureScript/Pretty/JS.hs
@@ -24,7 +24,7 @@ import Language.PureScript.CodeGen.JS.AST
 import Data.List
 import Data.Maybe (fromMaybe)
 import qualified Control.Arrow as A
-import Control.Arrow ((<+>))
+import Control.Arrow ((***), (<+>), first, second)
 import Control.Applicative
 import Control.Monad.State
 
@@ -34,10 +34,11 @@ blockIndent :: Int
 blockIndent = 4
 
 withIndent :: StateT PrinterState Maybe String -> StateT PrinterState Maybe String
-withIndent action = do
-  modify $ \st -> st { indent = indent st + blockIndent }
-  result <- action
-  modify $ \st -> st { indent = indent st - blockIndent }
+withIndent s = do
+  current <- get
+  modify $ \s -> s { indent = indent s + blockIndent }
+  result <- s
+  modify $ \s -> s { indent = indent s - blockIndent }
   return result
 
 currentIndent :: StateT PrinterState Maybe String
@@ -157,22 +158,22 @@ app = mkPattern' match
   match _ = mzero
 
 unary :: UnaryOperator -> String -> Operator PrinterState JS String
-unary op str = Wrap match (++)
+unary op str = Wrap pattern (++)
   where
-  match :: Pattern PrinterState JS (String, JS)
-  match = mkPattern match'
+  pattern :: Pattern PrinterState JS (String, JS)
+  pattern = mkPattern match
     where
-    match' (JSUnary op' val) | op' == op = Just (str, val)
-    match' _ = Nothing
+    match (JSUnary op' val) | op' == op = Just (str, val)
+    match _ = Nothing
 
 binary :: BinaryOperator -> String -> Operator PrinterState JS String
-binary op str = AssocR match (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)
+binary op str = AssocR pattern (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)
   where
-  match :: Pattern PrinterState JS (JS, JS)
-  match = mkPattern match'
+  pattern :: Pattern PrinterState JS (JS, JS)
+  pattern = mkPattern match
     where
-    match' (JSBinary op' v1 v2) | op' == op = Just (v1, v2)
-    match' _ = Nothing
+    match (JSBinary op' v1 v2) | op' == op = Just (v1, v2)
+    match _ = Nothing
 
 prettyPrintJS1 :: JS -> String
 prettyPrintJS1 = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintJS'
diff --git a/src/Language/PureScript/Pretty/Kinds.hs b/src/Language/PureScript/Pretty/Kinds.hs
index 822d6a1..a1c9883 100644
--- a/src/Language/PureScript/Pretty/Kinds.hs
+++ b/src/Language/PureScript/Pretty/Kinds.hs
@@ -17,11 +17,15 @@ module Language.PureScript.Pretty.Kinds (
 ) where
 
 import Data.Maybe (fromMaybe)
+import Data.List (intersperse, intercalate)
+import qualified Control.Arrow as A
+import Control.Arrow ((<+>))
+import qualified Data.Map as M
+import Control.Applicative
 
 import Language.PureScript.Kinds
 import Language.PureScript.Pretty.Common
 import Language.PureScript.Unknown
-import Control.Arrow (ArrowPlus(..))
 
 typeLiterals :: Pattern () Kind String
 typeLiterals = mkPattern match
diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs
index bd93195..1babcc0 100644
--- a/src/Language/PureScript/Pretty/Types.hs
+++ b/src/Language/PureScript/Pretty/Types.hs
@@ -18,10 +18,17 @@ module Language.PureScript.Pretty.Types (
 ) where
 
 import Data.Maybe (fromMaybe)
-import Data.List (intercalate)
+import Data.List (intersperse, intercalate)
+import qualified Control.Arrow as A
 import Control.Arrow ((<+>))
+import qualified Data.Map as M
+import Control.Applicative
 
+import Language.PureScript.Values
 import Language.PureScript.Types
+import Language.PureScript.Names
+import Language.PureScript.Declarations
+import Language.PureScript.TypeChecker.Monad
 import Language.PureScript.Pretty.Common
 import Language.PureScript.Unknown
 
@@ -42,7 +49,7 @@ typeLiterals = mkPattern match
   match _ = Nothing
 
 prettyPrintRow :: Row -> String
-prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs rest) . toList []
+prettyPrintRow = (\(tys, tail) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs tail) . toList []
   where
   nameAndTypeToPs :: String -> Type -> String
   nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty
@@ -51,7 +58,6 @@ prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs
   tailToPs (RUnknown (Unknown u)) = " | u" ++ show u
   tailToPs (RowVar var) = " | " ++ var
   tailToPs (RSkolem s) = " | s" ++ show s
-  tailToPs _ = error "Invalid row tail"
   toList :: [(String, Type)] -> Row -> ([(String, Type)], Row)
   toList tys (RCons name ty row) = toList ((name, ty):tys) row
   toList tys r = (tys, r)
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index f9c6d81..f37c29a 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -17,12 +17,16 @@ module Language.PureScript.Pretty.Values (
     prettyPrintBinder
 ) where
 
+import Data.Char
 import Data.Maybe (fromMaybe)
 import Data.List (intercalate)
+import qualified Control.Arrow as A
 import Control.Arrow ((<+>))
+import Control.Applicative
 
 import Language.PureScript.Types
 import Language.PureScript.Values
+import Language.PureScript.Names
 import Language.PureScript.Pretty.Common
 import Language.PureScript.Pretty.Types
 
@@ -37,14 +41,12 @@ literals = mkPattern match
   match (ObjectLiteral ps) = Just $ "{" ++ intercalate ", " (map (uncurry prettyPrintObjectProperty) ps) ++ "}"
   match (Constructor name) = Just $ show name
   match (Block sts) = Just $ "do { " ++ intercalate " ; " (map prettyPrintStatement sts) ++ " }"
-  match (Case values binders) = Just $ "case " ++ intercalate " " (map prettyPrintValue values) ++
-    " of { " ++ intercalate " ; " (map prettyPrintCaseAlternative binders) ++ " }"
+  match (Case value binders) = Just $ "case " ++ prettyPrintValue value ++ " of { " ++ intercalate " ; " (map (uncurry prettyPrintCaseAlternative) binders) ++ " }"
   match (Var ident) = Just $ show ident
   match _ = Nothing
 
-prettyPrintCaseAlternative :: ([Binder], Maybe Guard, Value) -> String
-prettyPrintCaseAlternative (binders, grd, val) = "(" ++ intercalate ", " (map prettyPrintBinder binders) ++ ") " ++
-  (maybe "" (("| " ++) . prettyPrintValue) grd) ++ " -> " ++ prettyPrintValue val
+prettyPrintCaseAlternative :: Binder -> Value -> String
+prettyPrintCaseAlternative binder val = prettyPrintBinder binder ++ " -> " ++ prettyPrintValue val
 
 ifThenElse :: Pattern () Value ((Value, Value), Value)
 ifThenElse = mkPattern match
@@ -89,22 +91,22 @@ typed = mkPattern match
   match _ = Nothing
 
 unary :: UnaryOperator -> String -> Operator () Value String
-unary op str = Wrap match (++)
+unary op str = Wrap pattern (++)
   where
-  match :: Pattern () Value (String, Value)
-  match = mkPattern match'
+  pattern :: Pattern () Value (String, Value)
+  pattern = mkPattern match
     where
-    match' (Unary op' val) | op' == op = Just (str, val)
-    match' _ = Nothing
+    match (Unary op' val) | op' == op = Just (str, val)
+    match _ = Nothing
 
 binary :: BinaryOperator -> String -> Operator () Value String
-binary op str = AssocR match (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)
+binary op str = AssocR pattern (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)
   where
-  match :: Pattern () Value (Value, Value)
-  match = mkPattern match'
+  pattern :: Pattern () Value (Value, Value)
+  pattern = mkPattern match
     where
-    match' (Binary op' v1 v2) | op' == op = Just (v1, v2)
-    match' _ = Nothing
+    match (Binary op' v1 v2) | op' == op = Just (v1, v2)
+    match _ = Nothing
 
 prettyPrintValue :: Value -> String
 prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue ()
@@ -145,37 +147,19 @@ prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue (
                   , [ binary    Or                   "||" ]
                   ]
 
-prettyPrintBinderAtom :: Pattern () Binder String
-prettyPrintBinderAtom = mkPattern match
-  where
-  match :: Binder -> Maybe String
-  match NullBinder = Just "_"
-  match (StringBinder str) = Just $ show str
-  match (NumberBinder num) = Just $ either show show num
-  match (BooleanBinder True) = Just "true"
-  match (BooleanBinder False) = Just "false"
-  match (VarBinder ident) = Just $ show ident
-  match (NullaryBinder ctor) = Just $ show ctor
-  match (UnaryBinder ctor b) = Just $ show ctor ++ " " ++ prettyPrintBinder b
-  match (ObjectBinder bs) = Just $ "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"
-  match (ArrayBinder bs) = Just $ "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ " ]"
-  match (NamedBinder ident binder) = Just $ show ident ++ "@" ++ prettyPrintBinder binder
-  match _ = Nothing
-
 prettyPrintBinder :: Binder -> String
-prettyPrintBinder = fromMaybe (error "Incomplete pattern") . pattern matchBinder ()
-  where
-  matchBinder :: Pattern () Binder String
-  matchBinder = buildPrettyPrinter operators (prettyPrintBinderAtom <+> fmap parens matchBinder)
-  operators :: OperatorTable () Binder String
-  operators =
-    OperatorTable [ [ AssocR matchConsBinder (\b1 b2 -> b1 ++ " : " ++ b2) ] ]
-
-matchConsBinder :: Pattern () Binder (Binder, Binder)
-matchConsBinder = mkPattern match'
-  where
-  match' (ConsBinder b1 b2) = Just (b1, b2)
-  match' _ = Nothing
+prettyPrintBinder NullBinder = "_"
+prettyPrintBinder (StringBinder str) = show str
+prettyPrintBinder (NumberBinder num) = either show show num
+prettyPrintBinder (BooleanBinder True) = "true"
+prettyPrintBinder (BooleanBinder False) = "false"
+prettyPrintBinder (VarBinder ident) = show ident
+prettyPrintBinder (NullaryBinder ctor) = show ctor
+prettyPrintBinder (UnaryBinder ctor b) = show ctor ++ " " ++ prettyPrintBinder b
+prettyPrintBinder (ObjectBinder bs) = "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"
+prettyPrintBinder (ArrayBinder bs rest) = "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ maybe "" (("; " ++) . prettyPrintBinder) rest ++ " ]"
+prettyPrintBinder (NamedBinder ident binder) = show ident ++ "@" ++ prettyPrintBinder binder
+prettyPrintBinder (GuardedBinder cond binder) = prettyPrintBinder binder ++ " | " ++ prettyPrintValue cond
 
 prettyPrintObjectPropertyBinder :: String -> Binder -> String
 prettyPrintObjectPropertyBinder key binder = key ++ ": " ++ prettyPrintBinder binder
@@ -195,7 +179,6 @@ prettyPrintStatement (ForEach ident arr sts) = "foreach " ++ show ident
   ++ " in " ++ prettyPrintValue arr ++ ": {"
   ++ intercalate "; " (map prettyPrintStatement sts) ++ " }"
 prettyPrintStatement (If ifst) = prettyPrintIfStatement ifst
-prettyPrintStatement (ValueStatement val) = prettyPrintValue val
 prettyPrintStatement (Return value) = "return " ++ prettyPrintValue value
 
 prettyPrintIfStatement :: IfStatement -> String
diff --git a/src/Language/PureScript/Scope.hs b/src/Language/PureScript/Scope.hs
deleted file mode 100644
index 677f79a..0000000
--- a/src/Language/PureScript/Scope.hs
+++ /dev/null
@@ -1,75 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Language.PureScript.Scope
--- Copyright   :  (c) Phil Freeman 2013
--- License     :  MIT
---
--- Maintainer  :  Phil Freeman <paf31@cantab.net>
--- Stability   :  experimental
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Language.PureScript.Scope (
-    usedNames,
-    unusedNames,
-    firstUnusedName
-) where
-
-import Data.Data
-import Data.List ((\\), nub)
-import Data.Generics (extQ, mkQ, everything)
-
-import Language.PureScript.Values
-import Language.PureScript.Names
-import Language.PureScript.CodeGen.JS.AST
-import Data.Maybe (mapMaybe)
-
-usedNames :: (Data d) => d -> [Ident]
-usedNames val = nub $ everything (++) (mkQ [] namesV `extQ` namesS `extQ` namesB `extQ` namesJS) val
-  where
-  namesV :: Value -> [Ident]
-  namesV (Abs args _) = args
-  namesV (Var (Qualified (ModulePath []) name)) = [name]
-  namesV _ = []
-  namesS :: Statement -> [Ident]
-  namesS (VariableIntroduction name _) = [name]
-  namesS (For name _ _ _) = [name]
-  namesS _ = []
-  namesB :: Binder -> [Ident]
-  namesB (VarBinder name) = [name]
-  namesB _ = []
-  namesJS :: JS -> [Ident]
-  namesJS (JSVar name) = [name]
-  namesJS (JSFunction (Just name) args _) = name : args
-  namesJS (JSFunction Nothing args _) = args
-  namesJS (JSVariableIntroduction name _) = [name]
-  namesJS (JSFor name _ _ _) = [name]
-  namesJS _ = []
-
-unusedNames :: (Data d) => d -> [Ident]
-unusedNames val =
-  let
-    allNames = usedNames val
-    varNames = map (Ident . ('_' :) . show) ([1..] :: [Int])
-  in
-    varNames \\ allNames
-
-firstUnusedName :: (Data d) => d -> Int
-firstUnusedName val =
-  let
-    allNames = usedNames val
-    varNames = mapMaybe toUnknown allNames
-  in
-    1 + maximum (0 : varNames)
-  where
-  toUnknown :: Ident -> Maybe Int
-  toUnknown (Ident ('_' : s)) = readMaybe s
-  toUnknown _ = Nothing
-
-readMaybe :: String -> Maybe Int
-readMaybe s = case reads s of
-                [(n, "")] -> Just n
-                _ -> Nothing
diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs
index 85b48df..eff76f7 100644
--- a/src/Language/PureScript/TypeChecker.hs
+++ b/src/Language/PureScript/TypeChecker.hs
@@ -24,7 +24,9 @@ import Language.PureScript.TypeChecker.Kinds as T
 import Language.PureScript.TypeChecker.Types as T
 import Language.PureScript.TypeChecker.Synonyms as T
 
+import Data.List
 import Data.Maybe
+import Data.Function
 import qualified Data.Map as M
 
 import Language.PureScript.Values
@@ -33,6 +35,7 @@ import Language.PureScript.Names
 import Language.PureScript.Kinds
 import Language.PureScript.Declarations
 
+import Control.Monad (forM_)
 import Control.Monad.State
 import Control.Monad.Error
 
@@ -63,20 +66,19 @@ typeCheckAll (TypeSynonymDeclaration name args ty : rest) = do
     putEnv $ env { types = M.insert (modulePath, name) (kind, TypeSynonym) (types env)
                  , typeSynonyms = M.insert (modulePath, name) (args, ty) (typeSynonyms env) }
   typeCheckAll rest
-typeCheckAll (TypeDeclaration name ty : ValueDeclaration name' [] Nothing val : rest) | name == name' =
-  typeCheckAll (ValueDeclaration name [] Nothing (TypedValue val ty) : rest)
+typeCheckAll (TypeDeclaration name ty : ValueDeclaration name' val : rest) | name == name' =
+  typeCheckAll (ValueDeclaration name (TypedValue val ty) : rest)
 typeCheckAll (TypeDeclaration name _ : _) = throwError $ "Orphan type declaration for " ++ show name
-typeCheckAll (ValueDeclaration name [] Nothing val : rest) = do
+typeCheckAll (ValueDeclaration name val : rest) = do
   rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do
     env <- getEnv
     modulePath <- checkModulePath `fmap` get
     case M.lookup (modulePath, name) (names env) of
-      Just _ -> throwError $ show name ++ " is already defined"
+      Just ty -> throwError $ show name ++ " is already defined"
       Nothing -> do
         ty <- typeOf (Just name) val
         putEnv (env { names = M.insert (modulePath, name) (ty, Value) (names env) })
   typeCheckAll rest
-typeCheckAll (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
 typeCheckAll (ExternDataDeclaration name kind : rest) = do
   env <- getEnv
   modulePath <- checkModulePath `fmap` get
@@ -99,7 +101,7 @@ typeCheckAll (ExternMemberDeclaration member name ty : rest) = do
   typeCheckAll rest
   where
     isSingleArgumentFunction (Function [_] _) = True
-    isSingleArgumentFunction (ForAll _ t) = isSingleArgumentFunction t
+    isSingleArgumentFunction (ForAll _ ty) = isSingleArgumentFunction ty
     isSingleArgumentFunction _ = False
 typeCheckAll (ExternDeclaration name ty : rest) = do
   rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do
@@ -126,13 +128,13 @@ typeCheckAll (ImportDeclaration modulePath idents : rest) = do
     guardWith ("Module " ++ show modulePath ++ " does not exist") $ moduleExists env
     case idents of
       Nothing     -> bindIdents (map snd $ filterModule env) currentModule env
-      Just idents' -> bindIdents idents' currentModule env
+      Just idents -> bindIdents idents currentModule env
   typeCheckAll rest
  where errorMessage = (("Error in import declaration " ++ show modulePath ++ ":\n") ++)
        filterModule = filter ((== modulePath) . fst) . M.keys . names
        moduleExists env = not $ null $ filterModule env
-       bindIdents idents' currentModule env =
-         forM_ idents' $ \ident -> do
+       bindIdents idents currentModule env =
+         forM_ idents $ \ident -> do
            guardWith (show currentModule ++ "." ++ show ident ++ " is already defined") $ (currentModule, ident) `M.notMember` names env
            case (modulePath, ident) `M.lookup` names env of
              Just (pt, _) -> modifyEnv (\e -> e { names = M.insert (currentModule, ident) (pt, Alias modulePath ident) (names e) })
diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs
index ed64cc5..94f4600 100644
--- a/src/Language/PureScript/TypeChecker/Kinds.hs
+++ b/src/Language/PureScript/TypeChecker/Kinds.hs
@@ -19,9 +19,15 @@ module Language.PureScript.TypeChecker.Kinds (
     kindOf
 ) where
 
+import Data.List
+import Data.Maybe (fromMaybe)
+import Data.Function
+import Data.Data
+
 import Language.PureScript.Types
 import Language.PureScript.Kinds
 import Language.PureScript.Names
+import Language.PureScript.Declarations
 import Language.PureScript.TypeChecker.Monad
 import Language.PureScript.Pretty
 import Language.PureScript.Unknown
@@ -30,6 +36,8 @@ import Control.Monad.State
 import Control.Monad.Error
 
 import Control.Applicative
+import Control.Arrow (Kleisli(..), (***))
+import qualified Control.Category as C
 
 import qualified Data.Map as M
 
@@ -70,10 +78,10 @@ starIfUnknown (KUnknown _) = Star
 starIfUnknown (FunKind k1 k2) = FunKind (starIfUnknown k1) (starIfUnknown k2)
 starIfUnknown k = k
 
-inferAll :: Maybe (ProperName, Kind) -> M.Map String Kind -> [Type] -> Subst [Kind]
+inferAll :: Maybe (ProperName, Kind) -> M.Map String Kind -> [Type] -> Subst Check [Kind]
 inferAll name m = mapM (infer name m)
 
-infer :: Maybe (ProperName, Kind) -> M.Map String Kind -> Type -> Subst Kind
+infer :: Maybe (ProperName, Kind) -> M.Map String Kind -> Type -> Subst Check Kind
 infer name m (Array t) = do
   k <- infer name m t
   k ~~ Star
@@ -86,16 +94,16 @@ infer name m (Function args ret) = do
   ks <- inferAll name m args
   k <- infer name m ret
   k ~~ Star
-  forM ks (~~ Star)
+  forM ks $ \k -> k ~~ Star
   return Star
 infer _ m (TypeVar v) =
   case M.lookup v m of
     Just k -> return k
     Nothing -> throwError $ "Unbound type variable " ++ v
-infer (Just (name, k)) _ (TypeConstructor (Qualified (ModulePath []) pn)) | name == pn = return k
-infer _ _ (TypeConstructor v) = do
-  env <- liftCheck getEnv
-  modulePath <- checkModulePath `fmap` get
+infer (Just (name, k)) m c@(TypeConstructor v@(Qualified (ModulePath []) pn)) | name == pn = return k
+infer name m (TypeConstructor v) = do
+  env <- lift getEnv
+  modulePath <- checkModulePath `fmap` lift get
   case M.lookup (qualify modulePath v) (types env) of
     Nothing -> throwError $ "Unknown type constructor '" ++ show v ++ "'"
     Just (kind, _) -> return kind
@@ -108,18 +116,17 @@ infer name m (TypeApp t1 t2) = do
 infer name m (ForAll ident ty) = do
   k <- fresh
   infer name (M.insert ident k m) ty
-infer _ _ _ = return Star
+infer _ m t = return Star
 
-inferRow :: Maybe (ProperName, Kind) -> M.Map String Kind -> Row -> Subst Kind
+inferRow :: Maybe (ProperName, Kind) -> M.Map String Kind -> Row -> Subst Check Kind
 inferRow _ m (RowVar v) = do
   case M.lookup v m of
     Just k -> return k
     Nothing -> throwError $ "Unbound row variable " ++ v
-inferRow _ _ REmpty = return Row
-inferRow name m (RCons _ ty row) = do
+inferRow _ m r@REmpty = return Row
+inferRow name m r@(RCons _ ty row) = do
   k1 <- infer name m ty
   k2 <- inferRow name m row
   k1 ~~ Star
   k2 ~~ Row
   return Row
-inferRow _ _ _ = error "Invalid row in inferRow"
diff --git a/src/Language/PureScript/TypeChecker/Monad.hs b/src/Language/PureScript/TypeChecker/Monad.hs
index 6f9edfa..213708b 100644
--- a/src/Language/PureScript/TypeChecker/Monad.hs
+++ b/src/Language/PureScript/TypeChecker/Monad.hs
@@ -25,13 +25,16 @@ import Language.PureScript.Unknown
 import Data.Data
 import Data.Maybe
 import Data.Monoid
+import Data.Typeable
 import Control.Applicative
 import Control.Monad.State
 import Control.Monad.Error
 
+import Control.Arrow ((***), first, second)
+
 import qualified Data.Map as M
 
-data NameKind = Value | Extern | Alias ModulePath Ident | LocalVariable deriving Show
+data NameKind = Value | Extern | Alias ModulePath Ident deriving Show
 
 data TypeDeclarationKind = Data | ExternData | TypeSynonym deriving Show
 
@@ -46,28 +49,6 @@ data Environment = Environment
 emptyEnvironment :: Environment
 emptyEnvironment = Environment M.empty M.empty M.empty M.empty M.empty
 
-bindNames :: (MonadState CheckState m) => M.Map (ModulePath, Ident) (Type, NameKind) -> m a -> m a
-bindNames newNames action = do
-  orig <-  get
-  modify $ \st -> st { checkEnv = (checkEnv st) { names = newNames `M.union` (names . checkEnv $ st) } }
-  a <- action
-  modify $ \st -> st { checkEnv = (checkEnv st) { names = names . checkEnv $ orig } }
-  return a
-
-bindLocalVariables :: (Functor m, MonadState CheckState m) => [(Ident, Type)] -> m a -> m a
-bindLocalVariables bindings action = do
-  modulePath <- checkModulePath `fmap` get
-  bindNames (M.fromList $ flip map bindings $ \(name, ty) -> ((modulePath, name), (ty, LocalVariable))) action
-
-lookupVariable :: (Functor m, MonadState CheckState m, MonadError String m) => Qualified Ident -> m Type
-lookupVariable var = do
-  env <- getEnv
-  modulePath <- checkModulePath <$> get
-  let tries = map (First . flip M.lookup (names env)) (nameResolution modulePath var)
-  case getFirst (mconcat tries) of
-    Nothing -> throwError $ show var ++ " is undefined"
-    Just (ty, _) -> return ty
-
 data AnyUnifiable where
   AnyUnifiable :: forall t. (Unifiable t) => t -> AnyUnifiable
 
@@ -79,13 +60,13 @@ data CheckState = CheckState { checkEnv :: Environment
 newtype Check a = Check { unCheck :: StateT CheckState (Either String) a }
   deriving (Functor, Monad, Applicative, MonadPlus, MonadState CheckState, MonadError String)
 
-getEnv :: (Functor m, MonadState CheckState m) => m Environment
-getEnv = checkEnv <$> get
+getEnv :: Check Environment
+getEnv = fmap checkEnv get
 
-putEnv :: (MonadState CheckState m) => Environment -> m ()
+putEnv :: Environment -> Check ()
 putEnv env = modify (\s -> s { checkEnv = env })
 
-modifyEnv :: (MonadState CheckState m) => (Environment -> Environment) -> m ()
+modifyEnv :: (Environment -> Environment) -> Check ()
 modifyEnv f = modify (\s -> s { checkEnv = f (checkEnv s) })
 
 runCheck :: Check a -> Either String (a, Environment)
@@ -117,19 +98,12 @@ instance Monoid Substitution where
 data SubstState = SubstState { substSubst :: Substitution
                              , substFutureEscapeChecks :: [AnyUnifiable] }
 
-newtype Subst a = Subst { unSubst :: StateT SubstState Check a }
-  deriving (Functor, Monad, Applicative, MonadPlus)
-
-instance MonadState CheckState Subst where
-  get = Subst . lift $ get
-  put = Subst . lift . put
-
-deriving instance MonadError String Subst
+newtype Subst m a = Subst { unSubst :: StateT SubstState m a }
+  deriving (Functor, Monad, Applicative, MonadPlus, MonadTrans)
 
-liftCheck :: Check a -> Subst a
-liftCheck = Subst . lift
+deriving instance (MonadError String m) => MonadError String (Subst m)
 
-runSubst :: (Unifiable a) => Subst a -> Check (a, Substitution, [AnyUnifiable])
+runSubst :: (Unifiable a, Monad m) => Subst m a -> m (a, Substitution, [AnyUnifiable])
 runSubst subst = do
   (a, s) <- flip runStateT (SubstState mempty []) . unSubst $ subst
   return (apply (substSubst s) a, substSubst s, substFutureEscapeChecks s)
@@ -145,7 +119,7 @@ substituteOne u t = substituteWith $ \u1 ->
     u2 | u2 == u -> t
        | otherwise -> unknown u2
 
-replace :: (Unifiable t) => Unknown t -> t -> Subst ()
+replace :: (Unifiable t) => Unknown t -> t -> Subst Check ()
 replace u t' = do
   sub <- substSubst <$> Subst get
   let t = apply sub t'
@@ -158,25 +132,25 @@ replace u t' = do
 
 class (Typeable t, Data t, Show t) => Unifiable t where
   unknown :: Unknown t -> t
-  (~~) :: t -> t -> Subst ()
+  (~~) :: t -> t -> Subst Check ()
   isUnknown :: t -> Maybe (Unknown t)
   apply :: Substitution -> t -> t
   unknowns :: t -> [Int]
 
-occursCheck :: (Unifiable t) => Unknown s -> t -> Subst ()
+occursCheck :: (Unifiable t) => Unknown s -> t -> Subst Check ()
 occursCheck (Unknown u) t =
   case isUnknown t of
     Nothing -> guardWith "Occurs check fails" (u `notElem` unknowns t)
     _ -> return ()
 
-fresh' :: Subst Int
+fresh' :: Subst Check Int
 fresh' = do
-  n <- checkNextVar <$> get
-  modify $ \s -> s { checkNextVar = succ (checkNextVar s) }
+  n <- lift $ checkNextVar <$> get
+  lift . modify $ \s -> s { checkNextVar = succ (checkNextVar s) }
   return n
 
-fresh :: (Unifiable t) => Subst t
+fresh :: (Unifiable t) => Subst Check t
 fresh = unknown . Unknown <$> fresh'
 
-escapeCheckLater :: (Unifiable t) => t -> Subst ()
+escapeCheckLater :: (Unifiable t) => t -> Subst Check ()
 escapeCheckLater t = Subst . modify $ \s -> s { substFutureEscapeChecks = AnyUnifiable t : substFutureEscapeChecks s  }
diff --git a/src/Language/PureScript/TypeChecker/Synonyms.hs b/src/Language/PureScript/TypeChecker/Synonyms.hs
index d480e4a..0c990b7 100644
--- a/src/Language/PureScript/TypeChecker/Synonyms.hs
+++ b/src/Language/PureScript/TypeChecker/Synonyms.hs
@@ -18,22 +18,25 @@ module Language.PureScript.TypeChecker.Synonyms (
 ) where
 
 import Language.PureScript.Types
+import Language.PureScript.Declarations
 import Language.PureScript.Names
 
 import Data.Maybe (fromMaybe)
 import Data.Data
 import Data.Generics
 import Data.Generics.Extras
+import Control.Arrow
 import Control.Monad.Writer
 import Control.Monad.Error
+import qualified Data.Map as M
 
 buildTypeSubstitution :: Qualified ProperName -> Int -> Type -> Either String (Maybe Type)
 buildTypeSubstitution name n = go n []
   where
   go :: Int -> [Type] -> Type -> Either String (Maybe Type)
   go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)
-  go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ "Partially applied type synonym " ++ show name
-  go m args (TypeApp f arg) = go (m - 1) (arg:args) f
+  go n _ (TypeConstructor ctor) | n > 0 && name == ctor = throwError $ "Partially applied type synonym " ++ show name
+  go n args (TypeApp f arg) = go (n - 1) (arg:args) f
   go _ _ _ = return Nothing
 
 saturateTypeSynonym :: (Data d) => Qualified ProperName -> Int -> d -> Either String d
@@ -42,7 +45,7 @@ saturateTypeSynonym name n = everywhereM' (mkM replace)
   replace t = fmap (fromMaybe t) $ buildTypeSubstitution name n t
 
 saturateAllTypeSynonyms :: (Data d) => [(Qualified ProperName, Int)] -> d -> Either String d
-saturateAllTypeSynonyms syns d = foldM (\result (name, n) -> saturateTypeSynonym name n result) d syns
+saturateAllTypeSynonyms syns d = foldM (\d (name, n) -> saturateTypeSynonym name n d) d syns
 
 
 
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index c48804b..02ba0c3 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -12,17 +12,19 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 
 module Language.PureScript.TypeChecker.Types (
     typeOf
 ) where
 
 import Data.List
-import Data.Maybe (fromMaybe)
+import Data.Maybe (isJust, fromMaybe)
+import Data.Function
 import qualified Data.Data as D
 import Data.Generics
-       (mkT, something, everywhere, everywhereBut, mkQ, extQ)
+       (something, everywhere, everywhereM, everything, everywhereBut,
+        mkT, mkM, mkQ, extM, extQ)
 
 import Language.PureScript.Values
 import Language.PureScript.Types
@@ -38,7 +40,8 @@ import Control.Monad.State
 import Control.Monad.Error
 
 import Control.Applicative
-import Control.Arrow (Arrow(..))
+import Control.Arrow (Arrow(..), Kleisli(..), (***), (&&&), second)
+import qualified Control.Category as C
 
 import qualified Data.Map as M
 
@@ -57,7 +60,7 @@ instance Unifiable Type where
   apply _ t = t
   unknowns (TUnknown (Unknown u)) = [u]
   unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys
-  unknowns (ForAll _ ty) = unknowns ty
+  unknowns (ForAll idents ty) = unknowns ty
   unknowns (Array t) = unknowns t
   unknowns (Object r) = unknowns r
   unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret
@@ -79,19 +82,19 @@ instance Unifiable Row where
         forM_ int (uncurry (~~))
         unifyRows sd1 r1' sd2 r2'
       where
-      unifyRows :: [(String, Type)] -> Row -> [(String, Type)] -> Row -> Subst ()
+      unifyRows :: [(String, Type)] -> Row -> [(String, Type)] -> Row -> Subst Check ()
       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
+      unifyRows ns@((name, ty):row) r others u@(RUnknown un) = do
         occursCheck un ty
-        forM row $ \(_, t) -> occursCheck un t
+        forM row $ \(_, ty) -> occursCheck un ty
         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)) ++ "."
+      unifyRows sd1 r1 sd2 r2 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd1, r1)) ++ " with " ++ prettyPrintRow (rowFromList (sd2, r2)) ++ "."
   apply s (RUnknown u) = runSubstitution s u
   apply s (RCons name ty r) = RCons name (apply s ty) (apply s r)
   apply _ r = r
@@ -99,7 +102,7 @@ instance Unifiable Row where
   unknowns (RCons _ ty r) = unknowns ty ++ unknowns r
   unknowns _ = []
 
-unifyTypes :: Type -> Type -> Subst ()
+unifyTypes :: Type -> Type -> Subst Check ()
 unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 ++ " with type " ++ prettyPrintType t2 ++ ":\n" ++ e) $ do
   unifyTypes' t1 t2
   where
@@ -114,7 +117,7 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +
   unifyTypes' ty s@(SaturatedTypeSynonym _ _) = s `unifyTypes` ty
   unifyTypes' (ForAll ident1 ty1) (ForAll ident2 ty2) = do
     sk <- skolemize ident1 ty1
-    replaced <- replaceVarWithUnknown ident2 ty2
+    replaced <- replaceVarsWithUnknowns [ident2] ty2
     sk `unifyTypes` replaced
   unifyTypes' (ForAll ident ty1) ty2 = do
     sk <- skolemize ident ty1
@@ -131,13 +134,13 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +
     ret1 `unifyTypes` ret2
   unifyTypes' (TypeVar v1) (TypeVar v2) | v1 == v2 = return ()
   unifyTypes' (TypeConstructor c1) (TypeConstructor c2) = do
-    modulePath <- checkModulePath `fmap` get
+    modulePath <- checkModulePath `fmap` lift get
     guardWith ("Cannot unify " ++ show c1 ++ " with " ++ show c2 ++ ".") (qualify modulePath c1 == qualify modulePath c2)
-  unifyTypes' (TypeApp t3 t4) (TypeApp t5 t6) = do
-    t3 `unifyTypes` t5
-    t4 `unifyTypes` t6
+  unifyTypes' (TypeApp t1 t2) (TypeApp t3 t4) = do
+    t1 `unifyTypes` t3
+    t2 `unifyTypes` t4
   unifyTypes' (Skolem s1) (Skolem s2) | s1 == s2 = return ()
-  unifyTypes' t3 t4 = throwError $ "Cannot unify " ++ prettyPrintType t3 ++ " with " ++ prettyPrintType t4 ++ "."
+  unifyTypes' t1 t2 = throwError $ "Cannot unify " ++ prettyPrintType t1 ++ " with " ++ prettyPrintType t2 ++ "."
 
 isFunction :: Value -> Bool
 isFunction (Abs _ _) = True
@@ -149,20 +152,18 @@ typeOf name val = do
   (ty, sub, checks) <- runSubst $ case name of
         Just ident | isFunction val ->
           case val of
-            TypedValue value ty -> do
-              kind <- liftCheck $ kindOf ty
+            TypedValue val ty -> do
+              kind <- lift $ kindOf ty
               guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
-              ty' <- replaceAllTypeSynonyms ty
-              modulePath <- checkModulePath <$> get
-              bindNames (M.singleton (modulePath, ident) (ty, LocalVariable)) $ check value ty'
+              ty' <- lift $ replaceAllTypeSynonyms ty
+              check (M.singleton ident ty) val ty'
               return ty'
             _ -> do
               me <- fresh
-              modulePath <- checkModulePath <$> get
-              ty <- bindNames (M.singleton (modulePath, ident) (me, LocalVariable)) $ infer val
+              ty <- infer (M.singleton ident me) val
               ty ~~ me
               return ty
-        _ -> infer val
+        _ -> infer M.empty val
   escapeCheck checks ty sub
   skolemEscapeCheck ty
   return $ varIfUnknown $ desaturateAllTypeSynonyms $ setifyAll ty
@@ -172,7 +173,7 @@ escapeCheck checks ty sub =
   let
     visibleUnknowns = nub $ unknowns ty
   in
-    forM_ checks $ \c -> case c of
+    forM_ checks $ \check -> case check of
       AnyUnifiable t -> do
         let unsolvedUnknowns = nub . unknowns $ apply sub t
         guardWith "Escape check fails" $ null $ unsolvedUnknowns \\ visibleUnknowns
@@ -195,109 +196,121 @@ setifyAll :: (D.Data d) => d -> d
 setifyAll = everywhere (mkT setify)
 
 varIfUnknown :: Type -> Type
-varIfUnknown ty =
-  let unks = nub $ unknowns ty
-      toName = (:) 't' . show
-      ty' = everywhere (mkT rowToVar) . 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'
+varIfUnknown ty = mkForAll (sort . map ((:) 'u' . show) . nub $ unknowns ty) ty
 
 replaceAllTypeVars :: (D.Data d) => [(String, Type)] -> d -> d
 replaceAllTypeVars = foldl' (\f (name, ty) -> replaceTypeVars name ty . f) id
 
 replaceTypeVars :: (D.Data d) => String -> Type -> d -> d
-replaceTypeVars name t = everywhereBut (mkQ False isShadowed) (mkT replaceTypeVar)
+replaceTypeVars name t = everywhereBut (mkQ False isShadowed) (mkT replace)
   where
-  replaceTypeVar (TypeVar v) | v == name = t
-  replaceTypeVar other = other
+  replace (TypeVar v) | v == name = t
+  replace t = t
   isShadowed (ForAll v _) | v == name = True
   isShadowed _ = False
 
 replaceRowVars :: (D.Data d) => String -> Row -> d -> d
-replaceRowVars name r = everywhere (mkT replaceRowVar)
+replaceRowVars name r = everywhere (mkT replace)
   where
-  replaceRowVar (RowVar v) | v == name = r
-  replaceRowVar other = other
+  replace (RowVar v) | v == name = r
+  replace t = t
 
-replaceAllVarsWithUnknowns :: Type -> Subst Type
-replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarWithUnknown ident ty >>= replaceAllVarsWithUnknowns
+replaceAllVarsWithUnknowns :: Type -> Subst Check Type
+replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarsWithUnknowns [ident] ty >>= replaceAllVarsWithUnknowns
 replaceAllVarsWithUnknowns ty = return ty
 
-replaceVarWithUnknown :: String -> Type -> Subst Type
-replaceVarWithUnknown ident ty = do
-  tu <- fresh
-  ru <- fresh
-  return $ replaceRowVars ident ru . replaceTypeVars ident tu $ ty
+replaceVarsWithUnknowns :: [String] -> Type -> Subst Check Type
+replaceVarsWithUnknowns idents = flip evalStateT M.empty . everywhereM (flip extM f $ mkM g)
+  where
+  f :: Type -> StateT (M.Map String Int) (Subst Check) Type
+  f (TypeVar var) | var `elem` idents = do
+    m <- get
+    n <- lift fresh'
+    case M.lookup var m of
+      Nothing -> do
+        put (M.insert var n m)
+        return $ TUnknown (Unknown n)
+      Just u -> return $ TUnknown (Unknown u)
+  f t = return t
+  g :: Row -> StateT (M.Map String Int) (Subst Check) Row
+  g (RowVar var) | var `elem` idents = do
+    m <- get
+    n <- lift fresh'
+    case M.lookup var m of
+      Nothing -> do
+        put (M.insert var n m)
+        return $ RUnknown (Unknown n)
+      Just u -> return $ RUnknown (Unknown u)
+  g r = return r
 
-replaceAllTypeSynonyms :: (Functor m, MonadState CheckState m, MonadError String m) => (D.Data d) => d -> m d
+replaceAllTypeSynonyms :: (D.Data d) => d -> Check d
 replaceAllTypeSynonyms d = do
   env <- getEnv
   let syns = map (\((path, name), (args, _)) -> (Qualified path name, length args)) . M.toList $ typeSynonyms env
   either throwError return $ saturateAllTypeSynonyms syns d
 
 desaturateAllTypeSynonyms :: (D.Data d) => d -> d
-desaturateAllTypeSynonyms = everywhere (mkT replaceSaturatedTypeSynonym)
+desaturateAllTypeSynonyms = everywhere (mkT replace)
   where
-  replaceSaturatedTypeSynonym (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args
-  replaceSaturatedTypeSynonym t = t
+  replace (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args
+  replace t = t
+
+expandAllTypeSynonyms :: Type -> Subst Check Type
+expandAllTypeSynonyms (SaturatedTypeSynonym name args) = expandTypeSynonym name args >>= expandAllTypeSynonyms
+expandAllTypeSynonyms ty = return ty
 
-expandTypeSynonym :: Qualified ProperName -> [Type] -> Subst Type
+expandTypeSynonym :: Qualified ProperName -> [Type] -> Subst Check Type
 expandTypeSynonym name args = do
-  env <- getEnv
-  modulePath <- checkModulePath `fmap` get
+  env <- lift getEnv
+  modulePath <- checkModulePath `fmap` lift get
   case M.lookup (qualify modulePath name) (typeSynonyms env) of
     Just (synArgs, body) -> return $ replaceAllTypeVars (zip synArgs args) body
     Nothing -> error "Type synonym was not defined"
 
-ensureNoDuplicateProperties :: (MonadError String m) => [(String, Value)] -> m ()
+ensureNoDuplicateProperties :: [(String, Value)] -> Check ()
 ensureNoDuplicateProperties ps = guardWith "Duplicate property names" $ length (nub . map fst $ ps) == length ps
 
-infer :: Value -> Subst Type
-infer val = rethrow (\e -> "Error inferring type of term " ++ prettyPrintValue val ++ ":\n" ++ e) $ do
-  ty <- infer' val
+infer :: M.Map Ident Type -> Value -> Subst Check Type
+infer m val = rethrow (\e -> "Error inferring type of term " ++ prettyPrintValue val ++ ":\n" ++ e) $ do
+  ty <- infer' m val
   escapeCheckLater ty
   return ty
 
-infer' :: Value -> Subst Type
-infer' (NumericLiteral _) = return Number
-infer' (StringLiteral _) = return String
-infer' (BooleanLiteral _) = return Boolean
-infer' (ArrayLiteral vals) = do
-  ts <- mapM (infer) vals
-  els <- fresh
-  forM_ ts $ \t -> els ~~ Array t
-  return els
-infer' (Unary op val) = do
-  t <- infer val
+infer' _ (NumericLiteral _) = return Number
+infer' _ (StringLiteral _) = return String
+infer' _ (BooleanLiteral _) = return Boolean
+infer' m (ArrayLiteral vals) = do
+  ts <- mapM (infer m) vals
+  arr <- fresh
+  forM_ ts $ \t -> arr ~~ Array t
+  return arr
+infer' m (Unary op val) = do
+  t <- infer m val
   inferUnary op t
-infer' (Binary op left right) = do
-  t1 <- infer left
-  t2 <- infer right
+infer' m (Binary op left right) = do
+  t1 <- infer m left
+  t2 <- infer m right
   inferBinary op t1 t2
-infer' (ObjectLiteral ps) = do
-  ensureNoDuplicateProperties ps
-  ts <- mapM (infer . snd) ps
+infer' m (ObjectLiteral ps) = do
+  lift $ ensureNoDuplicateProperties ps
+  ts <- mapM (infer m . snd) ps
   let fields = zipWith (\(name, _) t -> (name, t)) ps ts
-  return $ Object $ rowFromList (fields, REmpty)
-infer' (ObjectUpdate o ps) = do
-  ensureNoDuplicateProperties ps
+  return $ Object $ typesToRow fields
+infer' m (ObjectUpdate o ps) = do
+  lift $ ensureNoDuplicateProperties ps
+  obj <- infer m o
   row <- fresh
-  newTys <- zipWith (\(name, _) t -> (name, t)) ps <$> mapM (infer . snd) ps
-  oldTys <- zip (map fst ps) <$> replicateM (length ps) fresh
-  check o $ Object $ rowFromList (oldTys, row)
-  return $ Object $ rowFromList (newTys, row)
-infer' (Indexer index val) = do
+  ts <- mapM (infer m . snd) ps
+  let tys = zipWith (\(name, _) t -> (name, t)) ps ts
+  obj ~~ Object (rowFromList (tys, row))
+  return obj
+infer' m (Indexer index val) = do
   el <- fresh
-  check index Number
-  check val (Array el)
+  check m index Number
+  check m val (Array el)
   return el
-infer' (Accessor prop val) = do
-  obj <- infer val
+infer' m (Accessor prop val) = do
+  obj <- infer m val
   propTy <- inferProperty obj prop
   case propTy of
     Nothing -> do
@@ -306,51 +319,61 @@ infer' (Accessor prop val) = do
       obj `subsumes` Object (RCons prop field rest)
       return field
     Just ty -> return ty
-infer' (Abs args ret) = do
+infer' m (Abs args ret) = do
   ts <- replicateM (length args) fresh
-  bindLocalVariables (zip args ts) $ do
-    body <- infer' ret
-    return $ Function ts body
-infer' app@(App _ _) = do
+  let m' = m `M.union` M.fromList (zip args ts)
+  body <- infer m' ret
+  return $ Function ts body
+infer' m app@(App _ _) = do
   let (f, argss) = unfoldApplication app
-  ft <- infer f
+  ft <- infer m f
   ret <- fresh
-  checkFunctionApplications ft argss ret
+  checkFunctionApplications m ft argss ret
   return ret
-infer' (Var var) = do
-  ty <- lookupVariable var
-  replaceAllTypeSynonyms ty
-infer' (Block ss) = do
+infer' m (Var var@(Qualified mp name)) = do
+  case mp of
+    ModulePath [] ->
+      case M.lookup name m of
+        Just ty -> lift $ replaceAllTypeSynonyms ty
+        Nothing -> lookupGlobal
+    _ -> lookupGlobal
+  where
+  lookupGlobal = do
+    env <- lift getEnv
+    modulePath <- checkModulePath `fmap` lift get
+    case M.lookup (qualify modulePath var) (names env) of
+      Nothing -> throwError $ show var ++ " is undefined"
+      Just (ty, _) -> lift $ replaceAllTypeSynonyms ty
+infer' m (Block ss) = do
   ret <- fresh
-  (allCodePathsReturn, _) <- checkBlock M.empty ret ss
+  (allCodePathsReturn, _) <- checkBlock m M.empty ret ss
   guardWith "Block is missing a return statement" allCodePathsReturn
   return ret
-infer' (Constructor c) = do
-  env <- getEnv
-  modulePath <- checkModulePath `fmap` get
+infer' m (Constructor c) = do
+  env <- lift getEnv
+  modulePath <- checkModulePath `fmap` lift get
   case M.lookup (qualify modulePath c) (dataConstructors env) of
     Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"
-    Just ty -> replaceAllTypeSynonyms ty
-infer' (Case vals binders) = do
-  ts <- mapM infer vals
+    Just ty -> lift $ replaceAllTypeSynonyms ty
+infer' m (Case val binders) = do
+  t1 <- infer m val
   ret <- fresh
-  checkBinders ts ret binders
+  checkBinders m t1 ret binders
   return ret
-infer' (IfThenElse cond th el) = do
-  check cond Boolean
-  t2 <- infer th
-  t3 <- infer el
+infer' m (IfThenElse cond th el) = do
+  check m cond Boolean
+  t2 <- infer m th
+  t3 <- infer m el
   t2 ~~ t3
   return t2
-infer' (TypedValue val ty) = do
-  kind <- liftCheck $ kindOf ty
+infer' m (TypedValue val ty) = do
+  kind <- lift $ kindOf ty
   guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
-  ty' <- replaceAllTypeSynonyms ty
-  check val ty'
+  ty' <- lift $ replaceAllTypeSynonyms ty
+  check m val ty'
   return ty'
-infer' _ = error "Invalid argument to infer"
 
-inferProperty :: Type -> String -> Subst (Maybe Type)
+inferProperty :: Type -> String -> Subst Check (Maybe Type)
 inferProperty (Object row) prop = do
   let (props, _) = rowToList row
   return $ lookup prop props
@@ -358,23 +381,23 @@ inferProperty (SaturatedTypeSynonym name args) prop = do
   replaced <- expandTypeSynonym name args
   inferProperty replaced prop
 inferProperty (ForAll ident ty) prop = do
-  replaced <- replaceVarWithUnknown ident ty
+  replaced <- replaceVarsWithUnknowns [ident] ty
   inferProperty replaced prop
-inferProperty _ _ = return Nothing
+inferProperty _ prop = return Nothing
 
-inferUnary :: UnaryOperator -> Type -> Subst Type
+inferUnary :: UnaryOperator -> Type -> Subst Check Type
 inferUnary op val =
   case fromMaybe (error "Invalid operator") $ lookup op unaryOps of
     (valTy, resTy) -> do
       val ~~ valTy
       return resTy
 
-checkUnary :: UnaryOperator -> Value -> Type -> Subst ()
-checkUnary op val res =
+checkUnary :: M.Map Ident Type -> UnaryOperator -> Value -> Type -> Subst Check ()
+checkUnary m op val res =
   case fromMaybe (error "Invalid operator") $ lookup op unaryOps of
     (valTy, resTy) -> do
       res ~~ resTy
-      check val valTy
+      check m val valTy
 
 unaryOps :: [(UnaryOperator, (Type, Type))]
 unaryOps = [ (Negate, (Number, Number))
@@ -382,7 +405,7 @@ unaryOps = [ (Negate, (Number, Number))
            , (BitwiseNot, (Number, Number))
            ]
 
-inferBinary :: BinaryOperator -> Type -> Type -> Subst Type
+inferBinary :: BinaryOperator -> Type -> Type -> Subst Check Type
 inferBinary op left right | isEqualityTest op = do
   left ~~ right
   return Boolean
@@ -393,18 +416,18 @@ inferBinary op left right =
       right ~~ valTy
       return resTy
 
-checkBinary :: BinaryOperator -> Value -> Value -> Type -> Subst ()
-checkBinary op left right res | isEqualityTest op = do
+checkBinary :: M.Map Ident Type -> BinaryOperator -> Value -> Value -> Type -> Subst Check ()
+checkBinary m op left right res | isEqualityTest op = do
   res ~~ Boolean
-  t1 <- infer left
-  t2 <- infer right
+  t1 <- infer m left
+  t2 <- infer m right
   t1 ~~ t2
-checkBinary op left right res =
+checkBinary m op left right res =
   case fromMaybe (error "Invalid operator") $ lookup op binaryOps of
     (valTy, resTy) -> do
       res ~~ resTy
-      check left valTy
-      check right valTy
+      check m left valTy
+      check m right valTy
 
 isEqualityTest :: BinaryOperator -> Bool
 isEqualityTest EqualTo = True
@@ -432,31 +455,28 @@ binaryOps = [ (Add, (Number, Number))
             , (GreaterThanOrEqualTo, (Number, Boolean))
             ]
 
-inferBinder :: Type -> Binder -> Subst (M.Map Ident Type)
+inferBinder :: Type -> Binder -> Subst Check (M.Map Ident Type)
 inferBinder _ NullBinder = return M.empty
 inferBinder val (StringBinder _) = val ~~ String >> return M.empty
 inferBinder val (NumberBinder _) = val ~~ Number >> return M.empty
 inferBinder val (BooleanBinder _) = val ~~ Boolean >> return M.empty
 inferBinder val (VarBinder name) = return $ M.singleton name val
 inferBinder val (NullaryBinder ctor) = do
-  env <- getEnv
-  modulePath <- checkModulePath <$> get
+  env <- lift getEnv
+  modulePath <- checkModulePath `fmap` lift get
   case M.lookup (qualify modulePath ctor) (dataConstructors env) of
     Just ty -> do
       ty `subsumes` val
       return M.empty
     _ -> throwError $ "Constructor " ++ show ctor ++ " is not defined"
 inferBinder val (UnaryBinder ctor binder) = do
-  env <- getEnv
-  modulePath <- checkModulePath <$> get
+  env <- lift getEnv
+  modulePath <- checkModulePath `fmap` lift get
   case M.lookup (qualify modulePath ctor) (dataConstructors env) of
     Just ty -> do
-      fn <- replaceAllVarsWithUnknowns ty
-      case fn of
-        Function [obj] ret -> do
-          val `subsumes` ret
-          inferBinder obj binder
-        _ -> throwError $ "Constructor " ++ show ctor ++ " is not a unary constructor"
+      Function [obj] ret <- replaceAllVarsWithUnknowns ty
+      val `subsumes` ret
+      inferBinder obj binder
     _ -> throwError $ "Constructor " ++ show ctor ++ " is not defined"
 inferBinder val (ObjectBinder props) = do
   row <- fresh
@@ -465,117 +485,117 @@ inferBinder val (ObjectBinder props) = do
   val ~~ Object row
   return m1
   where
-  inferRowProperties :: Row -> Row -> [(String, Binder)] -> Subst (M.Map Ident Type)
+  inferRowProperties :: Row -> Row -> [(String, Binder)] -> Subst Check (M.Map Ident Type)
   inferRowProperties nrow row [] = nrow ~~ row >> return M.empty
   inferRowProperties nrow row ((name, binder):binders) = do
     propTy <- fresh
     m1 <- inferBinder propTy binder
     m2 <- inferRowProperties nrow (RCons name propTy row) binders
     return $ m1 `M.union` m2
-inferBinder val (ArrayBinder binders) = do
+inferBinder val (ArrayBinder binders rest) = do
   el <- fresh
   m1 <- M.unions <$> mapM (inferBinder el) binders
   val ~~ Array el
-  return m1
-inferBinder val (ConsBinder headBinder tailBinder) = do
-  el <- fresh
-  m1 <- inferBinder el headBinder
-  m2 <- inferBinder val tailBinder
-  val ~~ Array el
-  return $ m1 `M.union` m2
+  case rest of
+    Nothing -> return m1
+    Just binder -> do
+      m2 <- inferBinder val binder
+      return $ m1 `M.union` m2
 inferBinder val (NamedBinder name binder) = do
   m <- inferBinder val binder
   return $ M.insert name val m
 
-checkBinders :: [Type] -> Type -> [([Binder], Maybe Guard, Value)] -> Subst ()
-checkBinders _ _ [] = return ()
-checkBinders nvals ret ((binders, grd, val):bs) = do
-  m1 <- M.unions <$> zipWithM inferBinder nvals binders
-  bindLocalVariables (M.toList m1) $ do
-    check val ret
-    case grd of
-      Nothing -> return ()
-      Just g -> check g Boolean
-  checkBinders nvals ret bs
-
-assignVariable :: Ident -> Subst ()
-assignVariable name = do
-  env <- checkEnv <$> get
-  modulePath <- checkModulePath <$> get
-  case M.lookup (modulePath, name) (names env) of
-    Just (_, LocalVariable) -> throwError $ "Variable with name " ++ show name ++ " already exists."
-    _ -> return ()
-
-checkStatement :: M.Map Ident Type -> Type -> Statement -> Subst (Bool, M.Map Ident Type)
-checkStatement mass _ (VariableIntroduction name val) = do
-  assignVariable name
-  t <- infer val
+inferGuardedBinder :: M.Map Ident Type -> Type -> Binder -> Subst Check (M.Map Ident Type)
+inferGuardedBinder m val (GuardedBinder cond binder) = do
+  m1 <- inferBinder val binder
+  check (m1 `M.union` m) cond Boolean
+  return m1
+inferGuardedBinder m val b = inferBinder val b
+
+checkBinders :: M.Map Ident Type -> Type -> Type -> [(Binder, Value)] -> Subst Check ()
+checkBinders _ _ _ [] = return ()
+checkBinders m nval ret ((binder, val):bs) = do
+  m1 <- inferGuardedBinder m nval binder
+  check (m1 `M.union` m) val ret
+  checkBinders m nval ret bs
+
+assignVariable :: Ident -> M.Map Ident Type -> Subst Check ()
+assignVariable name m =
+  case M.lookup name m of
+    Nothing -> return ()
+    Just _ -> throwError $ "Variable with name " ++ show name ++ " already exists."
+
+checkStatement :: M.Map Ident Type -> M.Map Ident Type -> Type -> Statement -> Subst Check (Bool, M.Map Ident Type)
+checkStatement m mass ret (VariableIntroduction name val) = do
+  assignVariable name (m `M.union` mass)
+  t <- infer m val
   return (False, M.insert name t mass)
-checkStatement mass _ (Assignment ident val) = do
-  t <- infer val
+checkStatement m mass ret (Assignment ident val) = do
+  t <- infer m val
   case M.lookup ident mass of
     Nothing -> throwError $ "No local variable with name " ++ show ident
     Just ty -> do t ~~ ty
                   return (False, mass)
-checkStatement mass ret (While val inner) = do
-  check val Boolean
-  (allCodePathsReturn, _) <- checkBlock mass ret inner
+checkStatement m mass ret (While val inner) = do
+  check m val Boolean
+  (allCodePathsReturn, _) <- checkBlock m mass ret inner
   return (allCodePathsReturn, mass)
-checkStatement mass ret (If ifst) = do
-  allCodePathsReturn <- checkIfStatement mass ret ifst
+checkStatement m mass ret (If ifst) = do
+  allCodePathsReturn <- checkIfStatement m mass ret ifst
   return (allCodePathsReturn, mass)
-checkStatement mass ret (For ident start end inner) = do
-  assignVariable ident
-  check start Number
-  check end Number
-  (allCodePathsReturn, _) <- bindLocalVariables [(ident, Number)] $ checkBlock mass ret inner
+checkStatement m mass ret (For ident start end inner) = do
+  assignVariable ident (m `M.union` mass)
+  check (m `M.union` mass) start Number
+  check (m `M.union` mass) end Number
+  let mass1 = M.insert ident Number mass
+  (allCodePathsReturn, _) <- checkBlock (m `M.union` mass1) mass1 ret inner
   return (allCodePathsReturn, mass)
-checkStatement mass ret (ForEach ident vals inner) = do
-  assignVariable ident
+checkStatement m mass ret (ForEach ident vals inner) = do
+  assignVariable ident (m `M.union` mass)
   val <- fresh
-  check vals (Array val)
-  (allCodePathsReturn, _) <- bindLocalVariables [(ident, val)] $ checkBlock mass ret inner
+  check (m `M.union` mass) vals (Array val)
+  let mass1 = M.insert ident val mass
+  (allCodePathsReturn, _) <- checkBlock (m `M.union` mass1) mass1 ret inner
   guardWith "Cannot return from within a foreach block" $ not allCodePathsReturn
   return (False, mass)
-checkStatement mass _ (ValueStatement val) = do
-  check val unit
-  return (False, mass)
-checkStatement mass ret (Return val) = do
-  check val ret
+checkStatement m mass ret (Return val) = do
+  check (m `M.union` mass) val ret
   return (True, mass)
 
-checkIfStatement :: M.Map Ident Type -> Type -> IfStatement -> Subst Bool
-checkIfStatement mass ret (IfStatement val thens Nothing) = do
-  check val Boolean
-  _ <- checkBlock mass ret thens
+checkIfStatement :: M.Map Ident Type -> M.Map Ident Type -> Type -> IfStatement -> Subst Check Bool
+checkIfStatement m mass ret (IfStatement val thens Nothing) = do
+  check m val Boolean
+  _ <- checkBlock m mass ret thens
   return False
-checkIfStatement mass ret (IfStatement val thens (Just elses)) = do
-  check val Boolean
-  (allCodePathsReturn1, _) <- checkBlock mass ret thens
-  allCodePathsReturn2 <- checkElseStatement mass ret elses
+checkIfStatement m mass ret (IfStatement val thens (Just elses)) = do
+  check m val Boolean
+  (allCodePathsReturn1, _) <- checkBlock m mass ret thens
+  allCodePathsReturn2 <- checkElseStatement m mass ret elses
   return $ allCodePathsReturn1 && allCodePathsReturn2
 
-checkElseStatement :: M.Map Ident Type -> Type -> ElseStatement -> Subst Bool
-checkElseStatement mass ret (Else elses) = fst <$> checkBlock mass ret elses
-checkElseStatement mass ret (ElseIf ifst) = checkIfStatement mass ret ifst
+checkElseStatement :: M.Map Ident Type -> M.Map Ident Type -> Type -> ElseStatement -> Subst Check Bool
+checkElseStatement m mass ret (Else elses) = fst <$> checkBlock m mass ret elses
+checkElseStatement m mass ret (ElseIf ifst) = checkIfStatement m mass ret ifst
 
-checkBlock :: M.Map Ident Type -> Type -> [Statement] -> Subst (Bool, M.Map Ident Type)
-checkBlock mass _ [] = return (False, mass)
-checkBlock mass ret (s:ss) = do
-  (b1, mass1) <- checkStatement mass ret s
-  bindLocalVariables (M.toList mass1) $ case (b1, ss) of
+checkBlock :: M.Map Ident Type -> M.Map Ident Type -> Type -> [Statement] -> Subst Check (Bool, M.Map Ident Type)
+checkBlock _ mass _ [] = return (False, mass)
+checkBlock m mass ret (s:ss) = do
+  (b1, mass1) <- checkStatement (m `M.union` mass) mass ret s
+  case (b1, ss) of
     (True, []) -> return (True, mass1)
     (True, _) -> throwError "Unreachable code"
-    (False, ss') -> checkBlock mass1 ret ss'
+    (False, ss) -> do
+      (b2, mass2) <- checkBlock m mass1 ret ss
+      return (b2, mass2)
 
-skolemize :: String -> Type -> Subst Type
+skolemize :: String -> Type -> Subst Check Type
 skolemize ident ty = do
   tsk <- Skolem <$> fresh'
   rsk <- RSkolem <$> fresh'
   return $ replaceRowVars ident rsk $ replaceTypeVars ident tsk ty
 
-check :: Value -> Type -> Subst ()
-check val ty = rethrow errorMessage $ check' val ty
+check :: M.Map Ident Type -> Value -> Type -> Subst Check ()
+check m val ty = rethrow errorMessage $ check' m val ty
   where
   errorMessage msg =
     "Error checking type of term " ++
@@ -585,98 +605,109 @@ check val ty = rethrow errorMessage $ check' val ty
     ":\n" ++
     msg
 
-check' :: Value -> Type -> Subst ()
-check' val (ForAll idents ty) = do
+check' :: M.Map Ident Type -> Value -> Type -> Subst Check ()
+check' m val (ForAll idents ty) = do
   sk <- skolemize idents ty
-  check val sk
-check' val u@(TUnknown _) = do
-  ty <- infer val
+  check m val sk
+check' m val u@(TUnknown _) = do
+  ty <- infer m val
   -- Don't unify an unknown with an inferred polytype
   ty' <- replaceAllVarsWithUnknowns ty
   ty' ~~ u
-check' (NumericLiteral _) Number = return ()
-check' (StringLiteral _) String = return ()
-check' (BooleanLiteral _) Boolean = return ()
-check' (Unary op val) ty = checkUnary op val ty
-check' (Binary op left right) ty = checkBinary op left right ty
-check' (ArrayLiteral vals) (Array ty) = forM_ vals (\val -> check val ty)
-check' (Indexer index vals) ty = check index Number >> check vals (Array ty)
-check' (Abs args ret) (Function argTys retTy) = do
+check' m (NumericLiteral _) Number = return ()
+check' m (StringLiteral _) String = return ()
+check' m (BooleanLiteral _) Boolean = return ()
+check' m (Unary op val) ty = checkUnary m op val ty
+check' m (Binary op left right) ty = checkBinary m op left right ty
+check' m (ArrayLiteral vals) (Array ty) = forM_ vals (\val -> check m val ty)
+check' m (Indexer index vals) ty = check m index Number >> check m vals (Array ty)
+check' m (Abs args ret) (Function argTys retTy) = do
   guardWith "Incorrect number of function arguments" (length args == length argTys)
-  bindLocalVariables (zip args argTys) $ check ret retTy
-check' app@(App _ _) ret = do
+  let bindings = M.fromList (zip args argTys)
+  check (bindings `M.union` m) ret retTy
+check' m app@(App _ _) ret = do
   let (f, argss) = unfoldApplication app
-  ft <- infer f
-  checkFunctionApplications ft argss ret
-check' (Var var) ty = do
-  ty1 <- lookupVariable var
-  repl <- replaceAllTypeSynonyms ty1
-  repl `subsumes` ty
-check' (TypedValue val ty1) ty2 = do
-  kind <- liftCheck $ kindOf ty1
+  ft <- infer m f
+  checkFunctionApplications m ft argss ret
+check' m v@(Var var@(Qualified mp name)) ty = do
+  case mp of
+    ModulePath [] ->
+      case M.lookup name m of
+        Just ty1 -> do
+          repl <- lift $ replaceAllTypeSynonyms ty1
+          repl `subsumes` ty
+        Nothing -> lookupGlobal
+    _ -> lookupGlobal
+  where
+  lookupGlobal = do
+    env <- lift getEnv
+    modulePath <- checkModulePath `fmap` lift get
+    case M.lookup (qualify modulePath var) (names env) of
+      Nothing -> throwError $ show var ++ " is undefined"
+      Just (ty1, _) -> do
+        repl <- lift $ replaceAllTypeSynonyms ty1
+        repl `subsumes` ty
+check' m (TypedValue val ty1) ty2 = do
+  kind <- lift $ kindOf ty1
   guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
   ty1 `subsumes` ty2
-  check val ty1
-check' (Case vals binders) ret = do
-  ts <- mapM infer vals
-  checkBinders ts ret binders
-check' (IfThenElse cond th el) ty = do
-  check cond Boolean
-  check th ty
-  check el ty
-check' (ObjectLiteral ps) (Object row) = do
-  ensureNoDuplicateProperties ps
-  checkProperties ps row False
-check' (ObjectUpdate obj ps) (Object row) = do
-  ensureNoDuplicateProperties ps
-  us <- zip (map fst ps) <$> replicateM (length ps) fresh
-  let (propsToCheck, rest) = rowToList row
-      propsToRemove = map fst ps
-      remainingProps = filter (\(p, _) -> p `notElem` propsToRemove) propsToCheck
-  check obj (Object (rowFromList (us ++ remainingProps, rest)))
-  checkProperties ps row True
-check' (Accessor prop val) ty = do
+  check m val ty1
+check' m (Case val binders) ret = do
+  t1 <- infer m val
+  checkBinders m t1 ret binders
+check' m (IfThenElse cond th el) ty = do
+  check m cond Boolean
+  check m th ty
+  check m el ty
+check' m (ObjectLiteral ps) (Object row) = do
+  lift $ ensureNoDuplicateProperties ps
+  checkProperties m ps row False
+check' m (ObjectUpdate obj ps) objTy@(Object row) = do
+  lift $ ensureNoDuplicateProperties ps
+  check m obj objTy
+  checkProperties m ps row True
+check' m (Accessor prop val) ty = do
   rest <- fresh
-  check val (Object (RCons prop ty rest))
-check' (Block ss) ret = do
-  (allCodePathsReturn, _) <- checkBlock M.empty ret ss
+  check m val (Object (RCons prop ty rest))
+check' m (Block ss) ret = do
+  (allCodePathsReturn, _) <- checkBlock m M.empty ret ss
   guardWith "Block is missing a return statement" allCodePathsReturn
-check' (Constructor c) ty = do
-  env <- getEnv
-  modulePath <- checkModulePath <$> get
+check' m (Constructor c) ty = do
+  env <- lift getEnv
+  modulePath <- checkModulePath `fmap` lift get
   case M.lookup (qualify modulePath c) (dataConstructors env) of
     Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"
     Just ty1 -> do
-      repl <- replaceAllTypeSynonyms ty1
+      repl <- lift $ replaceAllTypeSynonyms ty1
       repl `subsumes` ty
-check' val (SaturatedTypeSynonym name args) = do
+check' m val (SaturatedTypeSynonym name args) = do
   ty <- expandTypeSynonym name args
-  check val ty
-check' val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ prettyPrintType ty
+  check m val ty
+check' _ val ty = throwError $ prettyPrintValue val ++ " does not have type " ++ prettyPrintType ty
 
-checkProperties :: [(String, Value)] -> Row -> Bool -> Subst ()
-checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where
+checkProperties :: M.Map Ident Type -> [(String, Value)] -> Row -> Bool -> Subst Check ()
+checkProperties m 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 [] ((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
-    ty <- infer v
+  go ((p,v):ps) [] u@(RUnknown _) = do
+    ty <- infer m v
     rest <- fresh
     u ~~ RCons p ty rest
-    go ps' [] rest
-  go ((p,v):ps') ts r =
+    go ps [] rest
+  go ((p,v):ps) ts r =
     case lookup p ts of
       Nothing -> do
-        ty <- infer v
+        ty <- infer m v
         rest <- fresh
         r ~~ RCons p ty rest
-        go ps' ts rest
+        go ps ts rest
       Just ty -> do
-        check v ty
-        go ps' (delete (p, ty) ts) r
+        check m v ty
+        go ps (delete (p, ty) ts) r
   go _ _ _ = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have type " ++ prettyPrintType (Object row)
 
 unfoldApplication :: Value -> (Value, [[Value]])
@@ -685,16 +716,16 @@ unfoldApplication = go []
   go argss (App f args) = go (args:argss) f
   go argss f = (f, argss)
 
-checkFunctionApplications :: Type -> [[Value]] -> Type -> Subst ()
-checkFunctionApplications _ [] _ = error "Nullary function application"
-checkFunctionApplications fnTy [args] ret = checkFunctionApplication fnTy args ret
-checkFunctionApplications fnTy (args:argss) ret = do
-  argTys <- mapM (infer) args
-  f <- inferFunctionApplication fnTy argTys
-  checkFunctionApplications f argss ret
+checkFunctionApplications :: M.Map Ident Type -> Type -> [[Value]] -> Type -> Subst Check ()
+checkFunctionApplications _ _ [] _ = error "Nullary function application"
+checkFunctionApplications m fnTy [args] ret = checkFunctionApplication m fnTy args ret
+checkFunctionApplications m fnTy (args:argss) ret = do
+  f <- fresh
+  checkFunctionApplication m fnTy args f
+  checkFunctionApplications m f argss ret
 
-checkFunctionApplication :: Type -> [Value] -> Type -> Subst ()
-checkFunctionApplication fnTy args ret = rethrow errorMessage $ checkFunctionApplication' fnTy args ret
+checkFunctionApplication :: M.Map Ident Type -> Type -> [Value] -> Type -> Subst Check ()
+checkFunctionApplication m fnTy args ret = rethrow errorMessage $ checkFunctionApplication' m fnTy args ret
   where
   errorMessage msg = "Error applying function of type "
     ++ prettyPrintType fnTy
@@ -702,49 +733,28 @@ checkFunctionApplication fnTy args ret = rethrow errorMessage $ checkFunctionApp
     ++ ", expecting value of type "
     ++ prettyPrintType ret ++ ":\n" ++ msg
 
-inferFunctionApplication :: Type -> [Type] -> Subst Type
-inferFunctionApplication (Function argTys retTy) args = do
-  guardWith "Incorrect number of function arguments" (length args == length argTys)
-  zipWithM subsumes args argTys
-  return retTy
-inferFunctionApplication (ForAll ident ty) args = do
-  replaced <- replaceVarWithUnknown ident ty
-  inferFunctionApplication replaced args
-inferFunctionApplication u@(TUnknown _) args = do
-
-  ret <- fresh
-  args' <- mapM replaceAllVarsWithUnknowns args
-  u ~~ Function args' ret
-  return ret
-inferFunctionApplication (SaturatedTypeSynonym name tyArgs) args  = do
-  ty <- expandTypeSynonym name tyArgs
-  inferFunctionApplication ty args
-inferFunctionApplication fnTy args = throwError $ "Cannot apply function of type "
-  ++ prettyPrintType fnTy
-  ++ " to argument(s) of type(s) " ++ intercalate ", " (map prettyPrintType args)
-
-checkFunctionApplication' :: Type -> [Value] -> Type -> Subst ()
-checkFunctionApplication' (Function argTys retTy) args ret = do
+checkFunctionApplication' :: M.Map Ident Type -> Type -> [Value] -> Type -> Subst Check ()
+checkFunctionApplication' m (Function argTys retTy) args ret = do
   guardWith "Incorrect number of function arguments" (length args == length argTys)
-  zipWithM (check) args argTys
+  zipWithM (check m) args argTys
   retTy `subsumes` ret
-checkFunctionApplication' (ForAll ident ty) args ret = do
-  replaced <- replaceVarWithUnknown ident ty
-  checkFunctionApplication replaced args ret
-checkFunctionApplication' u@(TUnknown _) args ret = do
-  tyArgs <- mapM (\arg -> infer arg >>= replaceAllVarsWithUnknowns) args
+checkFunctionApplication' m (ForAll ident ty) args ret = do
+  replaced <- replaceVarsWithUnknowns [ident] ty
+  checkFunctionApplication m replaced args ret
+checkFunctionApplication' m u@(TUnknown _) args ret = do
+  tyArgs <- mapM (\arg -> infer m arg >>= replaceAllVarsWithUnknowns) args
   u ~~ Function tyArgs ret
-checkFunctionApplication' (SaturatedTypeSynonym name tyArgs) args ret = do
+checkFunctionApplication' m (SaturatedTypeSynonym name tyArgs) args ret = do
   ty <- expandTypeSynonym name tyArgs
-  checkFunctionApplication' ty args ret
-checkFunctionApplication' fnTy args ret = throwError $ "Applying a function of type "
+  checkFunctionApplication' m ty args ret
+checkFunctionApplication' _ fnTy args ret = throwError $ "Cannot apply function of type "
   ++ prettyPrintType fnTy
-  ++ " to argument(s) " ++ intercalate ", " (map prettyPrintValue args)
-  ++ " does not yield a value of type " ++ prettyPrintType ret ++ "."
+  ++ " to arguments " ++ intercalate ", " (map prettyPrintValue args)
+  ++ ". Expecting value of type " ++ prettyPrintType ret ++ "."
 
-subsumes :: Type -> Type -> Subst ()
+subsumes :: Type -> Type -> Subst Check ()
 subsumes (ForAll ident ty1) ty2 = do
-  replaced <- replaceVarWithUnknown ident ty1
+  replaced <- replaceVarsWithUnknowns [ident] ty1
   replaced `subsumes` ty2
 subsumes (Function args1 ret1) (Function args2 ret2) = do
   zipWithM subsumes args2 args1
diff --git a/src/Language/PureScript/Types.hs b/src/Language/PureScript/Types.hs
index 8028109..f7d57f4 100644
--- a/src/Language/PureScript/Types.hs
+++ b/src/Language/PureScript/Types.hs
@@ -44,6 +44,10 @@ data Row
   | RCons String Type Row
   | RSkolem Int deriving (Show, Eq, Data, Typeable)
 
+typesToRow :: [(String, Type)] -> Row
+typesToRow [] = REmpty
+typesToRow ((name, ty):tys) = RCons name ty (typesToRow tys)
+
 rowToList :: Row -> ([(String, Type)], Row)
 rowToList (RCons name ty row) = let (tys, rest) = rowToList row
                                in ((name, ty):tys, rest)
@@ -63,11 +67,8 @@ isPolyType (Object ps) = all isPolyType (map snd . fst $ rowToList ps)
 isPolyType (Function args ret) = all isPolyType args && isPolyType ret
 isPolyType (TypeApp t1 t2) = isMonoType t1 && isMonoType t2
 isPolyType (SaturatedTypeSynonym _ args) = all isPolyType args
-isPolyType (ForAll _ ty) = isPolyType ty
+isPolyType (ForAll idents ty) = isPolyType ty
 isPolyType _ = True
 
 mkForAll :: [String] -> Type -> Type
 mkForAll = flip . foldl . flip $ ForAll
-
-unit :: Type
-unit = Object REmpty
diff --git a/src/Language/PureScript/Unknown.hs b/src/Language/PureScript/Unknown.hs
index 96e102b..9f40ab9 100644
--- a/src/Language/PureScript/Unknown.hs
+++ b/src/Language/PureScript/Unknown.hs
@@ -17,6 +17,7 @@
 module Language.PureScript.Unknown where
 
 import Data.Data
+import Data.Typeable
 
 newtype Unknown t = Unknown { runUnknown :: Int } deriving (Show, Eq, Ord, Data, Typeable)
 
diff --git a/src/Language/PureScript/Values.hs b/src/Language/PureScript/Values.hs
index 1e57a74..402ec1b 100644
--- a/src/Language/PureScript/Values.hs
+++ b/src/Language/PureScript/Values.hs
@@ -21,8 +21,6 @@ import Language.PureScript.Names
 
 import Data.Data
 
-type Guard = Value
-
 data UnaryOperator
   = Negate
   | Not
@@ -69,7 +67,7 @@ data Value
   | IfThenElse Value Value Value
   | Block [Statement]
   | Constructor (Qualified ProperName)
-  | Case [Value] [([Binder], Maybe Guard, Value)]
+  | Case Value [(Binder, Value)]
   | TypedValue Value PolyType deriving (Show, Data, Typeable)
 
 data Statement
@@ -79,7 +77,6 @@ data Statement
   | For Ident Value Value [Statement]
   | ForEach Ident Value [Statement]
   | If IfStatement
-  | ValueStatement Value
   | Return Value deriving (Show, Data, Typeable)
 
 data IfStatement = IfStatement Value [Statement] (Maybe ElseStatement) deriving (Show, Data, Typeable)
@@ -97,6 +94,6 @@ data Binder
   | NullaryBinder (Qualified ProperName)
   | UnaryBinder (Qualified ProperName) Binder
   | ObjectBinder [(String, Binder)]
-  | ArrayBinder [Binder]
-  | ConsBinder Binder Binder
-  | NamedBinder Ident Binder deriving (Show, Data, Typeable)
+  | ArrayBinder [Binder] (Maybe Binder)
+  | NamedBinder Ident Binder
+  | GuardedBinder Value Binder deriving (Show, Data, Typeable)
diff --git a/src/Main.hs b/src/Main.hs
index f9ec73a..adada98 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -15,46 +15,41 @@
 module Main where
 
 import qualified Language.PureScript as P
+import Data.Maybe (mapMaybe)
+import Data.List (intercalate)
 import System.Console.CmdTheLine
 import Control.Applicative
 import Control.Monad (forM)
 import System.Exit (exitSuccess, exitFailure)
+import qualified Text.Parsec as P
 import qualified System.IO.UTF8 as U
-import Text.Parsec (ParseError)
+import qualified Data.Map as M
 
-readInput :: Maybe [FilePath] -> IO (Either ParseError [P.Declaration])
-readInput Nothing = getContents >>= return . P.runIndentParser P.parseDeclarations
-readInput (Just input) = fmap (fmap concat . sequence) $ forM input $ \inputFile -> do
-  text <- U.readFile inputFile
-  return $ P.runIndentParser P.parseDeclarations text
-
-compile :: Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
-compile input output externs = do
-  asts <- readInput input
+compile :: [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
+compile inputFiles outputFile externsFile = do
+  asts <- fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do
+    text <- U.readFile inputFile
+    return $ P.runIndentParser P.parseDeclarations text
   case asts of
     Left err -> do
       U.print err
       exitFailure
     Right decls ->
       case P.compile decls of
-        Left err -> do
-          U.putStrLn err
+        Left error -> do
+          U.putStrLn error
           exitFailure
         Right (js, exts, _) -> do
-          case output of
+          case outputFile of
             Just path -> U.writeFile path js
             Nothing -> U.putStrLn js
-          case externs of
+          case externsFile of
             Nothing -> return ()
             Just filePath -> U.writeFile filePath exts
           exitSuccess
 
-useStdIn :: Term Bool
-useStdIn = value . flag $ (optInfo [ "s", "stdin" ])
-     { optDoc = "Read from standard input" }
-
 inputFiles :: Term [FilePath]
-inputFiles = value $ posAny [] $ posInfo
+inputFiles = nonEmpty $ posAny [] $ posInfo
      { posDoc = "The input .ps files" }
 
 outputFile :: Term (Maybe FilePath)
@@ -65,14 +60,8 @@ externsFile :: Term (Maybe FilePath)
 externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])
      { optDoc = "The output .e.ps file" }
 
-stdInOrInputFiles :: Term (Maybe [FilePath])
-stdInOrInputFiles = combine <$> useStdIn <*> inputFiles
-  where
-  combine False input = Just input
-  combine True _ = Nothing
-
 term :: Term (IO ())
-term = compile <$> stdInOrInputFiles <*> outputFile <*> externsFile
+term = compile <$> inputFiles <*> outputFile <*> externsFile
 
 termInfo :: TermInfo
 termInfo = defTI
@@ -81,5 +70,4 @@ termInfo = defTI
   , termDoc  = "Compiles PureScript to Javascript"
   }
 
-main :: IO ()
 main = run (term, termInfo)
diff --git a/tests/Main.hs b/tests/Main.hs
index d14fc7f..74dfd19 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -58,14 +58,13 @@ assertDoesNotCompile inputFile = do
 main :: IO ()
 main = do
   cd <- getCurrentDirectory
-  putStrLn $ cd
   let examples = cd ++ pathSeparator : "examples"
   let passing = examples ++ pathSeparator : "passing"
   passingTestCases <- getDirectoryContents passing
-  forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
+  forM_ passingTestCases $ \inputFile -> when (".ps" `isSuffixOf` inputFile) $
     assertCompiles (passing ++ pathSeparator : inputFile)
   let failing = examples ++ pathSeparator : "failing"
   failingTestCases <- getDirectoryContents failing
-  forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
+  forM_ failingTestCases $ \inputFile -> when (".ps" `isSuffixOf` inputFile) $
     assertDoesNotCompile (failing ++ pathSeparator : inputFile)
   exitSuccess