diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md
index 42f8195216..ca6246b5f6 100644
--- a/CONTRIBUTORS.md
+++ b/CONTRIBUTORS.md
@@ -21,6 +21,7 @@ If you would prefer to use different terms, please use the section below instead
 | [@andyarvanitis](https://github.com/andyarvanitis) | Andy Arvanitis | [MIT license](http://opensource.org/licenses/MIT) |
 | [@anthok88](https://github.com/anthok88) | anthoq88 | MIT license |
 | [@ardumont](https://github.com/ardumont) | Antoine R. Dumont | [MIT license](http://opensource.org/licenses/MIT) |
+| [@arrowd](https://github.com/arrowd) | Gleb Popov | [MIT license](http://opensource.org/licenses/MIT) |
 | [@aspidites](https://github.com/aspidites) | Edwin Marshall | [MIT license](http://opensource.org/licenses/MIT) |
 | [@bagl](https://github.com/bagl) | Petr Vapenka | [MIT license](http://opensource.org/licenses/MIT) |
 | [@balajirrao](https://github.com/balajirrao) | Balaji Rao | MIT license |
@@ -50,6 +51,7 @@ If you would prefer to use different terms, please use the section below instead
 | [@fehrenbach](https://github.com/fehrenbach) | Stefan Fehrenbach | [MIT license](http://opensource.org/licenses/MIT) |
 | [@felixSchl](https://github.com/felixSchl) | Felix Schlitter | [MIT license](http://opensource.org/licenses/MIT) |
 | [@FrigoEU](https://github.com/FrigoEU) | Simon Van Casteren | [MIT license](http://opensource.org/licenses/MIT) |
+| [@fsoikin](https://github.com/fsoikin) | Fyodor Soikin | [MIT license](http://opensource.org/licenses/MIT) |
 | [@garyb](https://github.com/garyb) | Gary Burgess | [MIT license](http://opensource.org/licenses/MIT) |
 | [@hdgarrood](https://github.com/hdgarrood) | Harry Garrood | [MIT license](http://opensource.org/licenses/MIT) |
 | [@houli](https://github.com/houli) | Eoin Houlihan | [MIT license](http://opensource.org/licenses/MIT) |
@@ -67,6 +69,7 @@ If you would prefer to use different terms, please use the section below instead
 | [@legrostdg](https://github.com/legrostdg) | Félix Sipma | [MIT license](http://opensource.org/licenses/MIT) |
 | [@LiamGoodacre](https://github.com/LiamGoodacre) | Liam Goodacre | [MIT license](http://opensource.org/licenses/MIT) |
 | [@lukerandall](https://github.com/lukerandall) | Luke Randall | [MIT license](http://opensource.org/licenses/MIT) |
+| [@lunaris](https://github.com/lunaris) | Will Jones | [MIT license](http://opensource.org/licenses/MIT) |
 | [@matthewleon](https://github.com/matthewleon) | Matthew Leon | [MIT license](http://opensource.org/licenses/MIT) |
 | [@mcoffin](https://github.com/mcoffin) | Matt Coffin | [MIT license](http://opensource.org/licenses/MIT) |
 | [@mhcurylo](https://github.com/mhcurylo) | Mateusz Curylo | [MIT license](http://opensource.org/licenses/MIT) |
@@ -75,6 +78,7 @@ If you would prefer to use different terms, please use the section below instead
 | [@mgmeier](https://github.com/mgmeier) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) |
 | [@michaelficarra](https://github.com/michaelficarra) | Michael Ficarra | [MIT license](http://opensource.org/licenses/MIT) |
 | [@MichaelXavier](https://github.com/MichaelXavier) | Michael Xavier | MIT license |
+| [@milesfrain](https://github.com/milesfrain) | Miles Frain | [MIT license](http://opensource.org/licenses/MIT) |
 | [@mjgpy3](https://github.com/mjgpy3) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) |
 | [@mpietrzak](https://github.com/mpietrzak) | Maciej Pietrzak | [MIT license](http://opensource.org/licenses/MIT) |
 | [@mrhania](https://github.com/mrhania) | Łukasz Hanuszczak | [MIT license](http://opensource.org/licenses/MIT) |
@@ -137,6 +141,9 @@ If you would prefer to use different terms, please use the section below instead
 | [@marcosh](https://github.com/marcosh) | Marco Perone | [MIT license](http://opensource.org/licenses/MIT) |
 | [@matthew-hilty](https://github.com/matthew-hilty) | Matthew Hilty | [MIT license](http://opensource.org/licenses/MIT) |
 | [@woody88](https://github.com/woody88) | Woodson Delhia | [MIT license](http://opensource.org/licenses/MIT) |
+| [@mhmdanas](https://github.com/mhmdanas) | Mohammed Anas | [MIT license](http://opensource.org/licenses/MIT) |
+| [@kl0tl](https://github.com/kl0tl) | Cyril Sobierajewicz | [MIT license](http://opensource.org/licenses/MIT) |
+| [@gorbak25](https://github.com/gorbak25) | Grzegorz Uriasz | [MIT license](http://opensource.org/licenses/MIT) |
 
 ### Contributors using Modified Terms
 
@@ -144,6 +151,7 @@ If you would prefer to use different terms, please use the section below instead
 | :------- | :--- | :------ |
 | [@charleso](https://github.com/charleso) | Charles O'Farrell | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Charles O'Farrell, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |
 | [@chrissmoak](https://github.com/chrissmoak) | Chris Smoak | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Chris Smoak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |
+| [@citizengabe](https://github.com/citizengabe) | Gabe Johnson | All contributions I have or will make using the @citizengabe GitHub account are during employment at [CitizenNet Inc.](#companies) who owns the copyright. All of my existing or future contributions made using the @gabejohnson GitHub account are personal contributions and subject to the terms specified [above](#contributors-using-standard-terms). |
 | [@dylex](https://github.com/dylex) | Dylan Simon | My existing and all future contributions to the PureScript compiler until further notice are Copyright Dylan Simon, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |
 | [@leighman](http://github.com/leighman) | Jack Leigh | My existing contributions and all future contributions until further notice are Copyright Jack Leigh, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |
 | [@nagisa](https://github.com/nagisa) | nagisa | I hereby release my [only contribution](https://github.com/purescript/purescript/commit/80287a5d0de619862d3b4cda9c1ee276d18fdcd8) into public domain. |
@@ -153,5 +161,6 @@ If you would prefer to use different terms, please use the section below instead
 
 | Username | Company | Terms |
 | :------- | :--- | :------ |
+| [@citizennet](https://github.com/citizennet) | CitizenNet Inc. | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright CitizenNet Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@dbenyamin-cn](https://github.com/dbenyamin-cn) |
 | [@slamdata](https://github.com/slamdata) | SlamData, Inc. | Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - @jdegoes |
 | [@qfpl](https://github.com/qfpl) | qfpl @ Data61 / CSIRO | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Data61 / CSIRO, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@lightandlight](https://github.com/lightandlight) |
diff --git a/package.yaml b/package.yaml
index 3840ebb5b6..fafe2d0533 100644
--- a/package.yaml
+++ b/package.yaml
@@ -102,7 +102,7 @@ build-tools:
 
 library:
   source-dirs: src
-  ghc-options: -Wall -O2
+  ghc-options: -Wall -O3 -optc-O3
   other-modules: Paths_purescript
   default-extensions:
     - ConstraintKinds
@@ -131,7 +131,7 @@ executables:
   purs:
     main: Main.hs
     source-dirs: app
-    ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N
+    ghc-options: -Wall -O3 -optc-O3 -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N
     other-modules:
       - Command.Bundle
       - Command.Compile
diff --git a/src/Control/Monad/Supply/Class.hs b/src/Control/Monad/Supply/Class.hs
index 64038a6aac..b0e37666fa 100644
--- a/src/Control/Monad/Supply/Class.hs
+++ b/src/Control/Monad/Supply/Class.hs
@@ -34,3 +34,6 @@ instance (Monoid w, MonadSupply m) => MonadSupply (WriterT w m)
 
 freshName :: MonadSupply m => m Text
 freshName = fmap (("$" <> ) . pack . show) fresh
+
+freshNameHint :: MonadSupply m => Text -> m Text
+freshNameHint hint = fmap ((("$" <> hint) <> ) . pack . show) fresh
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
index 63ef0af4aa..50f467110d 100644
--- a/src/Language/PureScript/AST/Declarations.hs
+++ b/src/Language/PureScript/AST/Declarations.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DeriveAnyClass #-}
 
@@ -34,7 +33,7 @@ import Language.PureScript.Kinds
 import Language.PureScript.TypeClassDictionaries
 import Language.PureScript.Comments
 import Language.PureScript.Environment
-import qualified Language.PureScript.Bundle as Bundle
+import qualified Language.PureScript.Bundle.Types as Bundle
 import qualified Language.PureScript.Constants as C
 import qualified Language.PureScript.CST.Errors as CST
 
diff --git a/src/Language/PureScript/AST/Literals.hs b/src/Language/PureScript/AST/Literals.hs
index a161fd82ab..5939d3a5f0 100644
--- a/src/Language/PureScript/AST/Literals.hs
+++ b/src/Language/PureScript/AST/Literals.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 -- |
 -- The core functional representation for literal values.
 --
diff --git a/src/Language/PureScript/AST/Operators.hs b/src/Language/PureScript/AST/Operators.hs
index 41a129257e..4a73c19990 100644
--- a/src/Language/PureScript/AST/Operators.hs
+++ b/src/Language/PureScript/AST/Operators.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 {-# LANGUAGE DeriveGeneric #-}
 -- |
 -- Operators fixity and associativity
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
index 4aaeeecad7..83dda247d0 100644
--- a/src/Language/PureScript/AST/Traversals.hs
+++ b/src/Language/PureScript/AST/Traversals.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 -- |
 -- AST traversal helpers
 --
@@ -8,7 +9,7 @@ import Prelude.Compat
 import Control.Monad
 
 import Data.Foldable (fold)
-import Data.List (mapAccumL)
+import Data.List (mapAccumL, foldl')
 import Data.Maybe (mapMaybe)
 import qualified Data.List.NonEmpty as NEL
 import qualified Data.Map as M
@@ -273,11 +274,11 @@ everythingOnValues (<>.) f g h i j = (f', g', h', i', j')
   where
 
   f' :: Declaration -> r
-  f' d@(DataBindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap f' ds)
-  f' d@(ValueDeclaration vd) = foldl (<>.) (f d) (fmap h' (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) (valdeclExpression vd))
-  f' d@(BindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap (\(_, _, val) -> g' val) ds)
-  f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) (f d) (fmap f' ds)
-  f' d@(TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) (f d) (fmap f' ds)
+  f' d@(DataBindingGroupDeclaration ds) = foldl' (<>.) (f d) (fmap f' ds)
+  f' d@(ValueDeclaration vd) = foldl' (<>.) (f d) (fmap h' (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) (valdeclExpression vd))
+  f' d@(BindingGroupDeclaration ds) = foldl' (<>.) (f d) (fmap (\(_, _, val) -> g' val) ds)
+  f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl' (<>.) (f d) (fmap f' ds)
+  f' d@(TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl' (<>.) (f d) (fmap f' ds)
   f' d@(BoundValueDeclaration _ b expr) = f d <>. h' b <>. g' expr
   f' d = f d
 
@@ -288,23 +289,23 @@ everythingOnValues (<>.) f g h i j = (f', g', h', i', j')
   g' v@(Parens v1) = g v <>. g' v1
   g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <>. g' v1
   g' v@(Accessor _ v1) = g v <>. g' v1
-  g' v@(ObjectUpdate obj vs) = foldl (<>.) (g v <>. g' obj) (fmap (g' . snd) vs)
-  g' v@(ObjectUpdateNested obj vs) = foldl (<>.) (g v <>. g' obj) (fmap g' vs)
+  g' v@(ObjectUpdate obj vs) = foldl' (<>.) (g v <>. g' obj) (fmap (g' . snd) vs)
+  g' v@(ObjectUpdateNested obj vs) = foldl' (<>.) (g v <>. g' obj) (fmap g' vs)
   g' v@(Abs b v1) = g v <>. h' b <>. g' v1
   g' v@(App v1 v2) = g v <>. g' v1 <>. g' v2
   g' v@(Unused v1) = g v <>. g' v1
   g' v@(IfThenElse v1 v2 v3) = g v <>. g' v1 <>. g' v2 <>. g' v3
-  g' v@(Case vs alts) = foldl (<>.) (foldl (<>.) (g v) (fmap g' vs)) (fmap i' alts)
+  g' v@(Case vs alts) = foldl' (<>.) (foldl' (<>.) (g v) (fmap g' vs)) (fmap i' alts)
   g' v@(TypedValue _ v1 _) = g v <>. g' v1
-  g' v@(Let _ ds v1) = foldl (<>.) (g v) (fmap f' ds) <>. g' v1
-  g' v@(Do _ es) = foldl (<>.) (g v) (fmap j' es)
-  g' v@(Ado _ es v1) = foldl (<>.) (g v) (fmap j' es) <>. g' v1
+  g' v@(Let _ ds v1) = foldl' (<>.) (g v) (fmap f' ds) <>. g' v1
+  g' v@(Do _ es) = foldl' (<>.) (g v) (fmap j' es)
+  g' v@(Ado _ es v1) = foldl' (<>.) (g v) (fmap j' es) <>. g' v1
   g' v@(PositionedValue _ _ v1) = g v <>. g' v1
   g' v = g v
 
   h' :: Binder -> r
   h' b@(LiteralBinder _ l) = lit (h b) h' l
-  h' b@(ConstructorBinder _ _ bs) = foldl (<>.) (h b) (fmap h' bs)
+  h' b@(ConstructorBinder _ _ bs) = foldl' (<>.) (h b) (fmap h' bs)
   h' b@(BinaryNoParensBinder b1 b2 b3) = h b <>. h' b1 <>. h' b2 <>. h' b3
   h' b@(ParensInBinder b1) = h b <>. h' b1
   h' b@(NamedBinder _ _ b1) = h b <>. h' b1
@@ -313,18 +314,18 @@ everythingOnValues (<>.) f g h i j = (f', g', h', i', j')
   h' b = h b
 
   lit :: r -> (a -> r) -> Literal a -> r
-  lit r go (ArrayLiteral as) = foldl (<>.) r (fmap go as)
-  lit r go (ObjectLiteral as) = foldl (<>.) r (fmap (go . snd) as)
+  lit r go (ArrayLiteral as) = foldl' (<>.) r (fmap go as)
+  lit r go (ObjectLiteral as) = foldl' (<>.) r (fmap (go . snd) as)
   lit r _ _ = r
 
   i' :: CaseAlternative -> r
   i' ca@(CaseAlternative bs gs) =
-    foldl (<>.) (i ca) (fmap h' bs ++ concatMap (\(GuardedExpr grd val) -> fmap k' grd ++ [g' val]) gs)
+    foldl' (<>.) (i ca) (fmap h' bs ++ concatMap (\(GuardedExpr grd val) -> fmap k' grd ++ [g' val]) gs)
 
   j' :: DoNotationElement -> r
   j' e@(DoNotationValue v) = j e <>. g' v
   j' e@(DoNotationBind b v) = j e <>. h' b <>. g' v
-  j' e@(DoNotationLet ds) = foldl (<>.) (j e) (fmap f' ds)
+  j' e@(DoNotationLet ds) = foldl' (<>.) (j e) (fmap f' ds)
   j' e@(PositionedDoNotationElement _ _ e1) = j e <>. j' e1
 
   k' :: Guard -> r
@@ -353,11 +354,11 @@ everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i
   f'' s d = let (s', r) = f s d in r <>. f' s' d
 
   f' :: s -> Declaration -> r
-  f' s (DataBindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (f'' s) ds)
-  f' s (ValueDeclaration vd) = foldl (<>.) r0 (fmap (h'' s) (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) (valdeclExpression vd))
-  f' s (BindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (\(_, _, val) -> g'' s val) ds)
-  f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) r0 (fmap (f'' s) ds)
-  f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) r0 (fmap (f'' s) ds)
+  f' s (DataBindingGroupDeclaration ds) = foldl' (<>.) r0 (fmap (f'' s) ds)
+  f' s (ValueDeclaration vd) = foldl' (<>.) r0 (fmap (h'' s) (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) (valdeclExpression vd))
+  f' s (BindingGroupDeclaration ds) = foldl' (<>.) r0 (fmap (\(_, _, val) -> g'' s val) ds)
+  f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl' (<>.) r0 (fmap (f'' s) ds)
+  f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl' (<>.) r0 (fmap (f'' s) ds)
   f' _ _ = r0
 
   g'' :: s -> Expr -> r
@@ -370,17 +371,17 @@ everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i
   g' s (Parens v1) = g'' s v1
   g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
   g' s (Accessor _ v1) = g'' s v1
-  g' s (ObjectUpdate obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s . snd) vs)
-  g' s (ObjectUpdateNested obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s) vs)
+  g' s (ObjectUpdate obj vs) = foldl' (<>.) (g'' s obj) (fmap (g'' s . snd) vs)
+  g' s (ObjectUpdateNested obj vs) = foldl' (<>.) (g'' s obj) (fmap (g'' s) vs)
   g' s (Abs binder v1) = h'' s binder <>. g'' s v1
   g' s (App v1 v2) = g'' s v1 <>. g'' s v2
   g' s (Unused v) = g'' s v
   g' s (IfThenElse v1 v2 v3) = g'' s v1 <>. g'' s v2 <>. g'' s v3
-  g' s (Case vs alts) = foldl (<>.) (foldl (<>.) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)
+  g' s (Case vs alts) = foldl' (<>.) (foldl' (<>.) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)
   g' s (TypedValue _ v1 _) = g'' s v1
-  g' s (Let _ ds v1) = foldl (<>.) r0 (fmap (f'' s) ds) <>. g'' s v1
-  g' s (Do _ es) = foldl (<>.) r0 (fmap (j'' s) es)
-  g' s (Ado _ es v1) = foldl (<>.) r0 (fmap (j'' s) es) <>. g'' s v1
+  g' s (Let _ ds v1) = foldl' (<>.) r0 (fmap (f'' s) ds) <>. g'' s v1
+  g' s (Do _ es) = foldl' (<>.) r0 (fmap (j'' s) es)
+  g' s (Ado _ es v1) = foldl' (<>.) r0 (fmap (j'' s) es) <>. g'' s v1
   g' s (PositionedValue _ _ v1) = g'' s v1
   g' _ _ = r0
 
@@ -389,7 +390,7 @@ everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i
 
   h' :: s -> Binder -> r
   h' s (LiteralBinder _ l) = lit h'' s l
-  h' s (ConstructorBinder _ _ bs) = foldl (<>.) r0 (fmap (h'' s) bs)
+  h' s (ConstructorBinder _ _ bs) = foldl' (<>.) r0 (fmap (h'' s) bs)
   h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <>. h'' s b2 <>. h'' s b3
   h' s (ParensInBinder b) = h'' s b
   h' s (NamedBinder _ _ b1) = h'' s b1
@@ -398,15 +399,15 @@ everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i
   h' _ _ = r0
 
   lit :: (s -> a -> r) -> s -> Literal a -> r
-  lit go s (ArrayLiteral as) = foldl (<>.) r0 (fmap (go s) as)
-  lit go s (ObjectLiteral as) = foldl (<>.) r0 (fmap (go s . snd) as)
+  lit go s (ArrayLiteral as) = foldl' (<>.) r0 (fmap (go s) as)
+  lit go s (ObjectLiteral as) = foldl' (<>.) r0 (fmap (go s . snd) as)
   lit _ _ _ = r0
 
   i'' :: s -> CaseAlternative -> r
   i'' s ca = let (s', r) = i s ca in r <>. i' s' ca
 
   i' :: s -> CaseAlternative -> r
-  i' s (CaseAlternative bs gs) = foldl (<>.) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> fmap (k' s) grd ++ [g'' s val]) gs)
+  i' s (CaseAlternative bs gs) = foldl' (<>.) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> fmap (k' s) grd ++ [g'' s val]) gs)
 
   j'' :: s -> DoNotationElement -> r
   j'' s e = let (s', r) = j s e in r <>. j' s' e
@@ -414,7 +415,7 @@ everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i
   j' :: s -> DoNotationElement -> r
   j' s (DoNotationValue v) = g'' s v
   j' s (DoNotationBind b v) = h'' s b <>. g'' s v
-  j' s (DoNotationLet ds) = foldl (<>.) r0 (fmap (f'' s) ds)
+  j' s (DoNotationLet ds) = foldl' (<>.) r0 (fmap (f'' s) ds)
   j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
 
   k' :: s -> Guard -> r
diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs
index cf90d2e0ae..60d01039c6 100644
--- a/src/Language/PureScript/Bundle.hs
+++ b/src/Language/PureScript/Bundle.hs
@@ -17,6 +17,8 @@ module Language.PureScript.Bundle
   , Module
   ) where
 
+import Debug.Trace
+
 import Prelude.Compat
 import Protolude (ordNub)
 
@@ -36,8 +38,12 @@ import Data.Version (showVersion)
 import qualified Data.Aeson as A
 import qualified Data.Map as M
 import qualified Data.Set as S
+import qualified Data.Text as TS
 import qualified Data.Text.Lazy as T
 
+import Language.PureScript.Bundle.Types
+import qualified Language.PureScript.CoreImp.AST as CoreAST
+
 import Language.JavaScript.Parser
 import Language.JavaScript.Parser.AST
 import Language.JavaScript.Process.Minify
@@ -48,41 +54,6 @@ import System.FilePath (takeFileName, takeDirectory, takeDirectory, makeRelative
 
 import SourceMap.Types
 
--- | The type of error messages. We separate generation and rendering of errors using a data
--- type, in case we need to match on error types later.
-data ErrorMessage
-  = UnsupportedModulePath String
-  | InvalidTopLevel
-  | UnableToParseModule String
-  | UnsupportedExport
-  | ErrorInModule ModuleIdentifier ErrorMessage
-  | MissingEntryPoint String
-  | MissingMainModule String
-  deriving (Show)
-
--- | Modules are either "regular modules" (i.e. those generated by the PureScript compiler) or
--- foreign modules.
-data ModuleType
-  = Regular
-  | Foreign
-  deriving (Show, Eq, Ord)
-
-showModuleType :: ModuleType -> String
-showModuleType Regular = "Regular"
-showModuleType Foreign = "Foreign"
-
--- | A module is identified by its module name and its type.
-data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)
-
-instance A.ToJSON ModuleIdentifier where
-  toJSON (ModuleIdentifier name mt) =
-    A.object [ "name" .= name
-             , "type" .= show mt
-             ]
-
-moduleName :: ModuleIdentifier -> String
-moduleName (ModuleIdentifier name _) = name
-
 -- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
 guessModuleIdentifier :: MonadError ErrorMessage m => FilePath -> m ModuleIdentifier
 guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> guessModuleType (takeFileName filename)
@@ -122,6 +93,7 @@ data ModuleElement
   = Require JSStatement String (Either String ModuleIdentifier)
   | Member JSStatement Visibility String JSExpression [Key]
   | ExportsList [(ExportType, String, JSExpression, [Key])]
+  | Block (Maybe String) [JSStatement] [Key]
   | Other JSStatement
   | Skip JSStatement
   deriving (Show)
@@ -148,6 +120,11 @@ instance A.ToJSON ModuleElement where
       A.object [ "type"    .= A.String "ExportsList"
                , "exports" .= map exportToJSON exports
                ]
+    (Block name stmts dependsOn) ->
+      A.object [ "statemtents" .= A.toJSON (map getFragment stmts)
+               , "name" .= A.toJSON name
+               , "dependsOn"  .= map keyToJSON dependsOn
+               ]
     (Other stmt) ->
       A.object [ "type" .= A.String "Other"
                , "js"   .= getFragment stmt
@@ -206,10 +183,11 @@ printErrorMessage (UnableToParseModule err) =
   [ "The module could not be parsed:"
   , err
   ]
-printErrorMessage UnsupportedExport =
+printErrorMessage (UnsupportedExport s) =
   [ "An export was unsupported. Exports can be defined in one of two ways: "
   , "  1) exports.name = ..."
   , "  2) exports = { ... }"
+  , "ERROR: " <> s
   ]
 printErrorMessage (ErrorInModule mid e) =
   ("Error in module " ++ displayIdentifier mid ++ ":")
@@ -267,15 +245,20 @@ withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es)
 
   -- | Collects all member names in scope, so that we can identify dependencies of the second type.
   boundNames :: [String]
-  boundNames = mapMaybe toBoundName es
+  boundNames = concatMap toBoundName es
     where
-    toBoundName :: ModuleElement -> Maybe String
-    toBoundName (Member _ Internal nm _ _) = Just nm
-    toBoundName _ = Nothing
+    toBoundName :: ModuleElement -> [String]
+    toBoundName (Member _ Internal nm _ _) = [nm]
+    toBoundName _ = []
 
   -- | Calculate dependencies and add them to the current element.
   expandDeps :: ModuleElement -> ModuleElement
   expandDeps (Member n f nm decl _) = Member n f nm decl (ordNub $ dependencies modulePath decl)
+  expandDeps (Block n b _) = Block n b keys where
+    keys = ordNub $
+      dependencies modulePath
+      (JSFunctionExpression JSNoAnnot JSIdentNone JSNoAnnot JSLNil JSNoAnnot
+        (JSBlock JSNoAnnot b JSNoAnnot))
   expandDeps (ExportsList exps) = ExportsList (map expand exps)
       where
       expand (ty, nm, n1, _) = (ty, nm, n1, ordNub (dependencies modulePath n1))
@@ -311,9 +294,9 @@ withDeps (Module modulePath fn es) = Module modulePath fn (map expandDeps es)
             mapMaybe unPropertyIdentRef $
             trailingCommaList props
         in
-          (map (\name -> (m, name, Internal)) shorthandNames, bn)
+          (map (m, , Internal) shorthandNames, bn)
     toReference (JSFunctionExpression _ _ _ params _ _) bn
-      = ([], bn \\ (mapMaybe unIdentifier $ commaList params))
+      = ([], bn \\ mapMaybe unIdentifier (commaList params))
     toReference e bn
       | Just nm <- exportsAccessor e
       -- exports.foo means there's a dependency on the public member "foo" of
@@ -387,6 +370,9 @@ toModule mids mid filename top
   toModuleElement stmt
     | Just (visibility, name, decl) <- matchMember stmt
     = pure (Member stmt visibility name decl [])
+  toModuleElement stmt
+    | Just (name, block) <- matchBlock stmt
+    = pure (Block name block [])
   toModuleElement stmt
     | Just props <- matchExportsAssignment stmt
     = ExportsList <$> traverse toExport (trailingCommaList props)
@@ -395,7 +381,7 @@ toModule mids mid filename top
       toExport (JSPropertyNameandValue name _ [val]) =
         (,,val,[]) <$> exportType val
                    <*> extractLabel' name
-      toExport _ = err UnsupportedExport
+      toExport e = err $ UnsupportedExport $ "toExport: " <> show e
 
       exportType :: JSExpression -> m ExportType
       exportType (JSMemberDot f _ _)
@@ -405,9 +391,9 @@ toModule mids mid filename top
         | JSIdentifier _ "$foreign" <- f
         = pure ForeignReexport
       exportType (JSIdentifier _ s) = pure (RegularExport s)
-      exportType _ = err UnsupportedExport
+      exportType e = err $ UnsupportedExport $ "exportType: " <> show e
 
-      extractLabel' = maybe (err UnsupportedExport) pure . extractLabel
+      extractLabel' = maybe (err $ UnsupportedExport "extractLabel1") pure . extractLabel
 
   toModuleElement other = pure (Other other)
 
@@ -435,10 +421,10 @@ getExportedIdentifiers mname top
 
   toIdent (JSPropertyNameandValue name _ [_]) =
     extractLabel' name
-  toIdent _ =
-    err UnsupportedExport
+  toIdent e =
+    err $ UnsupportedExport $ "toIdent: " <> show e
 
-  extractLabel' = maybe (err UnsupportedExport) pure . extractLabel
+  extractLabel' = maybe (err $ UnsupportedExport "extractLabel2") pure . extractLabel
 
 -- Matches JS statements like this:
 -- var ModuleName = require("file");
@@ -468,6 +454,12 @@ matchMember stmt
   , JSIdentifier _ name <- var
   , JSVarInit _ decl <- varInit
   = Just (Internal, name, decl)
+  -- let foo = expr;
+  | JSLet _ jsInit _ <- stmt
+  , [JSVarInitExpression var varInit] <- commaList jsInit
+  , JSIdentifier _ name <- var
+  , JSVarInit _ decl <- varInit
+  = Just (Internal, name, decl)
   -- exports.foo = expr; exports["foo"] = expr;
   | JSAssignStatement e (JSAssign _) decl _ <- stmt
   , Just name <- exportsAccessor e
@@ -475,6 +467,13 @@ matchMember stmt
   | otherwise
   = Nothing
 
+matchBlock :: JSStatement -> Maybe (Maybe String, [JSStatement])
+matchBlock (JSLabelled (JSIdentName _ label) _ block)
+  | Just (Nothing, matched) <- matchBlock block
+  = Just (Just label, matched)
+matchBlock (JSStatementBlock _ block _ _) = Just (Nothing, block)
+matchBlock _ = Nothing
+
 -- Matches exports.* or exports["*"] expressions and returns the property name.
 exportsAccessor :: JSExpression -> Maybe String
 exportsAccessor (JSMemberDot exports _ nm)
@@ -524,6 +523,9 @@ compile modules entryPoints = filteredModules
     -- inlined wherever they are used inside other module elements.
     toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
     toVertices p m@(Member _ visibility nm _ deps) = [(m, (p, nm, visibility), deps)]
+    toVertices p m@(Block (Just init_name) _ deps)
+      | Just n <- CoreAST.dropInitializerName (TS.pack init_name)
+      = [(m, (p, TS.unpack n, Public), deps)]
     toVertices p m@(ExportsList exps) = map toVertex exps
       where
       toVertex (ForeignReexport, nm, _, ks) = (m, (p, nm, Public), ks)
@@ -532,10 +534,10 @@ compile modules entryPoints = filteredModules
 
   -- | The set of vertices whose connected components we are interested in keeping.
   entryPointVertices :: [Vertex]
-  entryPointVertices = catMaybes $ do
+  entryPointVertices = catMaybes (do
     (_, k@(mid, _, Public), _) <- verts
     guard $ mid `elem` entryPoints
-    return (vertexFor k)
+    return (vertexFor k))
 
   -- | The set of vertices reachable from an entry point
   reachableSet :: S.Set Vertex
@@ -557,15 +559,16 @@ compile modules entryPoints = filteredModules
       go :: [ModuleElement] -> [ModuleElement]
       go [] = []
       go (d : rest)
-        | not (isDeclUsed d) = skipDecl d : go rest
+        | not (isDeclUsed d) = skipDecl d ++ go rest
         | otherwise = d : go rest
 
-      skipDecl :: ModuleElement -> ModuleElement
-      skipDecl (Require s _ _) = Skip s
-      skipDecl (Member s _ _ _ _) = Skip s
-      skipDecl (ExportsList _) = Skip (JSEmptyStatement JSNoAnnot)
-      skipDecl (Other s) = Skip s
-      skipDecl (Skip s) = Skip s
+      skipDecl :: ModuleElement -> [ModuleElement]
+      skipDecl (Require s _ _) = [Skip s]
+      skipDecl (Member s _ _ _ _) = [Skip s]
+      skipDecl (Block _ s _) = map Skip s
+      skipDecl (ExportsList _) = [Skip (JSEmptyStatement JSNoAnnot)]
+      skipDecl (Other s) = [Skip s]
+      skipDecl (Skip s) = [Skip s]
 
       -- | Filter out the exports for members which aren't used.
       filterExports :: ModuleElement -> ModuleElement
@@ -574,6 +577,9 @@ compile modules entryPoints = filteredModules
 
       isDeclUsed :: ModuleElement -> Bool
       isDeclUsed (Member _ visibility nm _ _) = isKeyUsed (mid, nm, visibility)
+      isDeclUsed (Block (Just n) _ _)
+        | Just varName <- CoreAST.dropInitializerName (TS.pack n)
+        = isKeyUsed (mid, TS.unpack varName, Public)
       isDeclUsed (Require _ _ (Right midRef)) = midRef `S.member` modulesReferenced
       isDeclUsed _ = True
 
@@ -644,7 +650,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o
           map (\(porig, pgen) -> Mapping {
                 mapOriginal = Just (Pos (fromIntegral $ porig + 1) 0)
               , mapSourceFile = pathToFile <$> file
-              , mapGenerated = (Pos (fromIntegral $ pos + pgen) 0)
+              , mapGenerated = Pos (fromIntegral $ pos + pgen) 0
               , mapName = Nothing
               })
             (offsets (0,0) (Right 1 : positions)))
@@ -683,6 +689,8 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o
     declToJS :: ModuleElement -> ([JSStatement], Either Int Int)
     declToJS (Member n _ _ _ _) = withLength [n]
     declToJS (Other n) = withLength [n]
+    declToJS (Block Nothing b _) = withLength [JSStatementBlock JSAnnotSpace b JSAnnotSpace JSSemiAuto]
+    declToJS (Block (Just name) b _) = withLength [JSLabelled (JSIdentName JSAnnotSpace name) JSAnnotSpace (JSStatementBlock JSAnnotSpace b JSAnnotSpace JSSemiAuto)]
     declToJS (Skip n) = ([], Left $ moduleLength [n])
     declToJS (Require _ nm req) = withLength
       [
@@ -729,7 +737,7 @@ codeGen optionsMainModule optionsNamespace ms outFileOpt = (fmap sourceMapping o
     keepCol (TokenPn _ _ c) = TokenPn 0 0 (if c >= 0 then c + 2 else 2)
 
   prelude :: JSStatement
-  prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by purs bundle " ++ showVersion Paths.version
+  prelude = JSVariable (JSAnnot tokenPosnEmpty [ CommentA tokenPosnEmpty $ "// Generated by purs bundle " ++ showVersion Paths.version ++ ". Erlscripten edition!"
                                                , WhiteSpace tokenPosnEmpty "\n" ])
               (cList [
                 JSVarInitExpression (JSIdentifier sp optionsNamespace)
diff --git a/src/Language/PureScript/Bundle/Types.hs b/src/Language/PureScript/Bundle/Types.hs
new file mode 100644
index 0000000000..7a1714c6a7
--- /dev/null
+++ b/src/Language/PureScript/Bundle/Types.hs
@@ -0,0 +1,40 @@
+module Language.PureScript.Bundle.Types where
+
+import Data.Aeson ((.=))
+import qualified Data.Aeson as A
+import Prelude.Compat
+
+-- | Modules are either "regular modules" (i.e. those generated by the PureScript compiler) or
+-- foreign modules.
+data ModuleType
+  = Regular
+  | Foreign
+  deriving (Show, Eq, Ord)
+
+showModuleType :: ModuleType -> String
+showModuleType Regular = "Regular"
+showModuleType Foreign = "Foreign"
+
+-- | A module is identified by its module name and its type.
+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)
+
+instance A.ToJSON ModuleIdentifier where
+  toJSON (ModuleIdentifier name mt) =
+    A.object [ "name" .= name
+             , "type" .= show mt
+             ]
+
+moduleName :: ModuleIdentifier -> String
+moduleName (ModuleIdentifier name _) = name
+
+-- | The type of error messages. We separate generation and rendering of errors using a data
+-- type, in case we need to match on error types later.
+data ErrorMessage
+  = UnsupportedModulePath String
+  | InvalidTopLevel
+  | UnableToParseModule String
+  | UnsupportedExport String -- TODO REMOVE STIRNG
+  | ErrorInModule ModuleIdentifier ErrorMessage
+  | MissingEntryPoint String
+  | MissingMainModule String
+  deriving (Show)
diff --git a/src/Language/PureScript/CST/Monad.hs b/src/Language/PureScript/CST/Monad.hs
index eb7a3be456..39abcf083d 100644
--- a/src/Language/PureScript/CST/Monad.hs
+++ b/src/Language/PureScript/CST/Monad.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 module Language.PureScript.CST.Monad where
 
 import Prelude
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index f4ee7426bc..480f9e5398 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -3,6 +3,7 @@
 module Language.PureScript.CodeGen.JS
   ( module AST
   , module Common
+  , Env(..)
   , moduleToJs
   ) where
 
@@ -10,11 +11,12 @@ import Prelude.Compat
 import Protolude (ordNub)
 
 import Control.Arrow ((&&&))
-import Control.Monad (forM, replicateM, void)
+import Control.Monad (forM, replicateM, void, foldM)
 import Control.Monad.Except (MonadError, throwError)
-import Control.Monad.Reader (MonadReader, asks)
+import Control.Monad.Reader (MonadReader, asks, local)
 import Control.Monad.Supply.Class
 
+import Data.Bifunctor(first, second)
 import Data.List ((\\), intersect)
 import qualified Data.Foldable as F
 import qualified Data.Map as M
@@ -42,40 +44,80 @@ import qualified Language.PureScript.Constants as C
 
 import System.FilePath.Posix ((</>))
 
+data ContinuationKind = InExpr | InFun | InLet Text Text
+data Env = Env
+  { options :: Options
+  , vars :: VarEnv
+  , continuationKind :: ContinuationKind
+  , currentModule :: Maybe ModuleName
+  , inToplevel :: Bool
+  }
+
+runASTCont :: ContinuationKind -> AST -> AST
+runASTCont InExpr = id
+runASTCont InFun = AST.Return Nothing
+runASTCont (InLet breakRef i) =
+  \val -> AST.Block Nothing Nothing
+          [ AST.Assignment Nothing (AST.Var Nothing i) val
+          , AST.Break Nothing (Just breakRef)
+          ]
+
+type VarEnv = M.Map Text Text
+
 -- | Generate code in the simplified JavaScript intermediate representation for all declarations in a
 -- module.
 moduleToJs
   :: forall m
-   . (Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
+   . (Monad m, MonadReader Env m, MonadSupply m, MonadError MultipleErrors m)
   => Module Ann
   -> Maybe AST
   -> m [AST]
 moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
-  rethrow (addHint (ErrorInModule mn)) $ do
+  rethrow (addHint (ErrorInModule mn)) $ local (\e -> e{currentModule = Just mn}) $ do
     let usedNames = concatMap getNames decls
     let mnLookup = renameImports usedNames imps
     let decls' = renameModules mnLookup decls
-    jsDecls <- mapM bindToJs decls'
-    optimized <- traverse (traverse optimize) jsDecls
+
+    jsDecls <- inFun $ map snd <$> mapM bindToJs decls'
+    optimized <- map cleanupBlockStatements <$> traverse (traverse optimize) jsDecls
+
     let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup
     let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized
     jsImports <- traverse (importToJs mnLookup)
-      . filter (flip S.member usedModuleNames)
+      . filter (`S.member` usedModuleNames)
       . (\\ (mn : C.primModules)) $ ordNub $ map snd imps
     F.traverse_ (F.traverse_ checkIntegers) optimized
-    comments <- not <$> asks optionsNoComments
+    comments <- asks (not . optionsNoComments . options)
     let strict = AST.StringLiteral Nothing "use strict"
     let header = if comments && not (null coms) then AST.Comment Nothing coms strict else strict
     let foreign' = [AST.VariableIntroduction Nothing "$foreign" foreign_ | not $ null foreigns || isNothing foreign_]
     let moduleBody = header : foreign' ++ jsImports ++ concat optimized
     let foreignExps = exps `intersect` foreigns
     let standardExps = exps \\ foreignExps
-    let exps' = AST.ObjectLiteral Nothing $ map (mkString . runIdent &&& AST.Var Nothing . identToJs) standardExps
-                               ++ map (mkString . runIdent &&& foreignIdent) foreignExps
+    let exps' =
+          AST.ObjectLiteral Nothing $
+          map (mkString . runIdent &&&
+               AST.Var Nothing . identToJs
+              ) standardExps
+          ++ map (mkString . runIdent &&& foreignIdent) foreignExps
     return $ moduleBody ++ [AST.Assignment Nothing (accessorString "exports" (AST.Var Nothing "module")) exps']
 
   where
 
+  escapeTopLevel :: m a -> m a
+  escapeTopLevel = local $ \e -> e{inToplevel = False}
+
+  inLet :: MonadReader Env m => Text -> Text -> m a -> m a
+  inLet breakRef i = local $ \env ->
+    env{continuationKind = InLet breakRef i
+       }
+
+  inFun :: MonadReader Env m => m a -> m a
+  inFun = local $ \env -> env{continuationKind = InFun}
+
+  inExpr :: MonadReader Env m => m a -> m a
+  inExpr = local $ \env -> env{continuationKind = InExpr}
+
   -- | Extracts all declaration names from a binding group.
   getNames :: Bind Ann -> [Ident]
   getNames (NonRec _ ident _) = [ident]
@@ -142,27 +184,51 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
   -- |
   -- Generate code in the simplified JavaScript intermediate representation for a declaration
   --
-  bindToJs :: Bind Ann -> m [AST]
-  bindToJs (NonRec ann ident val) = return <$> nonRecToJS ann ident val
-  bindToJs (Rec vals) = forM vals (uncurry . uncurry $ nonRecToJS)
+  bindToJs :: Bind Ann -> m (VarEnv, [AST])
+  bindToJs (NonRec ann ident val) = do
+    let nameStr = identToJs ident
+    env <- do
+      inTop <- asks inToplevel
+      if inTop then return M.empty
+      else do newName <- freshNameHint nameStr
+              return (M.singleton nameStr newName)
+    local (\e -> e{vars = M.union env (vars e)}) $ do
+      ds <- nonRecToJS ann nameStr val
+      return (env, ds)
+  bindToJs (Rec vals) = do
+    env <- do
+      inTop <- asks inToplevel
+      if inTop then return M.empty
+      else fmap M.fromList $ forM vals $ \((_, ident), _) -> do
+         let nameStr = identToJs ident
+         newName <- freshNameHint nameStr
+         return (nameStr, newName)
+    ds <- local (\e -> e{vars = M.union env (vars e)}) $
+      fmap concat $ forM vals $ \((ann, ident), val) -> nonRecToJS ann (identToJs ident) val
+    return (env, ds)
 
   -- | Generate code in the simplified JavaScript intermediate representation for a single non-recursive
   -- declaration.
   --
   -- The main purpose of this function is to handle code generation for comments.
-  nonRecToJS :: Ann -> Ident -> Expr Ann -> m AST
+  nonRecToJS :: Ann -> Text -> Expr Ann -> m [AST]
   nonRecToJS a i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
-    withoutComment <- asks optionsNoComments
-    if withoutComment
-       then nonRecToJS a i (modifyAnn removeComments e)
-       else AST.Comment Nothing com <$> nonRecToJS a i (modifyAnn removeComments e)
-  nonRecToJS (ss, _, _, _) ident val = do
-    js <- valueToJs val
-    withPos ss $ AST.VariableIntroduction Nothing (identToJs ident) (Just js)
+    withoutComment <- asks $ optionsNoComments . options
+    js <- nonRecToJS a i (modifyAnn removeComments e)
+    return $ if withoutComment then js
+             else case js of
+                    []    -> js
+                    (h:t) -> AST.Comment Nothing com h : t
+  nonRecToJS (_, _, _, _) ident val = escapeTopLevel $ do
+    env <- asks vars
+    let solvedIdent = case M.lookup ident env of
+          Just ii -> ii
+          _ -> ident
+    bindToVar solvedIdent (valueToJs val)
 
   withPos :: SourceSpan -> AST -> m AST
   withPos ss js = do
-    withSM <- asks (elem JSSourceMap . optionsCodegenTargets)
+    withSM <- asks (elem JSSourceMap . optionsCodegenTargets . options)
     return $ if withSM
       then withSourceSpan ss js
       else js
@@ -183,28 +249,53 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
   accessorString :: PSString -> AST -> AST
   accessorString prop = AST.Indexer Nothing (AST.StringLiteral Nothing prop)
 
-  -- | Generate code in the simplified JavaScript intermediate representation for a value or expression.
-  valueToJs :: Expr Ann -> m AST
-  valueToJs e =
-    let (ss, _, _, _) = extractAnn e in
-    withPos ss =<< valueToJs' e
+  willHandleContinuationByItself :: Expr Ann -> Bool
+  willHandleContinuationByItself e = case e of
+    Let{} -> True
+    Case{} -> True
+    _ -> False
 
-  valueToJs' :: Expr Ann -> m AST
+  -- | Generate code in the simplified JavaScript intermediate representation for a value or expression.
+  valueToJs :: Expr Ann -> m ([AST], AST)
+  valueToJs e = do
+    let (ss, _, _, _) = extractAnn e
+    (ds, x) <- valueToJs' e
+    x' <- withPos ss x
+    finCont <- asks $ runASTCont . continuationKind
+    return (ds, if willHandleContinuationByItself e then x' else finCont x')
+
+  single :: AST -> m ([AST], AST)
+  single = return . ([],)
+
+  traverseCat f l = do
+    (ds, vs) <- unzip <$> traverse f l
+    return (concat ds, vs)
+
+  bindToVar :: Text -> m ([AST], AST) -> m [AST]
+  bindToVar v ex = do
+    let breakRef = AST.initializerName v
+    (ds, js) <- inLet breakRef v ex
+    return
+      (AST.VariableLetIntroduction Nothing v Nothing :
+       [AST.Block Nothing (Just breakRef) (ds ++ [js])]
+      )
+
+  valueToJs' :: Expr Ann -> m ([AST], AST)
   valueToJs' (Literal (pos, _, _, _) l) =
     rethrowWithPosition pos $ literalToValueJS pos l
   valueToJs' (Var (_, _, _, Just (IsConstructor _ [])) name) =
-    return $ accessorString "value" $ qualifiedToJS id name
+    single $ accessorString "value" $ qualifiedToJS id name
   valueToJs' (Var (_, _, _, Just (IsConstructor _ _)) name) =
-    return $ accessorString "create" $ qualifiedToJS id name
+    single $ accessorString "create" $ qualifiedToJS id name
   valueToJs' (Accessor _ prop val) =
-    accessorString prop <$> valueToJs val
+    second (accessorString prop) <$> inExpr (valueToJs val)
   valueToJs' (ObjectUpdate _ o ps) = do
-    obj <- valueToJs o
-    sts <- mapM (sndM valueToJs) ps
-    extendObj obj sts
-  valueToJs' e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
+    (dso, obj) <- inExpr $ valueToJs o
+    (dss, sts) <- inExpr $ traverseCat (fmap (\(p, (d, x)) -> (d, (p, x))) . sndM valueToJs) ps
+    first ((dso ++ dss) ++) <$> extendObj obj sts
+  valueToJs' e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) = do
     let args = unAbs e
-    in return $ AST.Function Nothing Nothing (map identToJs args) (AST.Block Nothing $ map assign args)
+    single $ AST.Function Nothing Nothing (map identToJs args) (AST.Block Nothing Nothing $ map assign args)
     where
     unAbs :: Expr Ann -> [Ident]
     unAbs (Abs _ arg val) = arg : unAbs val
@@ -213,73 +304,100 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
     assign name = AST.Assignment Nothing (accessorString (mkString $ runIdent name) (AST.Var Nothing "this"))
                                (var name)
   valueToJs' (Abs _ arg val) = do
-    ret <- valueToJs val
+    (ds, v) <- inFun $ valueToJs val
     let jsArg = case arg of
                   UnusedIdent -> []
                   _           -> [identToJs arg]
-    return $ AST.Function Nothing Nothing jsArg (AST.Block Nothing [AST.Return Nothing ret])
+    r <- single $ AST.Function Nothing Nothing jsArg (AST.Block Nothing Nothing $ ds ++ [v])
+    return r
   valueToJs' e@App{} = do
     let (f, args) = unApp e []
-    args' <- mapM valueToJs args
+    (dsa, args') <- inExpr $ traverseCat valueToJs args
     case f of
-      Var (_, _, _, Just IsNewtype) _ -> return (head args')
+      Var (_, _, _, Just IsNewtype) _ -> return (dsa, head args')
       Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields ->
-        return $ AST.Unary Nothing AST.New $ AST.App Nothing (qualifiedToJS id name) args'
+        return (dsa, AST.Unary Nothing AST.New $ AST.App Nothing (qualifiedToJS id name) args')
       Var (_, _, _, Just IsTypeClassConstructor) name ->
-        return $ AST.Unary Nothing AST.New $ AST.App Nothing (qualifiedToJS id name) args'
-      _ -> flip (foldl (\fn a -> AST.App Nothing fn [a])) args' <$> valueToJs f
+        return (dsa, AST.Unary Nothing AST.New $ AST.App Nothing (qualifiedToJS id name) args')
+      _ -> do
+        (dsf, v') <- inExpr $ valueToJs f
+        return (dsa ++ dsf, foldl (\fn a -> AST.App Nothing fn [a]) v' args')
     where
     unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
     unApp (App _ val arg) args = unApp val (arg : args)
     unApp other args = (other, args)
   valueToJs' (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =
-    return $ if mn' == mn
+    single $ if mn' == mn
              then foreignIdent ident
              else varToJs qi
   valueToJs' (Var (_, _, _, Just IsForeign) ident) =
     internalError $ "Encountered an unqualified reference to a foreign ident " ++ T.unpack (showQualified showIdent ident)
-  valueToJs' (Var _ ident) = return $ varToJs ident
+  valueToJs' (Var _ q@(Qualified qual i)) = do
+    env <- asks vars
+    currMod <- asks currentModule
+    single $
+      if isNothing qual || qual == currMod
+      then case M.lookup (identToJs i) env of
+        Nothing -> varToJs q
+        Just name -> AST.Var Nothing name
+      else varToJs q
   valueToJs' (Case (ss, _, _, _) values binders) = do
-    vals <- mapM valueToJs values
-    bindersToJs ss binders vals
+    (ds, vals) <- inExpr $ traverseCat valueToJs values
+    resVar <- freshNameHint "case"
+    contKind <- asks continuationKind
+    case contKind of
+      InFun -> do
+        val <- bindersToJs ss binders vals
+        return (ds, val)
+      _ -> do
+        dsr <- bindToVar resVar (([],) <$> bindersToJs ss binders vals)
+        return (ds ++ dsr, runASTCont contKind $ AST.Var Nothing resVar)
   valueToJs' (Let _ ds val) = do
-    ds' <- concat <$> mapM bindToJs ds
-    ret <- valueToJs val
-    return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (ds' ++ [AST.Return Nothing ret]))) []
+    env0 <- asks vars
+    let proceedDecl (prevEnv, prevDecls) decl' = do
+          (env'', decl'') <- local (\e -> e{vars = prevEnv}) $ bindToJs decl'
+          return (M.union env'' prevEnv, prevDecls . (decl'':))
+    (env1, ds') <- inExpr $ second ($[]) <$> foldM proceedDecl (env0, id) ds
+    (ds'', ret) <- local (\env -> env{vars = env1}) $ valueToJs val
+    return (concat ds' ++ ds'', ret)
   valueToJs' (Constructor (_, _, _, Just IsNewtype) _ ctor _) =
-    return $ AST.VariableIntroduction Nothing (properToJs ctor) (Just $
+    single $ AST.VariableLetIntroduction Nothing (properToJs ctor) (Just $
                 AST.ObjectLiteral Nothing [("create",
                   AST.Function Nothing Nothing ["value"]
-                    (AST.Block Nothing [AST.Return Nothing $ AST.Var Nothing "value"]))])
+                    (AST.Block Nothing Nothing [AST.Return Nothing $ AST.Var Nothing "value"]))])
   valueToJs' (Constructor _ _ ctor []) =
-    return $ iife (properToJs ctor) [ AST.Function Nothing (Just (properToJs ctor)) [] (AST.Block Nothing [])
+    single $ iife (properToJs ctor) [ AST.Function Nothing (Just (properToJs ctor)) [] (AST.Block Nothing Nothing [])
            , AST.Assignment Nothing (accessorString "value" (AST.Var Nothing (properToJs ctor)))
                 (AST.Unary Nothing AST.New $ AST.App Nothing (AST.Var Nothing (properToJs ctor)) []) ]
   valueToJs' (Constructor _ _ ctor fields) =
     let constructor =
           let body = [ AST.Assignment Nothing ((accessorString $ mkString $ identToJs f) (AST.Var Nothing "this")) (var f) | f <- fields ]
-          in AST.Function Nothing (Just (properToJs ctor)) (identToJs `map` fields) (AST.Block Nothing body)
+          in AST.Function Nothing (Just (properToJs ctor)) (identToJs `map` fields) (AST.Block Nothing Nothing body)
         createFn =
           let body = AST.Unary Nothing AST.New $ AST.App Nothing (AST.Var Nothing (properToJs ctor)) (var `map` fields)
-          in foldr (\f inner -> AST.Function Nothing Nothing [identToJs f] (AST.Block Nothing [AST.Return Nothing inner])) body fields
-    in return $ iife (properToJs ctor) [ constructor
+          in foldr (\f inner -> AST.Function Nothing Nothing [identToJs f] (AST.Block Nothing Nothing [AST.Return Nothing inner])) body fields
+    in single $ iife (properToJs ctor) [ constructor
                           , AST.Assignment Nothing (accessorString "create" (AST.Var Nothing (properToJs ctor))) createFn
                           ]
 
   iife :: Text -> [AST] -> AST
-  iife v exprs = AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing $ exprs ++ [AST.Return Nothing $ AST.Var Nothing v])) []
-
-  literalToValueJS :: SourceSpan -> Literal (Expr Ann) -> m AST
-  literalToValueJS ss (NumericLiteral (Left i)) = return $ AST.NumericLiteral (Just ss) (Left i)
-  literalToValueJS ss (NumericLiteral (Right n)) = return $ AST.NumericLiteral (Just ss) (Right n)
-  literalToValueJS ss (StringLiteral s) = return $ AST.StringLiteral (Just ss) s
-  literalToValueJS ss (CharLiteral c) = return $ AST.StringLiteral (Just ss) (fromString [c])
-  literalToValueJS ss (BooleanLiteral b) = return $ AST.BooleanLiteral (Just ss) b
-  literalToValueJS ss (ArrayLiteral xs) = AST.ArrayLiteral (Just ss) <$> mapM valueToJs xs
-  literalToValueJS ss (ObjectLiteral ps) = AST.ObjectLiteral (Just ss) <$> mapM (sndM valueToJs) ps
+  iife v exprs = AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing  Nothing $ exprs ++ [AST.Return Nothing $ AST.Var Nothing v])) []
+
+  literalToValueJS :: SourceSpan -> Literal (Expr Ann) -> m ([AST], AST)
+  literalToValueJS ss (NumericLiteral (Left i)) = single $ AST.NumericLiteral (Just ss) (Left i)
+  literalToValueJS ss (NumericLiteral (Right n)) = single $ AST.NumericLiteral (Just ss) (Right n)
+  literalToValueJS ss (StringLiteral s) = single $ AST.StringLiteral (Just ss) s
+  literalToValueJS ss (CharLiteral c) = single $ AST.StringLiteral (Just ss) (fromString [c])
+  literalToValueJS ss (BooleanLiteral b) = single $ AST.BooleanLiteral (Just ss) b
+  literalToValueJS ss (ArrayLiteral xs) = do
+    (declss, vals) <- traverseCat (inExpr . valueToJs) xs
+    return (declss, AST.ArrayLiteral (Just ss) vals)
+  literalToValueJS ss (ObjectLiteral ps) = do
+    (declss, vals) <- unzip . map (\(p, (d, x)) -> (d, (p, x))) <$> mapM (sndM (inExpr . valueToJs)) ps
+    return (concat declss, AST.ObjectLiteral (Just ss) vals)
 
   -- | Shallow copy an object.
-  extendObj :: AST -> [(PSString, AST)] -> m AST
+  extendObj :: AST -> [(PSString, AST)] -> m ([AST], AST)
   extendObj obj sts = do
     newObj <- freshName
     key <- freshName
@@ -288,15 +406,14 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
       jsKey = AST.Var Nothing key
       jsNewObj = AST.Var Nothing newObj
       jsEvaluatedObj = AST.Var Nothing evaluatedObj
-      block = AST.Block Nothing (evaluate:objAssign:copy:extend ++ [AST.Return Nothing jsNewObj])
-      evaluate = AST.VariableIntroduction Nothing evaluatedObj (Just obj)
-      objAssign = AST.VariableIntroduction Nothing newObj (Just $ AST.ObjectLiteral Nothing [])
-      copy = AST.ForIn Nothing key jsEvaluatedObj $ AST.Block Nothing [AST.IfElse Nothing cond assign Nothing]
+      evaluate = AST.VariableLetIntroduction Nothing evaluatedObj (Just obj)
+      objAssign = AST.VariableLetIntroduction Nothing newObj (Just $ AST.ObjectLiteral Nothing [])
+      copy = AST.ForIn Nothing key jsEvaluatedObj $ AST.Block Nothing Nothing [AST.IfElse Nothing cond assign Nothing]
       cond = AST.App Nothing (accessorString "call" (accessorString "hasOwnProperty" (AST.ObjectLiteral Nothing []))) [jsEvaluatedObj, jsKey]
-      assign = AST.Block Nothing [AST.Assignment Nothing (AST.Indexer Nothing jsKey jsNewObj) (AST.Indexer Nothing jsKey jsEvaluatedObj)]
+      assign = AST.Block Nothing Nothing [AST.Assignment Nothing (AST.Indexer Nothing jsKey jsNewObj) (AST.Indexer Nothing jsKey jsEvaluatedObj)]
       stToAssign (s, js) = AST.Assignment Nothing (accessorString s jsNewObj) js
       extend = map stToAssign sts
-    return $ AST.App Nothing (AST.Function Nothing Nothing [] block) []
+    return (evaluate:objAssign:copy:extend, jsNewObj)
 
   -- | Generate code in the simplified JavaScript intermediate representation for a reference to a
   -- variable.
@@ -317,14 +434,13 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
   -- | Generate code in the simplified JavaScript intermediate representation for pattern match binders
   -- and guards.
   bindersToJs :: SourceSpan -> [CaseAlternative Ann] -> [AST] -> m AST
-  bindersToJs ss binders vals = do
+  bindersToJs ss alts vals = do
     valNames <- replicateM (length vals) freshName
-    let assignments = zipWith (AST.VariableIntroduction Nothing) valNames (map Just vals)
-    jss <- forM binders $ \(CaseAlternative bs result) -> do
+    let assignments = zipWith (AST.VariableLetIntroduction Nothing) valNames (map Just vals)
+    jss <- forM alts $ \(CaseAlternative bs result) -> do
       ret <- guardsToJs result
       go valNames ret bs
-    return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing (assignments ++ concat jss ++ [AST.Throw Nothing $ failedPatternError valNames])))
-                   []
+    return $ AST.Block Nothing Nothing (assignments ++ concat jss ++ [AST.Throw Nothing $ failedPatternError valNames])
     where
       go :: [Text] -> [AST] -> [Binder Ann] -> m [AST]
       go _ done [] = return done
@@ -343,18 +459,36 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
       valueError _ l@(AST.NumericLiteral _ _) = l
       valueError _ l@(AST.StringLiteral _ _)  = l
       valueError _ l@(AST.BooleanLiteral _ _) = l
-      valueError s _                        = accessorString "name" . accessorString "constructor" $ AST.Var Nothing s
-
-      guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [AST]
-      guardsToJs (Left gs) = traverse genGuard gs where
-        genGuard (cond, val) = do
-          cond' <- valueToJs cond
-          val'   <- valueToJs val
-          return
-            (AST.IfElse Nothing cond'
-              (AST.Block Nothing [AST.Return Nothing val']) Nothing)
-
-      guardsToJs (Right v) = return . AST.Return Nothing <$> valueToJs v
+      valueError s _                          = accessorString "name" . accessorString "constructor" $ AST.Var Nothing s
+
+      guardsToJs :: Either [([Guard Ann], Expr Ann)] (Expr Ann) -> m [AST]
+      guardsToJs (Left gs) = do
+        let genGuard :: ([Guard Ann], Expr Ann) -> m AST
+            genGuard (conds, val) = do
+              rollback <- freshName
+              guardSeqJs <- guardSeqToJs (Just rollback) conds val
+              return $ AST.Block Nothing (Just rollback) guardSeqJs
+        traverse genGuard gs
+      guardsToJs (Right v) = do
+        guardSeqToJs Nothing [] v
+
+      guardSeqToJs :: Maybe Text -> [Guard Ann] -> Expr Ann -> m [AST]
+      guardSeqToJs _ [] fin = do
+        (ds, fin') <- valueToJs fin
+        return $ ds ++ [fin']
+      guardSeqToJs rollback (ConditionGuard e : rest) fin = do
+         (ds, val) <- inExpr $ valueToJs e
+         cont <- guardSeqToJs rollback rest fin
+         return $ ds ++
+           [ AST.IfElse Nothing val (AST.Block Nothing Nothing cont)
+             (AST.Break Nothing . Just <$> rollback)
+           ]
+      guardSeqToJs rollback (PatternGuard lv rv : rest) fin = do
+         (ds, rv') <- inExpr $ valueToJs rv
+         casevar <- freshName
+         cont <- guardSeqToJs rollback rest fin
+         bind <- binderToJs casevar cont lv
+         return $ ds ++ [AST.VariableLetIntroduction Nothing casevar (Just rv')] ++ bind ++ maybe [] ((:[]) . AST.Break Nothing . Just) rollback
 
   binderToJs :: Text -> [AST] -> Binder Ann -> m [AST]
   binderToJs s done binder =
@@ -368,7 +502,7 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
   binderToJs' varName done (LiteralBinder _ l) =
     literalToBinderJS varName done l
   binderToJs' varName done (VarBinder _ ident) =
-    return (AST.VariableIntroduction Nothing (identToJs ident) (Just (AST.Var Nothing varName)) : done)
+    return (AST.VariableLetIntroduction Nothing (identToJs ident) (Just (AST.Var Nothing varName)) : done)
   binderToJs' varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
     binderToJs varName done b
   binderToJs' varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do
@@ -377,7 +511,7 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
       ProductType -> js
       SumType ->
         [AST.IfElse Nothing (AST.InstanceOf Nothing (AST.Var Nothing varName) (qualifiedToJS (Ident . runProperName) ctor))
-                  (AST.Block Nothing js)
+                  (AST.Block Nothing Nothing js)
                   Nothing]
     where
     go :: [(Ident, Binder Ann)] -> [AST] -> m [AST]
@@ -386,24 +520,24 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
       argVar <- freshName
       done'' <- go remain done'
       js <- binderToJs argVar done'' binder
-      return (AST.VariableIntroduction Nothing argVar (Just $ accessorString (mkString $ identToJs field) $ AST.Var Nothing varName) : js)
+      return (AST.VariableLetIntroduction Nothing argVar (Just $ accessorString (mkString $ identToJs field) $ AST.Var Nothing varName) : js)
   binderToJs' _ _ ConstructorBinder{} =
     internalError "binderToJs: Invalid ConstructorBinder in binderToJs"
   binderToJs' varName done (NamedBinder _ ident binder) = do
     js <- binderToJs varName done binder
-    return (AST.VariableIntroduction Nothing (identToJs ident) (Just (AST.Var Nothing varName)) : js)
+    return (AST.VariableLetIntroduction Nothing (identToJs ident) (Just (AST.Var Nothing varName)) : js)
 
   literalToBinderJS :: Text -> [AST] -> Literal (Binder Ann) -> m [AST]
   literalToBinderJS varName done (NumericLiteral num) =
-    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.NumericLiteral Nothing num)) (AST.Block Nothing done) Nothing]
+    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.NumericLiteral Nothing num)) (AST.Block Nothing Nothing done) Nothing]
   literalToBinderJS varName done (CharLiteral c) =
-    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing (fromString [c]))) (AST.Block Nothing done) Nothing]
+    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing (fromString [c]))) (AST.Block Nothing Nothing done) Nothing]
   literalToBinderJS varName done (StringLiteral str) =
-    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing str)) (AST.Block Nothing done) Nothing]
+    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (AST.Var Nothing varName) (AST.StringLiteral Nothing str)) (AST.Block Nothing Nothing done) Nothing]
   literalToBinderJS varName done (BooleanLiteral True) =
-    return [AST.IfElse Nothing (AST.Var Nothing varName) (AST.Block Nothing done) Nothing]
+    return [AST.IfElse Nothing (AST.Var Nothing varName) (AST.Block Nothing Nothing done) Nothing]
   literalToBinderJS varName done (BooleanLiteral False) =
-    return [AST.IfElse Nothing (AST.Unary Nothing AST.Not (AST.Var Nothing varName)) (AST.Block Nothing done) Nothing]
+    return [AST.IfElse Nothing (AST.Unary Nothing AST.Not (AST.Var Nothing varName)) (AST.Block Nothing Nothing done) Nothing]
   literalToBinderJS varName done (ObjectLiteral bs) = go done bs
     where
     go :: [AST] -> [(PSString, Binder Ann)] -> m [AST]
@@ -412,10 +546,10 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
       propVar <- freshName
       done'' <- go done' bs'
       js <- binderToJs propVar done'' binder
-      return (AST.VariableIntroduction Nothing propVar (Just (accessorString prop (AST.Var Nothing varName))) : js)
+      return (AST.VariableLetIntroduction Nothing propVar (Just (accessorString prop (AST.Var Nothing varName))) : js)
   literalToBinderJS varName done (ArrayLiteral bs) = do
     js <- go done 0 bs
-    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (accessorString "length" (AST.Var Nothing varName)) (AST.NumericLiteral Nothing (Left (fromIntegral $ length bs)))) (AST.Block Nothing js) Nothing]
+    return [AST.IfElse Nothing (AST.Binary Nothing AST.EqualTo (accessorString "length" (AST.Var Nothing varName)) (AST.NumericLiteral Nothing (Left (fromIntegral $ length bs)))) (AST.Block Nothing Nothing js) Nothing]
     where
     go :: [AST] -> Integer -> [Binder Ann] -> m [AST]
     go done' _ [] = return done'
@@ -423,7 +557,7 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
       elVar <- freshName
       done'' <- go done' (index + 1) bs'
       js <- binderToJs elVar done'' binder
-      return (AST.VariableIntroduction Nothing elVar (Just (AST.Indexer Nothing (AST.NumericLiteral Nothing (Left index)) (AST.Var Nothing varName))) : js)
+      return (AST.VariableLetIntroduction Nothing elVar (Just (AST.Indexer Nothing (AST.NumericLiteral Nothing (Left index)) (AST.Var Nothing varName))) : js)
 
   -- Check that all integers fall within the valid int range for JavaScript.
   checkIntegers :: AST -> m ()
diff --git a/src/Language/PureScript/CodeGen/JS/Printer.hs b/src/Language/PureScript/CodeGen/JS/Printer.hs
index b69270cdac..79f67a08fa 100644
--- a/src/Language/PureScript/CodeGen/JS/Printer.hs
+++ b/src/Language/PureScript/CodeGen/JS/Printer.hs
@@ -61,8 +61,9 @@ literals = mkPattern' match'
           s'
         _ ->
           prettyPrintStringJS s
-  match (Block _ sts) = mconcat <$> sequence
-    [ return $ emit "{\n"
+  match (Block _ name sts) = mconcat <$> sequence
+    [ return $ maybe mempty (emit . (<> ": ")) name
+    , return $ emit "{\n"
     , withIndent $ prettyStatements sts
     , return $ emit "\n"
     , currentIndent
@@ -73,13 +74,18 @@ literals = mkPattern' match'
     [ return $ emit $ "var " <> ident
     , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintJS') value
     ]
+  match (VariableLetIntroduction _ ident value) = mconcat <$> sequence
+    [ return $ emit $ "let " <> ident
+    , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintJS') value
+    ]
   match (Assignment _ target value) = mconcat <$> sequence
     [ prettyPrintJS' target
     , return $ emit " = "
     , prettyPrintJS' value
     ]
-  match (While _ cond sts) = mconcat <$> sequence
-    [ return $ emit "while ("
+  match (While _ name cond sts) = mconcat <$> sequence
+    [ return $ maybe mempty (emit . (<> ": ")) name
+    , return $ emit "while ("
     , prettyPrintJS' cond
     , return $ emit ") "
     , prettyPrintJS' sts
@@ -98,6 +104,8 @@ literals = mkPattern' match'
     , return $ emit ") "
     , prettyPrintJS' sts
     ]
+  match (Break _ name) = return $ emit "break" <> maybe mempty (emit . (" " <>)) name
+  match (Continue _ name) = return $ emit "continue" <> maybe mempty (emit . (" " <>)) name
   match (IfElse _ cond thens elses) = mconcat <$> sequence
     [ return $ emit "if ("
     , prettyPrintJS' cond
@@ -122,7 +130,7 @@ literals = mkPattern' match'
   match _ = mzero
 
   comment :: (Emit gen) => Comment -> StateT PrinterState Maybe gen
-  comment (LineComment com) = fmap mconcat $ sequence $
+  comment (LineComment com) = fmap mconcat $ sequence
     [ currentIndent
     , return $ emit "//" <> emit com <> emit "\n"
     ]
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
index 547fe316c2..446b43eaf2 100644
--- a/src/Language/PureScript/CoreFn/Desugar.hs
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -124,17 +124,17 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
   altToCoreFn :: SourceSpan -> A.CaseAlternative -> CaseAlternative Ann
   altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn ss []) bs) (go vs)
     where
-    go :: [A.GuardedExpr] -> Either [(Guard Ann, Expr Ann)] (Expr Ann)
+    go :: [A.GuardedExpr] -> Either [([Guard Ann], Expr Ann)] (Expr Ann)
     go [A.MkUnguarded e]
       = Right (exprToCoreFn ss [] Nothing e)
     go gs
-      = Left [ (exprToCoreFn ss [] Nothing cond, exprToCoreFn ss [] Nothing e)
+      = Left [ (guard', exprToCoreFn ss [] Nothing e)
              | A.GuardedExpr g e <- gs
-             , let cond = guardToExpr g
+             , let guard' = map guardToCoreFn g
              ]
 
-    guardToExpr [A.ConditionGuard cond] = cond
-    guardToExpr _ = internalError "Guard not correctly desugared"
+    guardToCoreFn (A.ConditionGuard cond) = ConditionGuard (exprToCoreFn ss [] Nothing cond)
+    guardToCoreFn (A.PatternGuard lv rv) = PatternGuard (binderToCoreFn ss [] lv) (exprToCoreFn ss [] Nothing rv)
 
   -- | Desugars case binders from AST to CoreFn representation.
   binderToCoreFn :: SourceSpan -> [Comment] -> A.Binder -> Binder Ann
diff --git a/src/Language/PureScript/CoreFn/Expr.hs b/src/Language/PureScript/CoreFn/Expr.hs
index 981bf37c0f..fdfe6bc7c2 100644
--- a/src/Language/PureScript/CoreFn/Expr.hs
+++ b/src/Language/PureScript/CoreFn/Expr.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 -- |
 -- The core functional representation
 --
@@ -68,9 +69,11 @@ data Bind a
   | Rec [((a, Ident), Expr a)] deriving (Show, Functor)
 
 -- |
--- A guard is just a boolean-valued expression that appears alongside a set of binders
+-- A guard is just a boolean-valued expression that appears along side a set of binders
 --
-type Guard a = Expr a
+data Guard a = ConditionGuard (Expr a)
+             | PatternGuard (Binder a) (Expr a)
+  deriving (Show, Functor)
 
 -- |
 -- An alternative in a case statement
@@ -83,14 +86,14 @@ data CaseAlternative a = CaseAlternative
     -- |
     -- The result expression or a collect of guarded expressions
     --
-  , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
+  , caseAlternativeResult :: Either [([Guard a], Expr a)] (Expr a)
   } deriving (Show)
 
 instance Functor CaseAlternative where
 
   fmap f (CaseAlternative cabs car) = CaseAlternative
     (fmap (fmap f) cabs)
-    (either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)
+    (either (Left . fmap (fmap (fmap f) *** fmap f)) (Right . fmap f) car)
 
 -- |
 -- Extract the annotation from a term
@@ -106,7 +109,6 @@ extractAnn (Var a _) = a
 extractAnn (Case a _ _) = a
 extractAnn (Let a _ _) = a
 
-
 -- |
 -- Modify the annotation on a term
 --
diff --git a/src/Language/PureScript/CoreFn/FromJSON.hs b/src/Language/PureScript/CoreFn/FromJSON.hs
index 798ce2b843..68aec2de8b 100644
--- a/src/Language/PureScript/CoreFn/FromJSON.hs
+++ b/src/Language/PureScript/CoreFn/FromJSON.hs
@@ -246,19 +246,38 @@ caseAlternativeFromJSON modulePath = withObject "CaseAlternative" caseAlternativ
       isGuarded <- o .: "isGuarded"
       if isGuarded
         then do
-          es <- o .: "expressions" >>= listParser parseResultWithGuard
+          es <- o .: "expressions" >>= listParser parseResultWithGuards
           return $ CaseAlternative bs (Left es)
         else do
           e <- o .: "expression" >>= exprFromJSON modulePath
           return $ CaseAlternative bs (Right e)
 
-    parseResultWithGuard :: Value -> Parser (Guard Ann, Expr Ann)
-    parseResultWithGuard = withObject "parseCaseWithGuards" $
+    parseResultWithGuards :: Value -> Parser ([Guard Ann], Expr Ann)
+    parseResultWithGuards = withObject "parseCaseWithGuards" $
       \o -> do
-        g <- o .: "guard" >>= exprFromJSON modulePath
+        g <- o .: "guards" >>= listParser (guardFromJSON modulePath)
         e <- o .: "expression" >>= exprFromJSON modulePath
         return (g, e)
 
+guardFromJSON :: FilePath -> Value -> Parser (Guard Ann)
+guardFromJSON modulePath = withObject "Guard" guardFromObj
+  where
+    guardFromObj o = do
+      type_ <- o .: "guardType"
+      case type_ of
+        "ConditionGuard" -> conditionGuardFromObj o
+        "PatternGuard"   -> patternGuardFromObj o
+        _ -> fail ("not recognized guard: \"" ++ T.unpack type_ ++ "\"")
+
+    conditionGuardFromObj o = do
+      cond <- o .: "guardCondition" >>= exprFromJSON modulePath
+      return $ ConditionGuard cond
+
+    patternGuardFromObj o = do
+      lv <- o .: "guardLvalue" >>= binderFromJSON modulePath
+      rv <- o .: "guardRvalue" >>= exprFromJSON modulePath
+      return $ PatternGuard lv rv
+
 binderFromJSON :: FilePath -> Value -> Parser (Binder Ann)
 binderFromJSON modulePath = withObject "Binder" binderFromObj
   where
diff --git a/src/Language/PureScript/CoreFn/ToJSON.hs b/src/Language/PureScript/CoreFn/ToJSON.hs
index ec54c1e5c7..7ddabf0296 100644
--- a/src/Language/PureScript/CoreFn/ToJSON.hs
+++ b/src/Language/PureScript/CoreFn/ToJSON.hs
@@ -185,7 +185,7 @@ exprToJSON (Case ann ss cs)         = object [ T.pack "type"        .= "Case"
                                              , T.pack "caseAlternatives"
                                                                     .= map caseAlternativeToJSON cs
                                              ]
-exprToJSON (Let ann bs e)           = object [ T.pack "type"        .= "Let" 
+exprToJSON (Let ann bs e)           = object [ T.pack "type"        .= "Let"
                                              , T.pack "annotation"  .= annToJSON ann
                                              , T.pack "binds"       .= map bindToJSON bs
                                              , T.pack "expression"  .= exprToJSON e
@@ -199,10 +199,21 @@ caseAlternativeToJSON (CaseAlternative bs r') =
       , T.pack "isGuarded"   .= toJSON isGuarded
       , T.pack (if isGuarded then "expressions" else "expression")
          .= case r' of
-             Left rs -> toJSON $ map (\(g, e) -> object [ T.pack "guard" .= exprToJSON g, T.pack "expression" .= exprToJSON e]) rs
+             Left rs -> toJSON $ map (\(g, e) -> object [ T.pack "guards" .= toJSON (map guardToJSON g), T.pack "expression" .= exprToJSON e]) rs
              Right r -> exprToJSON r
       ]
 
+guardToJSON :: Guard Ann -> Value
+guardToJSON (ConditionGuard e)   = object
+  [ T.pack "guardType" .= "ConditionGuard"
+  , T.pack "guardCondition" .= exprToJSON e
+  ]
+guardToJSON (PatternGuard lv rv) = object
+  [ T.pack "guardType" .= "PatternGuard"
+  , T.pack "guardLvalue" .= binderToJSON lv
+  , T.pack "guardRvalue" .= exprToJSON rv
+  ]
+
 binderToJSON :: Binder Ann -> Value
 binderToJSON (VarBinder ann v)              = object [ T.pack "binderType"  .= "VarBinder"
                                                      , T.pack "annotation"  .= annToJSON ann
diff --git a/src/Language/PureScript/CoreFn/Traversals.hs b/src/Language/PureScript/CoreFn/Traversals.hs
index 5415911863..d8a1e5b6a9 100644
--- a/src/Language/PureScript/CoreFn/Traversals.hs
+++ b/src/Language/PureScript/CoreFn/Traversals.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- CoreFn traversal helpers
 --
@@ -5,12 +7,17 @@ module Language.PureScript.CoreFn.Traversals where
 
 import Prelude.Compat
 
+import Data.List(foldl')
 import Control.Arrow (second, (***), (+++))
 
 import Language.PureScript.AST.Literals
 import Language.PureScript.CoreFn.Binders
 import Language.PureScript.CoreFn.Expr
 
+strictMap :: (a -> b) -> [a] -> [b]
+strictMap _ [] = []
+strictMap f (h:t) = (f $! h) : strictMap f t
+
 everywhereOnValues :: (Bind a -> Bind a) ->
                       (Expr a -> Expr a) ->
                       (Binder a -> Binder a) ->
@@ -34,9 +41,12 @@ everywhereOnValues f g h = (f', g', h')
   h' (ConstructorBinder a q1 q2 bs) = h (ConstructorBinder a q1 q2 (map h' bs))
   h' b = h b
 
+  handleGuard (ConditionGuard e) = ConditionGuard (g' e)
+  handleGuard (PatternGuard p e) = PatternGuard (h' p) (g' e)
+
   handleCaseAlternative ca =
     ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
-       , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
+       , caseAlternativeResult = (map (map handleGuard *** g') +++ g') (caseAlternativeResult ca)
        }
 
   handleLiteral :: (a -> a) -> Literal a -> Literal a
@@ -53,24 +63,28 @@ everythingOnValues :: (r -> r -> r) ->
 everythingOnValues (<>.) f g h i = (f', g', h', i')
   where
   f' b@(NonRec _ _ e) = f b <>. g' e
-  f' b@(Rec es) = foldl (<>.) (f b) (map (g' . snd) es)
+  f' b@(Rec es) = foldl' (<>.) (f b) (map (g' . snd) es)
 
-  g' v@(Literal _ l) = foldl (<>.) (g v) (map g' (extractLiteral l))
+  g' v@(Literal _ l) = foldl' (<>.) (g v) (map g' (extractLiteral l))
   g' v@(Accessor _ _ e1) = g v <>. g' e1
-  g' v@(ObjectUpdate _ obj vs) = foldl (<>.) (g v <>. g' obj) (map (g' . snd) vs)
+  g' v@(ObjectUpdate _ obj vs) = foldl' (<>.) (g v <>. g' obj) (map (g' . snd) vs)
   g' v@(Abs _ _ e1) = g v <>. g' e1
   g' v@(App _ e1 e2) = g v <>. g' e1 <>. g' e2
-  g' v@(Case _ vs alts) = foldl (<>.) (foldl (<>.) (g v) (map g' vs)) (map i' alts)
-  g' v@(Let _ ds e1) = foldl (<>.) (g v) (map f' ds) <>. g' e1
+  g' v@(Case _ vs alts) = foldl' (<>.) (foldl' (<>.) (g v) (map g' vs)) (map i' alts)
+  g' v@(Let _ ds e1) = foldl' (<>.) (g v) (map f' ds) <>. g' e1
   g' v = g v
 
-  h' b@(LiteralBinder _ l) = foldl (<>.) (h b) (map h' (extractLiteral l))
-  h' b@(ConstructorBinder _ _ _ bs) = foldl (<>.) (h b) (map h' bs)
+  h' b@(LiteralBinder _ l) = foldl' (<>.) (h b) (map h' (extractLiteral l))
+  h' b@(ConstructorBinder _ _ _ bs) = foldl' (<>.) (h b) (map h' bs)
   h' b@(NamedBinder _ _ b1) = h b <>. h' b1
   h' b = h b
 
-  i' ca@(CaseAlternative bs (Right val)) = foldl (<>.) (i ca) (map h' bs) <>. g' val
-  i' ca@(CaseAlternative bs (Left gs)) = foldl (<>.) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
+  i' ca@(CaseAlternative bs (Right val)) = foldl' (<>.) (i ca) (map h' bs) <>. g' val
+  i' ca@(CaseAlternative bs (Left gs)) = foldl' (<>.) (i ca)
+    (map h' bs ++ concatMap (\(grd, val) -> map handleGuard grd ++ [g' val]) gs)
+
+  handleGuard (ConditionGuard e) = g' e
+  handleGuard (PatternGuard p e) = h' p <>. g' e
 
   extractLiteral (ArrayLiteral xs) = xs
   extractLiteral (ObjectLiteral xs) = map snd xs
diff --git a/src/Language/PureScript/CoreImp/AST.hs b/src/Language/PureScript/CoreImp/AST.hs
index b6dcad1446..3358747446 100644
--- a/src/Language/PureScript/CoreImp/AST.hs
+++ b/src/Language/PureScript/CoreImp/AST.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 -- | Data types for the imperative core AST
 module Language.PureScript.CoreImp.AST where
 
@@ -6,6 +7,8 @@ import Prelude.Compat
 import Control.Monad ((>=>))
 import Control.Monad.Identity (Identity(..), runIdentity)
 import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.List(foldl')
 
 import Language.PureScript.AST (SourceSpan(..))
 import Language.PureScript.Comments
@@ -68,18 +71,24 @@ data AST
   -- ^ Function application
   | Var (Maybe SourceSpan) Text
   -- ^ Variable
-  | Block (Maybe SourceSpan) [AST]
+  | Block (Maybe SourceSpan) (Maybe Text) [AST]
   -- ^ A block of expressions in braces
   | VariableIntroduction (Maybe SourceSpan) Text (Maybe AST)
   -- ^ A variable introduction and optional initialization
+  | VariableLetIntroduction (Maybe SourceSpan) Text (Maybe AST)
+  -- ^ A let variable introduction and optional initialization
   | Assignment (Maybe SourceSpan) AST AST
   -- ^ A variable assignment
-  | While (Maybe SourceSpan) AST AST
+  | While (Maybe SourceSpan) (Maybe Text) AST AST
   -- ^ While loop
   | For (Maybe SourceSpan) Text AST AST AST
   -- ^ For loop
   | ForIn (Maybe SourceSpan) Text AST AST
   -- ^ ForIn loop
+  | Break (Maybe SourceSpan) (Maybe Text)
+  -- ^ Loop break
+  | Continue (Maybe SourceSpan) (Maybe Text)
+  -- ^ Loop continue
   | IfElse (Maybe SourceSpan) AST AST (Maybe AST)
   -- ^ If-then-else statement
   | Return (Maybe SourceSpan) AST
@@ -94,6 +103,19 @@ data AST
   -- ^ Commented JavaScript
   deriving (Show, Eq)
 
+initializerPrefix :: Text
+initializerPrefix = "$init__"
+
+initializerName :: Text -> Text
+initializerName name = initializerPrefix <> name
+
+dropInitializerName :: Text -> Maybe Text
+dropInitializerName name =
+  let l = Text.length initializerPrefix
+  in case Text.splitAt l name of
+    (pref, rest) | pref == initializerPrefix -> Just rest
+    _ -> Nothing
+
 withSourceSpan :: SourceSpan -> AST -> AST
 withSourceSpan withSpan = go where
   ss :: Maybe SourceSpan
@@ -111,12 +133,15 @@ withSourceSpan withSpan = go where
   go (Function _ name args j) = Function ss name args j
   go (App _ j js) = App ss j js
   go (Var _ s) = Var ss s
-  go (Block _ js) = Block ss js
+  go (Block _ n js) = Block ss n js
   go (VariableIntroduction _ name j) = VariableIntroduction ss name j
+  go (VariableLetIntroduction _ name j) = VariableLetIntroduction ss name j
   go (Assignment _ j1 j2) = Assignment ss j1 j2
-  go (While _ j1 j2) = While ss j1 j2
+  go (While _ name j1 j2) = While ss name j1 j2
   go (For _ name j1 j2 j3) = For ss name j1 j2 j3
   go (ForIn _ name j1 j2) = ForIn ss name j1 j2
+  go (Break _ name) = Break ss name
+  go (Continue _ name) = Continue ss name
   go (IfElse _ j1 j2 j3) = IfElse ss j1 j2 j3
   go (Return _ js) = Return ss js
   go (ReturnNoResult _) = ReturnNoResult ss
@@ -138,12 +163,15 @@ getSourceSpan = go where
   go (Function ss _ _ _) = ss
   go (App ss _ _) = ss
   go (Var ss _) = ss
-  go (Block ss _) = ss
+  go (Block ss _ _) = ss
   go (VariableIntroduction ss _ _) = ss
+  go (VariableLetIntroduction ss _ _) = ss
   go (Assignment ss _ _) = ss
-  go (While ss _ _) = ss
+  go (While ss _ _ _) = ss
   go (For ss _ _ _ _) = ss
   go (ForIn ss _ _ _) = ss
+  go (Break ss _) = ss
+  go (Continue ss _) = ss
   go (IfElse ss _ _ _) = ss
   go (Return ss _) = ss
   go (ReturnNoResult ss) = ss
@@ -161,10 +189,11 @@ everywhere f = go where
   go (ObjectLiteral ss js) = f (ObjectLiteral ss (map (fmap go) js))
   go (Function ss name args j) = f (Function ss name args (go j))
   go (App ss j js) = f (App ss (go j) (map go js))
-  go (Block ss js) = f (Block ss (map go js))
+  go (Block ss n js) = f (Block ss n (map go js))
   go (VariableIntroduction ss name j) = f (VariableIntroduction ss name (fmap go j))
+  go (VariableLetIntroduction ss name j) = f (VariableLetIntroduction ss name (fmap go j))
   go (Assignment ss j1 j2) = f (Assignment ss (go j1) (go j2))
-  go (While ss j1 j2) = f (While ss (go j1) (go j2))
+  go (While ss name j1 j2) = f (While ss name (go j1) (go j2))
   go (For ss name j1 j2 j3) = f (For ss name (go j1) (go j2) (go j3))
   go (ForIn ss name j1 j2) = f (ForIn ss name (go j1) (go j2))
   go (IfElse ss j1 j2 j3) = f (IfElse ss (go j1) (go j2) (fmap go j3))
@@ -187,10 +216,11 @@ everywhereTopDownM f = f >=> go where
   go (ObjectLiteral ss js) = ObjectLiteral ss <$> traverse (sndM f') js
   go (Function ss name args j) = Function ss name args <$> f' j
   go (App ss j js) = App ss <$> f' j <*> traverse f' js
-  go (Block ss js) = Block ss <$> traverse f' js
+  go (Block ss n js) = Block ss n <$> traverse f' js
   go (VariableIntroduction ss name j) = VariableIntroduction ss name <$> traverse f' j
+  go (VariableLetIntroduction ss name j) = VariableLetIntroduction ss name <$> traverse f' j
   go (Assignment ss j1 j2) = Assignment ss <$> f' j1 <*> f' j2
-  go (While ss j1 j2) = While ss <$> f' j1 <*> f' j2
+  go (While ss name j1 j2) = While ss name <$> f' j1 <*> f' j2
   go (For ss name j1 j2 j3) = For ss name <$> f' j1 <*> f' j2 <*> f' j3
   go (ForIn ss name j1 j2) = ForIn ss name <$> f' j1 <*> f' j2
   go (IfElse ss j1 j2 j3) = IfElse ss <$> f' j1 <*> f' j2 <*> traverse f' j3
@@ -204,15 +234,16 @@ everything :: (r -> r -> r) -> (AST -> r) -> AST -> r
 everything (<>.) f = go where
   go j@(Unary _ _ j1) = f j <>. go j1
   go j@(Binary _ _ j1 j2) = f j <>. go j1 <>. go j2
-  go j@(ArrayLiteral _ js) = foldl (<>.) (f j) (map go js)
+  go j@(ArrayLiteral _ js) = foldl' (<>.) (f j) (map go js)
   go j@(Indexer _ j1 j2) = f j <>. go j1 <>. go j2
-  go j@(ObjectLiteral _ js) = foldl (<>.) (f j) (map (go . snd) js)
+  go j@(ObjectLiteral _ js) = foldl' (<>.) (f j) (map (go . snd) js)
   go j@(Function _ _ _ j1) = f j <>. go j1
-  go j@(App _ j1 js) = foldl (<>.) (f j <>. go j1) (map go js)
-  go j@(Block _ js) = foldl (<>.) (f j) (map go js)
+  go j@(App _ j1 js) = foldl' (<>.) (f j <>. go j1) (map go js)
+  go j@(Block _ _ js) = foldl' (<>.) (f j) (map go js)
   go j@(VariableIntroduction _ _ (Just j1)) = f j <>. go j1
+  go j@(VariableLetIntroduction _ _ (Just j1)) = f j <>. go j1
   go j@(Assignment _ j1 j2) = f j <>. go j1 <>. go j2
-  go j@(While _ j1 j2) = f j <>. go j1 <>. go j2
+  go j@(While _ _ j1 j2) = f j <>. go j1 <>. go j2
   go j@(For _ _ j1 j2 j3) = f j <>. go j1 <>. go j2 <>. go j3
   go j@(ForIn _ _ j1 j2) = f j <>. go j1 <>. go j2
   go j@(IfElse _ j1 j2 Nothing) = f j <>. go j1 <>. go j2
diff --git a/src/Language/PureScript/CoreImp/Optimizer.hs b/src/Language/PureScript/CoreImp/Optimizer.hs
index de92116251..dfbb3a0f58 100644
--- a/src/Language/PureScript/CoreImp/Optimizer.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer.hs
@@ -17,7 +17,7 @@
 --  * Inline Prelude.($), Prelude.(#), Prelude.(++), Prelude.(!!)
 --
 --  * Inlining primitive JavaScript operators
-module Language.PureScript.CoreImp.Optimizer (optimize) where
+module Language.PureScript.CoreImp.Optimizer (optimize, cleanupBlockStatements) where
 
 import Prelude.Compat
 
@@ -30,6 +30,7 @@ import Language.PureScript.CoreImp.Optimizer.MagicDo
 import Language.PureScript.CoreImp.Optimizer.TCO
 import Language.PureScript.CoreImp.Optimizer.Unused
 
+
 -- | Apply a series of optimizer passes to simplified JavaScript code
 optimize :: MonadSupply m => AST -> m AST
 optimize js = do
@@ -58,5 +59,5 @@ untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
 untilFixedPoint f = go
   where
   go a = do
-   a' <- f a
-   if a' == a then return a' else go a'
+    a' <- f a
+    if a' == a then return a' else go a'
diff --git a/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs b/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs
index 04febf2039..7eca22c103 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs
@@ -2,9 +2,14 @@
 module Language.PureScript.CoreImp.Optimizer.Blocks
   ( collapseNestedBlocks
   , collapseNestedIfs
+  , cleanupBlockStatements
   ) where
 
 import Prelude.Compat
+import qualified Data.Map as M
+import Data.Maybe
+import Language.PureScript.Comments
+import Language.PureScript.AST.SourcePos
 
 import Language.PureScript.CoreImp.AST
 
@@ -12,17 +17,61 @@ import Language.PureScript.CoreImp.AST
 collapseNestedBlocks :: AST -> AST
 collapseNestedBlocks = everywhere collapse where
   collapse :: AST -> AST
-  collapse (Block ss sts) = Block ss (concatMap go sts)
+  collapse (Block ss n sts) = Block ss n (cleanupBlockStatements $ concatMap go sts)
   collapse js = js
-  
+
   go :: AST -> [AST]
-  go (Block _ sts) = sts
+  go (Block _ Nothing sts) = sts
   go s = [s]
 
+cleanupBlockStatements :: [AST] -> [AST]
+cleanupBlockStatements block = bringBackComments (go noComments) [] where
+
+  stripComments :: [AST]
+                -> Int
+                -> [([Int], AST)]
+                -> M.Map Int [(Maybe SourceSpan, [Comment])]
+                -> ([([Int], AST)], M.Map Int [(Maybe SourceSpan, [Comment])])
+  stripComments (Comment ss com h : t) n acc strip =
+    stripComments (h:t) n acc (M.insertWith (++) n [(ss, com)] strip)
+  stripComments (h:t) n acc strip =
+    stripComments t (n + 1) (([n], h):acc) strip
+  stripComments [] _ acc strip =
+    (reverse acc, strip)
+
+  (noComments, comments) = stripComments block 0 [] M.empty
+
+  bringBackComments :: [([Int], AST)] -> [AST] -> [AST]
+  bringBackComments [] acc = reverse acc
+  bringBackComments ((ids, ast):rest) acc =
+    let coms = concat $ mapMaybe (`M.lookup` comments) ids
+    in bringBackComments rest (foldr (\(ss, com) r -> Comment ss com r) ast coms : acc)
+
+  go :: [([Int], AST)] -> [([Int], AST)]
+  -- TODO: ensure e1 is PURE
+  go ((n1, IfElse ss e1 b1 Nothing) : (n2, IfElse _ e2 b2 Nothing) : t)
+    | e1 == e2 = go $ (n1 ++ n2, IfElse ss e1 (Block ss Nothing [b1, b2]) Nothing) : t
+  go ((n1, IfElse ss1 e1 b1 Nothing):(n2, IfElse ss2 (Binary _ And e2 e3) b2 me) : t)
+    | e1 == e2 = go $ (n1 ++ n2, IfElse ss1 e1 (Block ss1 Nothing [b1, IfElse ss2 e3 b2 me]) Nothing) : t
+  go ((n1, Block ss l sts1) : (n2, Block _ Nothing sts2) : t) = go $ (n1 ++ n2, Block ss l (sts1 ++ sts2)) : t
+  go ((n1, VariableLetIntroduction ss1 name1 Nothing) : (n2, Block _ (Just label1) [Assignment _ (Var _ name2) js, Break _ (Just label2)]) : t)
+    | name1 == name2, label1 == label2 = (n1 ++ n2, VariableLetIntroduction ss1 name1 (Just js)) : go t
+  go ((n, js@(Return _ _)):_) = [(n, js)]
+  go ((n, js@(ReturnNoResult _)):_) = [(n, js)]
+  go ((n, js@(Throw _ _)):_) = [(n, js)]
+  go ((n, js@(Break _ _)):_) = [(n, js)]
+  go ((n, js@(Continue _ _)):_) = [(n, js)]
+
+  go (h:t) = h : go t
+  go [] = []
+
 collapseNestedIfs :: AST -> AST
 collapseNestedIfs = everywhere collapse where
   collapse :: AST -> AST
-  collapse (IfElse _ (BooleanLiteral _ True) (Block _ [js]) _) = js
-  collapse (IfElse s1 cond1 (Block _ [IfElse s2 cond2 body Nothing]) Nothing) =
+  collapse (IfElse _ (BooleanLiteral _ True) (Block _ _ [js]) _) = js
+  collapse (IfElse _ (BooleanLiteral _ False) _ (Just (Block _ _ [js]))) = js
+  collapse (IfElse _ (BooleanLiteral _ True) js _) = js
+  collapse (IfElse _ (BooleanLiteral _ False) _ (Just js)) = js
+  collapse (IfElse s1 cond1 (Block _ Nothing [IfElse s2 cond2 body Nothing]) Nothing) =
       IfElse s1 (Binary s2 And cond1 cond2) body Nothing
   collapse js = js
diff --git a/src/Language/PureScript/CoreImp/Optimizer/Common.hs b/src/Language/PureScript/CoreImp/Optimizer/Common.hs
index 040995cb36..16c536566d 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/Common.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/Common.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 -- | Common functions used by the various optimizer phases
 module Language.PureScript.CoreImp.Optimizer.Common where
 
@@ -11,38 +12,45 @@ import Language.PureScript.Crash
 import Language.PureScript.CoreImp.AST
 import Language.PureScript.PSString (PSString)
 
+{-# INLINE applyAll #-}
 applyAll :: [a -> a] -> a -> a
-applyAll = foldl' (.) id
+applyAll l x = foldl' (flip ($!)) x l
 
+{-# INLINE replaceIdent #-}
 replaceIdent :: Text -> AST -> AST -> AST
 replaceIdent var1 js = everywhere replace
   where
   replace (Var _ var2) | var1 == var2 = js
   replace other = other
 
+{-# INLINE replaceIdents #-}
 replaceIdents :: [(Text, AST)] -> AST -> AST
 replaceIdents vars = everywhere replace
   where
   replace v@(Var _ var) = fromMaybe v $ lookup var vars
   replace other = other
 
+{-# INLINE isReassigned #-}
 isReassigned :: Text -> AST -> Bool
 isReassigned var1 = everything (||) check
   where
   check :: AST -> Bool
   check (Function _ _ args _) | var1 `elem` args = True
   check (VariableIntroduction _ arg _) | var1 == arg = True
+  check (VariableLetIntroduction _ arg _) | var1 == arg = True
   check (Assignment _ (Var _ arg) _) | var1 == arg = True
   check (For _ arg _ _ _) | var1 == arg = True
   check (ForIn _ arg _ _) | var1 == arg = True
   check _ = False
 
+{-# INLINE isRebound #-}
 isRebound :: AST -> AST -> Bool
 isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everything (++) variablesOf js)
   where
   variablesOf (Var _ var) = [var]
   variablesOf _ = []
 
+{-# INLINE isUsed #-}
 isUsed :: Text -> AST -> Bool
 isUsed var1 = everything (||) check
   where
@@ -51,11 +59,13 @@ isUsed var1 = everything (||) check
   check (Assignment _ target _) | var1 == targetVariable target = True
   check _ = False
 
+{-# INLINE targetVariable #-}
 targetVariable :: AST -> Text
 targetVariable (Var _ var) = var
 targetVariable (Indexer _ _ tgt) = targetVariable tgt
 targetVariable _ = internalError "Invalid argument to targetVariable"
 
+{-# INLINE isUpdated #-}
 isUpdated :: Text -> AST -> Bool
 isUpdated var1 = everything (||) check
   where
@@ -63,14 +73,17 @@ isUpdated var1 = everything (||) check
   check (Assignment _ target _) | var1 == targetVariable target = True
   check _ = False
 
+{-# INLINE removeFromBlock #-}
 removeFromBlock :: ([AST] -> [AST]) -> AST -> AST
-removeFromBlock go (Block ss sts) = Block ss (go sts)
+removeFromBlock go (Block ss n sts) = Block ss n (go sts)
 removeFromBlock _  js = js
 
+{-# INLINE isDict #-}
 isDict :: (Text, PSString) -> AST -> Bool
 isDict (moduleName, dictName) (Indexer _ (StringLiteral _ x) (Var _ y)) =
   x == dictName && y == moduleName
 isDict _ _ = False
 
+{-# INLINE isDict' #-}
 isDict' :: [(Text, PSString)] -> AST -> Bool
 isDict' xs js = any (`isDict` js) xs
diff --git a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
index 4b627abd06..e7ce415eb3 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 -- | This module performs basic inlining of known functions
 module Language.PureScript.CoreImp.Optimizer.Inliner
   ( inlineVariables
@@ -43,31 +44,31 @@ etaConvert :: AST -> AST
 etaConvert = everywhere convert
   where
   convert :: AST -> AST
-  convert (Block ss [Return _ (App _ (Function _ Nothing idents block@(Block _ body)) args)])
+  convert (Block ss n [Return _ (App _ (Function _ Nothing idents block@(Block _ _ body)) args)])
     | all shouldInline args &&
-      not (any (`isRebound` block) (map (Var Nothing) idents)) &&
+      not (any ((`isRebound` block) . Var Nothing) idents) &&
       not (any (`isRebound` block) args)
-      = Block ss (map (replaceIdents (zip idents args)) body)
-  convert (Function _ Nothing [] (Block _ [Return _ (App _ fn [])])) = fn
+      = Block ss n (map (replaceIdents (zip idents args)) body)
+  convert (Function _ Nothing [] (Block _ Nothing [Return _ (App _ fn [])])) = fn
   convert js = js
 
 unThunk :: AST -> AST
 unThunk = everywhere convert
   where
   convert :: AST -> AST
-  convert (Block ss []) = Block ss []
-  convert (Block ss jss) =
+  convert (Block ss n []) = Block ss n []
+  convert (Block ss n jss) =
     case last jss of
-      Return _ (App _ (Function _ Nothing [] (Block _ body)) []) -> Block ss $ init jss ++ body
-      _ -> Block ss jss
+      Return _ (App _ (Function _ Nothing [] (Block _ Nothing body)) []) -> Block ss n $ init jss ++ body
+      _ -> Block ss n jss
   convert js = js
 
 evaluateIifes :: AST -> AST
 evaluateIifes = everywhere convert
   where
   convert :: AST -> AST
-  convert (App _ (Function _ Nothing [] (Block _ [Return _ ret])) []) = ret
-  convert (App _ (Function _ Nothing idents (Block _ [Return ss ret])) [])
+  convert (App _ (Function _ Nothing [] (Block _ _ [Return _ ret])) []) = ret
+  convert (App _ (Function _ Nothing idents (Block _ _ [Return ss ret])) [])
     | not (any (`isReassigned` ret) idents) = replaceIdents (map (, Var ss C.undefined) idents) ret
   convert js = js
 
@@ -79,6 +80,9 @@ inlineVariables = everywhere $ removeFromBlock go
   go (VariableIntroduction _ var (Just js) : sts)
     | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
       go (map (replaceIdent var js) sts)
+  go (VariableLetIntroduction _ var (Just js) : sts)
+    | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
+      go (map (replaceIdent var js) sts)
   go (s:sts) = s : go sts
 
 inlineCommonValues :: AST -> AST
@@ -194,16 +198,16 @@ inlineCommonOperators = everywhereTopDown $ applyAll $
 
   mkFn :: Int -> AST -> AST
   mkFn = mkFn' C.dataFunctionUncurried C.mkFn $ \ss1 ss2 ss3 args js ->
-    Function ss1 Nothing args (Block ss2 [Return ss3 js])
+    Function ss1 Nothing args (Block ss2 Nothing [Return ss3 js])
 
   mkEffFn :: Text -> Text -> Int -> AST -> AST
   mkEffFn modName fnName = mkFn' modName fnName $ \ss1 ss2 ss3 args js ->
-    Function ss1 Nothing args (Block ss2 [Return ss3 (App ss3 js [])])
+    Function ss1 Nothing args (Block ss2 Nothing [Return ss3 (App ss3 js [])])
 
   mkFn' :: Text -> Text -> (Maybe SourceSpan -> Maybe SourceSpan -> Maybe SourceSpan -> [Text] -> AST -> AST) -> Int -> AST -> AST
   mkFn' modName fnName res 0 = convert where
     convert :: AST -> AST
-    convert (App _ mkFnN [Function s1 Nothing [_] (Block s2 [Return s3 js])]) | isNFn modName fnName 0 mkFnN =
+    convert (App _ mkFnN [Function s1 Nothing [_] (Block s2 Nothing [Return s3 js])]) | isNFn modName fnName 0 mkFnN =
       res s1 s2 s3 [] js
     convert other = other
   mkFn' modName fnName res n = convert where
@@ -214,8 +218,8 @@ inlineCommonOperators = everywhereTopDown $ applyAll $
         _ -> orig
     convert other = other
     collectArgs :: Int -> [Text] -> AST -> Maybe ([Text], [AST])
-    collectArgs 1 acc (Function _ Nothing [oneArg] (Block _ js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
-    collectArgs m acc (Function _ Nothing [oneArg] (Block _ [Return _ ret])) = collectArgs (m - 1) (oneArg : acc) ret
+    collectArgs 1 acc (Function _ Nothing [oneArg] (Block _ _ js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
+    collectArgs m acc (Function _ Nothing [oneArg] (Block _ _ [Return _ ret])) = collectArgs (m - 1) (oneArg : acc) ret
     collectArgs _ _   _ = Nothing
 
   isNFn :: Text -> Text -> Int -> AST -> Bool
@@ -228,7 +232,7 @@ inlineCommonOperators = everywhereTopDown $ applyAll $
 
   runEffFn :: Text -> Text -> Int -> AST -> AST
   runEffFn modName fnName = runFn' modName fnName $ \ss fn acc ->
-    Function ss Nothing [] (Block ss [Return ss (App ss fn acc)])
+    Function ss Nothing [] (Block ss Nothing [Return ss (App ss fn acc)])
 
   runFn' :: Text -> Text -> (Maybe SourceSpan -> AST -> [AST] -> AST) -> Int -> AST -> AST
   runFn' modName runFnName res n = convert where
@@ -270,10 +274,10 @@ inlineFnComposition = everywhereTopDownM convert where
   convert other = return other
 
   mkApps :: Maybe SourceSpan -> [Either AST (Text, AST)] -> Text -> AST
-  mkApps ss fns a = App ss (Function ss Nothing [] (Block ss $ vars <> [Return Nothing comp])) []
+  mkApps ss fns a = App ss (Function ss Nothing [] (Block ss Nothing $ vars <> [Return Nothing comp])) []
     where
     vars = uncurry (VariableIntroduction ss) . fmap Just <$> rights fns
-    comp = Function ss Nothing [a] (Block ss [Return Nothing apps])
+    comp = Function ss Nothing [a] (Block ss Nothing [Return Nothing apps])
     apps = foldr (\fn acc -> App ss (mkApp fn) [acc]) (Var ss a) fns
 
   mkApp :: Either AST (Text, AST) -> AST
@@ -283,7 +287,7 @@ inlineFnComposition = everywhereTopDownM convert where
   goApps (App _ (App _ (App _ fn [dict']) [x]) [y])
     | isFnCompose dict' fn = mappend <$> goApps x <*> goApps y
     | isFnComposeFlipped dict' fn = mappend <$> goApps y <*> goApps x
-  goApps app@(App {}) = pure . Right . (,app) <$> freshName
+  goApps app@App{} = pure . Right . (,app) <$> freshName
   goApps other = pure [Left other]
 
   isFnCompose :: AST -> AST -> Bool
diff --git a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
index c14988f50a..0cf9894a51 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
@@ -46,26 +46,26 @@ magicDo effectModule C.EffectDictionaries{..} = everywhereTopDown convert
   -- Desugar pure
   convert (App _ (App _ pure' [val]) []) | isPure pure' = val
   -- Desugar discard
-  convert (App _ (App _ bind [m]) [Function s1 Nothing [] (Block s2 js)]) | isDiscard bind =
-    Function s1 (Just fnName) [] $ Block s2 (App s2 m [] : map applyReturns js )
+  convert (App _ (App _ bind [m]) [Function s1 Nothing [] (Block s2 n js)]) | isDiscard bind =
+    Function s1 (Just fnName) [] $ Block s2 n (App s2 m [] : map applyReturns js )
   -- Desugar bind to wildcard
-  convert (App _ (App _ bind [m]) [Function s1 Nothing [] (Block s2 js)])
+  convert (App _ (App _ bind [m]) [Function s1 Nothing [] (Block s2 n js)])
     | isBind bind =
-    Function s1 (Just fnName) [] $ Block s2 (App s2 m [] : map applyReturns js )
+    Function s1 (Just fnName) [] $ Block s2 n (App s2 m [] : map applyReturns js )
   -- Desugar bind
-  convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 js)]) | isBind bind =
-    Function s1 (Just fnName) [] $ Block s2 (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns js)
+  convert (App _ (App _ bind [m]) [Function s1 Nothing [arg] (Block s2 n js)]) | isBind bind =
+    Function s1 (Just fnName) [] $ Block s2 n (VariableIntroduction s2 arg (Just (App s2 m [])) : map applyReturns js)
   -- Desugar untilE
   convert (App s1 (App _ f [arg]) []) | isEffFunc edUntil f =
-    App s1 (Function s1 Nothing [] (Block s1 [ While s1 (Unary s1 Not (App s1 arg [])) (Block s1 []), Return s1 $ ObjectLiteral s1 []])) []
+    App s1 (Function s1 Nothing [] (Block s1 Nothing [ While s1 Nothing (Unary s1 Not (App s1 arg [])) (Block s1 Nothing []), Return s1 $ ObjectLiteral s1 []])) []
   -- Desugar whileE
   convert (App _ (App _ (App s1 f [arg1]) [arg2]) []) | isEffFunc edWhile f =
-    App s1 (Function s1 Nothing [] (Block s1 [ While s1 (App s1 arg1 []) (Block s1 [ App s1 arg2 [] ]), Return s1 $ ObjectLiteral s1 []])) []
+    App s1 (Function s1 Nothing [] (Block s1 Nothing [ While s1 Nothing (App s1 arg1 []) (Block s1 Nothing [ App s1 arg2 [] ]), Return s1 $ ObjectLiteral s1 []])) []
   -- Inline __do returns
   convert (Return _ (App _ (Function _ (Just ident) [] body) [])) | ident == fnName = body
   -- Inline double applications
-  convert (App _ (App s1 (Function s2 Nothing [] (Block ss body)) []) []) =
-    App s1 (Function s2 Nothing [] (Block ss (applyReturns `fmap` body))) []
+  convert (App _ (App s1 (Function s2 Nothing [] (Block ss n body)) []) []) =
+    App s1 (Function s2 Nothing [] (Block ss n (applyReturns `fmap` body))) []
   convert other = other
   -- Check if an expression represents a monomorphic call to >>= for the Eff monad
   isBind (App _ fn [dict]) | isDict (effectModule, edBindDict) dict && isBindPoly fn = True
@@ -91,8 +91,8 @@ magicDo effectModule C.EffectDictionaries{..} = everywhereTopDown convert
 
   applyReturns :: AST -> AST
   applyReturns (Return ss ret) = Return ss (App ss ret [])
-  applyReturns (Block ss jss) = Block ss (map applyReturns jss)
-  applyReturns (While ss cond js) = While ss cond (applyReturns js)
+  applyReturns (Block ss n jss) = Block ss n (map applyReturns jss)
+  applyReturns (While ss name cond js) = While ss name cond (applyReturns js)
   applyReturns (For ss v lo hi js) = For ss v lo hi (applyReturns js)
   applyReturns (ForIn ss v xs js) = ForIn ss v xs (applyReturns js)
   applyReturns (IfElse ss cond t f) = IfElse ss cond (applyReturns t) (applyReturns `fmap` f)
@@ -116,7 +116,7 @@ inlineST = everywhere convertBlock
   -- or in a more aggressive way, turning wrappers into local variables depending on the
   -- agg(ressive) parameter.
   convert agg (App s1 f [arg]) | isSTFunc C.newSTRef f =
-   Function s1 Nothing [] (Block s1 [Return s1 $ if agg then arg else ObjectLiteral s1 [(mkString C.stRefValue, arg)]])
+   Function s1 Nothing [] (Block s1 Nothing [Return s1 $ if agg then arg else ObjectLiteral s1 [(mkString C.stRefValue, arg)]])
   convert agg (App _ (App s1 f [ref]) []) | isSTFunc C.readSTRef f =
     if agg then ref else Indexer s1 (StringLiteral s1 C.stRefValue) ref
   convert agg (App _ (App _ (App s1 f [arg]) [ref]) []) | isSTFunc C.writeSTRef f =
diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
index 5f2123ced6..c1a2b260ca 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
@@ -3,174 +3,174 @@ module Language.PureScript.CoreImp.Optimizer.TCO (tco) where
 
 import Prelude.Compat
 
-import Control.Applicative (empty, liftA2)
-import Control.Monad (guard)
-import Control.Monad.State (State, evalState, get, modify)
-import Data.Foldable (foldr)
-import Data.Functor (($>), (<&>))
-import qualified Data.Set as S
+import Debug.Trace
+
+import Control.Monad.State
+import Data.Functor ((<&>))
 import Data.Text (Text, pack)
 import qualified Language.PureScript.Constants as C
 import Language.PureScript.CoreImp.AST
-import Language.PureScript.AST.SourcePos (SourceSpan)
 import Safe (headDef, tailSafe)
 
+data TCOState = TCOState
+  { supply :: !Int
+  -- | If there is a variable return right after the block end
+  -- then assignment to that variable and breaking will be considered
+  -- as a TCO candidate
+  , returnBlock :: ![(Text, Text)]
+  , tailCalls :: !Int
+  }
+emptyTCOState :: TCOState
+emptyTCOState = TCOState
+  { supply = 0
+  , returnBlock = []
+  , tailCalls = 0
+  }
+
+fresh :: State TCOState Int
+fresh = do
+  x <- gets supply
+  modify (\s -> s{supply = x + 1})
+  return x
+
+inBlock :: Text -> Text -> State TCOState a -> State TCOState a
+inBlock breakL retvar act = do
+  prev <- gets returnBlock
+  modify' (\s -> s{returnBlock = (breakL, retvar):prev})
+  r <- act
+  modify' (\s -> s{returnBlock = prev})
+  return r
+
+incrTailCount :: State TCOState ()
+incrTailCount = modify (\s -> s{tailCalls = tailCalls s + 1})
+
+resetTailCount :: State TCOState ()
+resetTailCount = modify (\s -> s{tailCalls = 0})
+
 -- | Eliminate tail calls
 tco :: AST -> AST
-tco = flip evalState 0 . everywhereTopDownM convert where
+tco = flip evalState emptyTCOState . everywhereTopDownM convertAST where
+  uniq :: Text -> State TCOState Text
+  uniq v = fresh <&> \count -> v <>
+    if count == 0 then "" else pack . show $ count
+
   tcoVar :: Text -> Text
   tcoVar arg = "$tco_var_" <> arg
 
   copyVar :: Text -> Text
   copyVar arg = "$copy_" <> arg
 
-  tcoDoneM :: State Int Text
-  tcoDoneM = get <&> \count -> "$tco_done" <>
-    if count == 0 then "" else pack . show $ count
-
-  tcoLoop :: Text
-  tcoLoop = "$tco_loop"
-
-  tcoResult :: Text
-  tcoResult = "$tco_result"
-
-  convert :: AST -> State Int AST
-  convert (VariableIntroduction ss name (Just fn@Function {}))
-      | Just trFns <- findTailRecursiveFns name arity body'
-      = VariableIntroduction ss name . Just . replace <$> toLoop trFns name arity outerArgs innerArgs body'
-    where
+  tcoLoopM :: State TCOState Text
+  tcoLoopM = uniq "$tco_loop"
+
+  convertAST :: AST -> State TCOState AST
+  convertAST js@(VariableLetIntroduction ss name (Just fn@Function {})) = do
+    conv <- convert name fn
+    return $ case conv of
+      Just looped -> VariableLetIntroduction ss name (Just looped)
+      _ -> js
+  convertAST js@(VariableIntroduction ss name (Just fn@Function {})) = do
+    conv <- convert name fn
+    return $ case conv of
+      Just looped -> VariableIntroduction ss name (Just looped)
+      _ -> js
+  convertAST js@(Assignment ss (Var vss name) fn@Function {}) = do
+    conv <- convert name fn
+    return $ case conv of
+      Just looped -> Assignment ss (Var vss name) looped
+      _ -> js
+  convertAST js = pure js
+
+  convert :: Text -> AST -> State TCOState (Maybe AST)
+  convert name fn = do
+    let
       innerArgs = headDef [] argss
       outerArgs = concat . reverse $ tailSafe argss
       arity = length argss
       -- ^ this is the number of calls, not the number of arguments, if there's
       -- ever a practical difference.
       (argss, body', replace) = topCollectAllFunctionArgs [] id fn
-  convert js = pure js
+
+    looped <- toLoop name arity outerArgs innerArgs body'
+
+    tcs <- gets tailCalls
+    resetTailCount
+    return $ if tcs == 0
+      then Nothing
+      else Just $ replace looped
 
   rewriteFunctionsWith :: ([Text] -> [Text]) -> [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
   rewriteFunctionsWith argMapper = collectAllFunctionArgs
     where
-    collectAllFunctionArgs allArgs f (Function s1 ident args (Block s2 (body@(Return _ _):_))) =
-      collectAllFunctionArgs (args : allArgs) (\b -> f (Function s1 ident (argMapper args) (Block s2 [b]))) body
-    collectAllFunctionArgs allArgs f (Function ss ident args body@(Block _ _)) =
+    collectAllFunctionArgs allArgs f (Function s1 ident args (Block s2 n (body@(Return _ _):_))) =
+      collectAllFunctionArgs (args : allArgs) (\b -> f (Function s1 ident (argMapper args) (Block s2 n [b]))) body
+    collectAllFunctionArgs allArgs f (Function ss ident args body@Block{}) =
       (args : allArgs, body, f . Function ss ident (argMapper args))
-    collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args (Block s3 [body]))) =
-      collectAllFunctionArgs (args : allArgs) (\b -> f (Return s1 (Function s2 ident (argMapper args) (Block s3 [b])))) body
-    collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args body@(Block _ _))) =
+    collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args (Block s3 n [body]))) =
+      collectAllFunctionArgs (args : allArgs) (\b -> f (Return s1 (Function s2 ident (argMapper args) (Block s3 n [b])))) body
+    collectAllFunctionArgs allArgs f (Return s1 (Function s2 ident args body@Block{})) =
       (args : allArgs, body, f . Return s1 . Function s2 ident (argMapper args))
     collectAllFunctionArgs allArgs f body = (allArgs, body, f)
 
   topCollectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
   topCollectAllFunctionArgs = rewriteFunctionsWith (map copyVar)
 
-  innerCollectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
-  innerCollectAllFunctionArgs = rewriteFunctionsWith id
-
-  countReferences :: Text -> AST -> Int
-  countReferences ident = everything (+) match where
-    match :: AST -> Int
-    match (Var _ ident') | ident == ident' = 1
-    match _ = 0
-
-  -- If `ident` is a tail-recursive function, returns a set of identifiers
-  -- that are locally bound to functions participating in the tail recursion.
-  -- Otherwise, returns Nothing.
-  findTailRecursiveFns :: Text -> Int -> AST -> Maybe (S.Set Text)
-  findTailRecursiveFns ident arity js = guard (countReferences ident js > 0) *> go (S.empty, S.singleton (ident, arity))
-    where
-
-    go :: (S.Set Text, S.Set (Text, Int)) -> Maybe (S.Set Text)
-    go (known, required) =
-      case S.minView required of
-        Just (r, required') -> do
-          required'' <- findTailPositionDeps r js
-          go (S.insert (fst r) known, required' <> (S.filter (not . (`S.member` known) . fst) required''))
-        Nothing ->
-          pure known
-
-  -- Returns set of identifiers (with their arities) that need to be used
-  -- exclusively in tail calls using their full arity in order for this
-  -- identifier to be considered in tail position (or Nothing if this
-  -- identifier is used somewhere not as a tail call with full arity).
-  findTailPositionDeps :: (Text, Int) -> AST -> Maybe (S.Set (Text, Int))
-  findTailPositionDeps (ident, arity) js = allInTailPosition js where
-    countSelfReferences = countReferences ident
-
-    allInTailPosition (Return _ expr)
-      | isSelfCall ident arity expr = guard (countSelfReferences expr == 1) $> S.empty
-      | otherwise = guard (countSelfReferences expr == 0) $> S.empty
-    allInTailPosition (While _ js1 body)
-      = guard (countSelfReferences js1 == 0) *> allInTailPosition body
-    allInTailPosition (For _ _ js1 js2 body)
-      = guard (countSelfReferences js1 == 0 && countSelfReferences js2 == 0) *> allInTailPosition body
-    allInTailPosition (ForIn _ _ js1 body)
-      = guard (countSelfReferences js1 == 0) *> allInTailPosition body
-    allInTailPosition (IfElse _ js1 body el)
-      = guard (countSelfReferences js1 == 0) *> liftA2 mappend (allInTailPosition body) (foldMapA allInTailPosition el)
-    allInTailPosition (Block _ body)
-      = foldMapA allInTailPosition body
-    allInTailPosition (Throw _ js1)
-      = guard (countSelfReferences js1 == 0) $> S.empty
-    allInTailPosition (ReturnNoResult _)
-      = pure S.empty
-    allInTailPosition (VariableIntroduction _ _ Nothing)
-      = pure S.empty
-    allInTailPosition (VariableIntroduction _ ident' (Just js1))
-      | countSelfReferences js1 == 0 = pure S.empty
-      | Function _ Nothing _ _ <- js1
-      , (argss, body, _) <- innerCollectAllFunctionArgs [] id js1
-        = S.insert (ident', length argss) <$> allInTailPosition body
-      | otherwise = empty
-    allInTailPosition (Assignment _ _ js1)
-      = guard (countSelfReferences js1 == 0) $> S.empty
-    allInTailPosition (Comment _ _ js1)
-      = allInTailPosition js1
-    allInTailPosition _
-      = empty
-
-  toLoop :: S.Set Text -> Text -> Int -> [Text] -> [Text] -> AST -> State Int AST
-  toLoop trFns ident arity outerArgs innerArgs js = do
-    tcoDone <- tcoDoneM
-    modify (+ 1)
+  toLoop :: Text -> Int -> [Text] -> [Text] -> AST -> State TCOState AST
+  toLoop ident arity outerArgs innerArgs js = do
+    tcoLoop <- tcoLoopM
 
     let
-      markDone :: Maybe SourceSpan -> AST
-      markDone ss = Assignment ss (Var ss tcoDone) (BooleanLiteral ss True)
-
-      loopify :: AST -> AST
-      loopify (Return ss ret)
-        | isSelfCall ident arity ret =
-          let
-            allArgumentValues = concat $ collectArgs [] ret
-          in
-            Block ss $
-              zipWith (\val arg ->
-                Assignment ss (Var ss (tcoVar arg)) val) allArgumentValues outerArgs
-              ++ zipWith (\val arg ->
-                Assignment ss (Var ss (copyVar arg)) val) (drop (length outerArgs) allArgumentValues) innerArgs
-              ++ [ ReturnNoResult ss ]
-        | isIndirectSelfCall ret = Return ss ret
-        | otherwise = Block ss [ markDone ss, Return ss ret ]
-      loopify (ReturnNoResult ss) = Block ss [ markDone ss, ReturnNoResult ss ]
-      loopify (While ss cond body) = While ss cond (loopify body)
-      loopify (For ss i js1 js2 body) = For ss i js1 js2 (loopify body)
-      loopify (ForIn ss i js1 body) = ForIn ss i js1 (loopify body)
-      loopify (IfElse ss cond body el) = IfElse ss cond (loopify body) (fmap loopify el)
-      loopify (Block ss body) = Block ss (map loopify body)
-      loopify (VariableIntroduction ss f (Just fn@(Function _ Nothing _ _)))
-        | (_, body, replace) <- innerCollectAllFunctionArgs [] id fn
-        , f `S.member` trFns = VariableIntroduction ss f (Just (replace (loopify body)))
-      loopify other = other
-
-    pure $ Block rootSS $
+      makeTailJump ss ret = do
+        incrTailCount
+        let allArgumentValues = concat $ collectArgs [] ret
+        return $ Block ss Nothing $
+          zipWith (\val arg ->
+                     Assignment ss (Var ss (tcoVar arg)) val) allArgumentValues outerArgs
+          ++ zipWith (\val arg ->
+                        Assignment ss (Var ss (copyVar arg)) val) (drop (length outerArgs) allArgumentValues) innerArgs
+          ++ [Continue ss (Just tcoLoop)]
+
+      loopify :: AST -> State TCOState AST
+      loopify (Return ss ret) | isSelfCall ident arity ret
+                                        = makeTailJump ss ret
+      loopify (While ss name cond body) = While ss name cond <$> loopify body
+      loopify (For ss i js1 js2 body)   = For ss i js1 js2 <$> loopify body
+      loopify (ForIn ss i js1 body)     = ForIn ss i js1 <$> loopify body
+      loopify (IfElse ss cond body el)  = IfElse ss cond <$> loopify body <*> mapM loopify el
+      loopify (Block ss n body)         = Block ss n <$> loopifyBlock body
+      loopify other                     = return other
+
+      loopifyBlock :: [AST] -> State TCOState [AST]
+      loopifyBlock [] = return []
+      loopifyBlock (Block ss (Just n) body : ret@(Return _ (Var _ var)) : _) =
+        (:[ret]) . Block ss (Just n) <$> inBlock n var (loopifyBlock body)
+      loopifyBlock (h1@(Block ss (Just n) body) : h2@(Assignment _ (Var _ out) (Var _ in_)) : h3@(Break _ (Just block)) : _) = do
+        rb <- gets returnBlock
+        if any (\(rbBlock, rbVar) -> rbBlock == block && rbVar == out) rb
+          then
+              sequence [Block ss (Just n) <$> inBlock n in_ (loopifyBlock body), pure h2, pure h3]
+          else traverse loopify [h1, h2, h3]
+      loopifyBlock (h1@(Assignment _ (Var _ v) expr) : h2@(Break _ (Just block)) : _) = do
+        rb <- gets returnBlock
+        if any (\(rbBlock, rbVar) -> rbBlock == block && rbVar == v) rb
+          then
+              if isSelfCall ident arity expr
+              then (:[]) <$> makeTailJump Nothing expr
+              else return [Return Nothing expr]
+          else traverse loopify [h1, h2]
+
+      loopifyBlock (h:t) = (:) <$> loopify h <*> loopifyBlock t
+
+    looped <- loopify js
+
+    pure $ Block rootSS Nothing $
         map (\arg -> VariableIntroduction rootSS (tcoVar arg) (Just (Var rootSS (copyVar arg)))) outerArgs ++
-        [ VariableIntroduction rootSS tcoDone (Just (BooleanLiteral rootSS False))
-        , VariableIntroduction rootSS tcoResult Nothing
-        , Function rootSS (Just tcoLoop) (outerArgs ++ innerArgs) (Block rootSS [loopify js])
-        , While rootSS (Unary rootSS Not (Var rootSS tcoDone))
-            (Block rootSS
-              [(Assignment rootSS (Var rootSS tcoResult) (App rootSS (Var rootSS tcoLoop) ((map (Var rootSS . tcoVar) outerArgs) ++ (map (Var rootSS . copyVar) innerArgs))))])
-        , Return rootSS (Var rootSS tcoResult)
+        [ While rootSS (Just tcoLoop) (BooleanLiteral Nothing True)
+          (Block rootSS Nothing $
+            map (\v -> VariableLetIntroduction rootSS v (Just . Var rootSS . tcoVar $ v)) outerArgs ++
+            map (\v -> VariableLetIntroduction rootSS v (Just . Var rootSS . copyVar $ v)) innerArgs ++
+            [looped]
+          )
         ]
     where
     rootSS = Nothing
@@ -182,15 +182,7 @@ tco = flip evalState 0 . everywhereTopDownM convert where
     collectArgs acc (App _ fn args') = collectArgs (args' : acc) fn
     collectArgs acc _ = acc
 
-    isIndirectSelfCall :: AST -> Bool
-    isIndirectSelfCall (App _ (Var _ ident') _) = ident' `S.member` trFns
-    isIndirectSelfCall (App _ fn _) = isIndirectSelfCall fn
-    isIndirectSelfCall _ = False
-
   isSelfCall :: Text -> Int -> AST -> Bool
   isSelfCall ident 1 (App _ (Var _ ident') _) = ident == ident'
   isSelfCall ident arity (App _ fn _) = isSelfCall ident (arity - 1) fn
   isSelfCall _ _ _ = False
-
-foldMapA :: (Applicative f, Monoid w, Foldable t) => (a -> f w) -> t a -> f w
-foldMapA f = foldr (liftA2 mappend . f) (pure mempty)
diff --git a/src/Language/PureScript/Docs/Collect.hs b/src/Language/PureScript/Docs/Collect.hs
index 2c64384d61..3f1926d2b1 100644
--- a/src/Language/PureScript/Docs/Collect.hs
+++ b/src/Language/PureScript/Docs/Collect.hs
@@ -105,6 +105,8 @@ compileForDocs outputDir inputFiles = do
   renderProgressMessage :: P.ProgressMessage -> String
   renderProgressMessage (P.CompilingModule mn) =
     "Compiling documentation for " ++ T.unpack (P.runModuleName mn)
+  renderProgressMessage msg =
+    "Progress: " ++ show msg
 
   testOptions :: P.Options
   testOptions = P.defaultOptions { P.optionsCodegenTargets = Set.singleton P.Docs }
diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs
index dfee03bd5a..05007acd82 100644
--- a/src/Language/PureScript/Make.hs
+++ b/src/Language/PureScript/Make.hs
@@ -48,6 +48,8 @@ import qualified Language.PureScript.CoreFn as CF
 import           System.Directory (doesFileExist)
 import           System.FilePath (replaceExtension)
 
+import Debug.Trace
+
 -- | Rebuild a single module.
 --
 -- This function is used for fast-rebuild workflows (PSCi and psc-ide are examples).
@@ -92,10 +94,12 @@ rebuildModule' MakeActions{..} exEnv externs m@(Module _ _ moduleName _ _) = do
   (deguarded, nextVar'') <- runSupplyT nextVar' $ do
     desugarCaseGuards elaborated
 
-  progress $ CollapseBindingGroupsModule moduleName
-  regrouped <- createBindingGroups moduleName . collapseBindingGroups $ deguarded
+  seq (last deguarded) $ progress $ CollapseBindingGroupsModule moduleName
+  let collapsed = collapseBindingGroups deguarded
+  seq (last collapsed) $ progress $ CreateBindingGroupsModule moduleName
+  regrouped <- createBindingGroups moduleName collapsed
   let mod' = Module ss coms moduleName regrouped exps
-  progress $ CoreFnGenModule moduleName
+  seq (last regrouped) $ progress $ CoreFnGenModule moduleName
   let corefn = CF.moduleToCoreFn env' mod'
   progress $ CoreFnOptModule moduleName
   let optimized = CF.optimizeCoreFn corefn
@@ -118,7 +122,7 @@ rebuildModule' MakeActions{..} exEnv externs m@(Module _ _ moduleName _ _) = do
                  ++ "; details:\n" ++ prettyPrintMultipleErrors defaultPPEOptions errs
                Right d -> d
 
-  progress $ CodegenModule moduleName
+  seq exts $ progress $ CodegenModule moduleName
   evalSupplyT nextVar'' $ codegen renamed docs exts
   progress $ DoneModule moduleName
   return exts
@@ -138,12 +142,17 @@ make ma@MakeActions{..} ms = do
   (sorted, graph) <- sortModules (moduleSignature . CST.resPartial) ms
 
   (buildPlan, newCacheDb) <- BuildPlan.construct ma cacheDb (sorted, graph)
+  -- Fork and let a separate thread handle the cache
+  rChan <- C.newChan
+  buildPlan' <- BuildPlan.setResultChannel buildPlan (Just rChan)
+  doneMVar <- C.newEmptyMVar
+  _ <- fork $ handleCache rChan cacheDb newCacheDb doneMVar
 
-  let toBeRebuilt = filter (BuildPlan.needsRebuild buildPlan . getModuleName . CST.resPartial) sorted
+  let toBeRebuilt = filter (BuildPlan.needsRebuild buildPlan' . getModuleName . CST.resPartial) sorted
   for_ toBeRebuilt $ \m -> fork $ do
     let moduleName = getModuleName . CST.resPartial $ m
     let deps = fromMaybe (internalError "make: module not found in dependency graph.") (lookup moduleName graph)
-    buildModule buildPlan moduleName
+    buildModule buildPlan' moduleName
       (spanName . getModuleSourceSpan . CST.resPartial $ m)
       (importPrim <$> CST.resFull m)
       (deps `inOrderOf` map (getModuleName . CST.resPartial) sorted)
@@ -159,10 +168,12 @@ make ma@MakeActions{..} ms = do
         BuildJobSkipped ->
           Left mempty
     in
-      M.mapEither splitResults <$> BuildPlan.collectResults buildPlan
+      M.mapEither splitResults <$> BuildPlan.collectResults buildPlan'
 
-  -- Write the updated build cache database to disk
-  writeCacheDb $ Cache.removeModules (M.keysSet failures) newCacheDb
+  -- Notify the cache handler that we are done
+  _ <- BuildPlan.setResultChannel buildPlan' Nothing
+  -- And wait for it to save everything
+  _ <- C.takeMVar doneMVar
 
   -- If generating docs, also generate them for the Prim modules
   outputPrimDocs
@@ -237,6 +248,22 @@ make ma@MakeActions{..} ms = do
 
     BuildPlan.markComplete buildPlan moduleName result
 
+  handleCache :: ResultChannel -> Cache.CacheDb -> Cache.CacheDb -> MVar () -> m ()
+  handleCache rChan curDB finalDB doneMVar = do
+    r <- readChan rChan
+    case r of
+      Nothing -> do -- We are done
+        C.putMVar doneMVar ()
+        return ()
+      Just (mn, BuildJobSucceeded _ _) -> do -- Job succeeded - update cache key
+        let newDB = Cache.updateModule mn curDB finalDB
+        writeCacheDb newDB
+        handleCache rChan newDB finalDB doneMVar
+      Just (mn, _) -> do -- Job failed - remove cache key
+        let newDB = Cache.removeModule mn curDB
+        writeCacheDb newDB
+        handleCache rChan newDB finalDB doneMVar
+
 -- | Infer the module name for a module by looking for the same filename with
 -- a .js extension.
 inferForeignModules
diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs
index 8b6b367613..47fb6c65c4 100644
--- a/src/Language/PureScript/Make/Actions.hs
+++ b/src/Language/PureScript/Make/Actions.hs
@@ -46,7 +46,6 @@ import           Language.PureScript.Externs (ExternsFile, externsFileName)
 import           Language.PureScript.Make.Monad
 import           Language.PureScript.Make.Cache
 import           Language.PureScript.Names
-import           Language.PureScript.Names (runModuleName, ModuleName)
 import           Language.PureScript.Options hiding (codegenTargets)
 import           Language.PureScript.Pretty.Common (SMap(..))
 import qualified Paths_purescript as Paths
@@ -71,6 +70,7 @@ data ProgressMessage
   | TypeCheckModule ModuleName
   | DesugarCaseGuardsModule ModuleName
   | CollapseBindingGroupsModule ModuleName
+  | CreateBindingGroupsModule ModuleName
   | CoreFnGenModule ModuleName
   | CoreFnOptModule ModuleName
   | FFICodegenModule ModuleName
@@ -88,6 +88,7 @@ renderProgressMessage (DesugarModule mn) = renderPrefixed mn "Desugar module"
 renderProgressMessage (TypeCheckModule mn) = renderPrefixed mn "Typecheck module"
 renderProgressMessage (DesugarCaseGuardsModule mn) = renderPrefixed mn "Desugar case guards"
 renderProgressMessage (CollapseBindingGroupsModule mn) = renderPrefixed mn "Collapse Binding Groups"
+renderProgressMessage (CreateBindingGroupsModule mn) = renderPrefixed mn "Create Binding Groups"
 renderProgressMessage (CoreFnGenModule mn) = renderPrefixed mn "CoreFn gen"
 renderProgressMessage (CoreFnOptModule mn) = renderPrefixed mn "CoreFn opt"
 renderProgressMessage (FFICodegenModule mn) = renderPrefixed mn "Codegen FFI"
@@ -156,7 +157,12 @@ writeCacheDb'
   -> CacheDb
   -- ^ The CacheDb to be written
   -> m ()
-writeCacheDb' = writeJSONFile . cacheDbFile
+writeCacheDb' dir db = do
+    writeJSONFile file_tmp db
+    renameFile file_tmp file
+  where
+    file = cacheDbFile dir
+    file_tmp = file ++ ".tmp"
 
 -- | A set of make actions that read and write modules from the given directory.
 buildMakeActions
@@ -204,7 +210,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
 
   getOutputTimestamp :: ModuleName -> Make (Maybe UTCTime)
   getOutputTimestamp mn = do
-    codegenTargets <- asks optionsCodegenTargets
+    codegenTargets <- asks $ optionsCodegenTargets . J.options
     let outputPaths = [outputFilename mn externsFileName] <> fmap (targetFilename mn) (S.toList codegenTargets)
     timestamps <- traverse getTimestampMaybe outputPaths
     pure $ fmap minimum . NEL.nonEmpty =<< sequence timestamps
@@ -216,7 +222,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
 
   outputPrimDocs :: Make ()
   outputPrimDocs = do
-    codegenTargets <- asks optionsCodegenTargets
+    codegenTargets <- asks $ optionsCodegenTargets . J.options
     when (S.member Docs codegenTargets) $ for_ Docs.Prim.primModules $ \docsMod@Docs.Module{..} ->
       writeJSONFile (outputFilename modName "docs.json") docsMod
 
@@ -224,7 +230,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
   codegen m docs exts = do
     let mn = CF.moduleName m
     lift $ writeCborFile (outputFilename mn externsFileName) exts
-    codegenTargets <- lift $ asks optionsCodegenTargets
+    codegenTargets <- lift $ asks $ optionsCodegenTargets . J.options
     when (S.member CoreFn codegenTargets) $ do
       let coreFnFile = targetFilename mn CoreFn
           json = CFJ.moduleToJSON Paths.version m
@@ -238,13 +244,13 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
               return $ Just $ Imp.App Nothing (Imp.Var Nothing "require") [Imp.StringLiteral Nothing "./foreign.js"]
         Nothing | requiresForeign m -> throwError . errorMessage' (CF.moduleSourceSpan m) $ MissingFFIModule mn
                 | otherwise -> return Nothing
-      rawJs <- J.moduleToJs m foreignInclude
+      rawJs <- J.moduleToJs m foreignInclude -- DROGIE!
       dir <- lift $ makeIO "get the current directory" getCurrentDirectory
       let sourceMaps = S.member JSSourceMap codegenTargets
           (pjs, mappings) = if sourceMaps then prettyPrintJSWithSourceMaps rawJs else (prettyPrintJS rawJs, [])
           jsFile = targetFilename mn JS
           mapFile = targetFilename mn JSSourceMap
-          prefix = ["Generated by purs version " <> T.pack (showVersion Paths.version) | usePrefix]
+          prefix = ["Generated by purs version " <> T.pack (showVersion Paths.version) <> ". Patched for erlscripten!" | usePrefix]
           js = T.unlines $ map ("// " <>) prefix ++ [pjs]
           mapRef = if sourceMaps then "//# sourceMappingURL=index.js.map\n" else ""
       lift $ do
@@ -255,7 +261,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
 
   ffiCodegen :: CF.Module CF.Ann -> Make ()
   ffiCodegen m = do
-    codegenTargets <- asks optionsCodegenTargets
+    codegenTargets <- asks $ optionsCodegenTargets . J.options
     when (S.member JS codegenTargets) $ do
       let mn = CF.moduleName m
       case mn `M.lookup` foreigns of
diff --git a/src/Language/PureScript/Make/BuildPlan.hs b/src/Language/PureScript/Make/BuildPlan.hs
index a8b0bfbab8..9168f77ccc 100644
--- a/src/Language/PureScript/Make/BuildPlan.hs
+++ b/src/Language/PureScript/Make/BuildPlan.hs
@@ -1,10 +1,12 @@
 module Language.PureScript.Make.BuildPlan
   ( BuildPlan(bpEnv)
   , BuildJobResult(..)
+  , ResultChannel
   , buildJobSuccess
   , buildJobFailure
   , construct
   , getResult
+  , setResultChannel
   , collectResults
   , markComplete
   , needsRebuild
@@ -39,8 +41,12 @@ data BuildPlan = BuildPlan
   { bpPrebuilt :: M.Map ModuleName Prebuilt
   , bpBuildJobs :: M.Map ModuleName BuildJob
   , bpEnv :: C.MVar Env
+  , bpResultChan :: Maybe ResultChannel
+  -- ^^ Optional channel for reporting build results, By sending Nothing we indicate that the build is done
   }
 
+type ResultChannel = C.Chan (Maybe (ModuleName, BuildJobResult))
+
 data Prebuilt = Prebuilt
   { pbModificationTime :: UTCTime
   , pbExternsFile :: ExternsFile
@@ -93,6 +99,9 @@ markComplete
   -> m ()
 markComplete buildPlan moduleName result = do
   let BuildJob rVar = fromMaybe (internalError "make: markComplete no barrier") $ M.lookup moduleName (bpBuildJobs buildPlan)
+  case bpResultChan buildPlan of
+    Just chan -> writeChan chan $ Just (moduleName, result)
+    Nothing -> return ()
   putMVar rVar result
 
 -- | Whether or not the module with the given ModuleName needs to be rebuilt
@@ -146,7 +155,7 @@ construct MakeActions{..} cacheDb (sorted, graph) = do
   buildJobs <- foldM makeBuildJob M.empty toBeRebuilt
   env <- C.newMVar primEnv
   pure
-    ( BuildPlan prebuilt buildJobs env
+    ( BuildPlan prebuilt buildJobs env Nothing
     , let
         update = flip $ \s ->
           M.alter (const (statusNewCacheInfo s)) (statusModuleName s)
@@ -214,6 +223,16 @@ construct MakeActions{..} cacheDb (sorted, graph) = do
                   prev
                 _ -> M.insert moduleName pb prev
 
+setResultChannel :: forall m. (Monad m, MonadBaseControl IO m)
+                    => BuildPlan
+                    -> Maybe ResultChannel
+                    -> m BuildPlan
+setResultChannel bp chan = do
+  case bpResultChan bp of
+    Just oldChan -> writeChan oldChan Nothing
+    Nothing -> return ()
+  pure $ bp { bpResultChan = chan }
+
 maximumMaybe :: Ord a => [a] -> Maybe a
 maximumMaybe [] = Nothing
 maximumMaybe xs = Just $ maximum xs
diff --git a/src/Language/PureScript/Make/Cache.hs b/src/Language/PureScript/Make/Cache.hs
index bfc3e4c7f8..9eb2002958 100644
--- a/src/Language/PureScript/Make/Cache.hs
+++ b/src/Language/PureScript/Make/Cache.hs
@@ -6,7 +6,8 @@ module Language.PureScript.Make.Cache
   , CacheDb
   , CacheInfo(..)
   , checkChanged
-  , removeModules
+  , removeModule
+  , updateModule
   , normaliseForCache
   ) where
 
@@ -24,7 +25,6 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
 import Data.Monoid (All(..))
-import Data.Set (Set)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import Data.These (These(..))
@@ -128,10 +128,17 @@ checkChanged cacheDb mn basePath currentInfo = do
 
   pure (CacheInfo newInfo, getAll isUpToDate)
 
--- | Remove any modules from the given set from the cache database; used when
--- they failed to build.
-removeModules :: Set ModuleName -> CacheDb -> CacheDb
-removeModules moduleNames = flip Map.withoutKeys moduleNames
+-- | Removes the given module from the cache database; used when
+-- it failed to build.
+removeModule :: ModuleName -> CacheDb -> CacheDb
+removeModule = Map.delete
+
+-- | Moves cache info between databases; used when a module was built successfully
+updateModule :: ModuleName -> CacheDb -> CacheDb -> CacheDb
+updateModule mn cur new =
+  case Map.lookup mn new of
+    Just r -> Map.insert mn r cur
+    Nothing -> Map.delete mn cur
 
 -- | 1. Any path that is beneath our current working directory will be
 -- stored as a normalised relative path
diff --git a/src/Language/PureScript/Make/Monad.hs b/src/Language/PureScript/Make/Monad.hs
index 0f5aad1b03..9b2b76cc5f 100644
--- a/src/Language/PureScript/Make/Monad.hs
+++ b/src/Language/PureScript/Make/Monad.hs
@@ -19,6 +19,7 @@ module Language.PureScript.Make.Monad
   , writeCborFile
   , writeCborFileIO
   , copyFile
+  , renameFile
   ) where
 
 import           Prelude
@@ -40,11 +41,13 @@ import qualified Data.ByteString as B
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Time.Clock (UTCTime)
+import           Data.Map as M
 import           Language.PureScript.AST
 import           Language.PureScript.Errors
 import           Language.PureScript.Externs (ExternsFile, externsIsCurrentVersion)
 import           Language.PureScript.Make.Cache (ContentHash, hash)
 import           Language.PureScript.Options
+import           Language.PureScript.CodeGen.JS(Env(..))
 import           System.Directory (createDirectoryIfMissing, getModificationTime)
 import qualified System.Directory as Directory
 import           System.FilePath (takeDirectory)
@@ -53,8 +56,8 @@ import           System.IO.UTF8 (readUTF8FileT)
 
 -- | A monad for running make actions
 newtype Make a = Make
-  { unMake :: ReaderT Options (ExceptT MultipleErrors (Logger MultipleErrors)) a
-  } deriving (Functor, Applicative, Monad, MonadIO, MonadError MultipleErrors, MonadWriter MultipleErrors, MonadReader Options)
+  { unMake :: ReaderT Env (ExceptT MultipleErrors (Logger MultipleErrors)) a
+  } deriving (Functor, Applicative, Monad, MonadIO, MonadError MultipleErrors, MonadWriter MultipleErrors, MonadReader Env)
 
 instance MonadBase IO Make where
   liftBase = liftIO
@@ -66,7 +69,17 @@ instance MonadBaseControl IO Make where
 
 -- | Execute a 'Make' monad, returning either errors, or the result of the compile plus any warnings.
 runMake :: Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)
-runMake opts = runLogger' . runExceptT . flip runReaderT opts . unMake
+runMake opts
+  = runLogger'
+  . runExceptT
+  . flip runReaderT
+  Env{ options = opts
+     , vars = M.empty
+     , continuationKind = error "codegen continuation undefined"
+     , currentModule = Nothing
+     , inToplevel = True
+     }
+  . unMake
 
 -- | Run an 'IO' action in the 'Make' monad. The 'String' argument should
 -- describe what we were trying to do; it is used for rendering errors in the
@@ -186,5 +199,10 @@ copyFile src dest =
     createParentDirectory dest
     Directory.copyFile src dest
 
+renameFile :: (MonadIO m, MonadError MultipleErrors m) => FilePath -> FilePath -> m ()
+renameFile src dest =
+  makeIO ("rename file: " <> Text.pack src <> " -> " <> Text.pack dest) $ do
+    Directory.renameFile src dest
+
 createParentDirectory :: FilePath -> IO ()
 createParentDirectory = createDirectoryIfMissing True . takeDirectory
diff --git a/src/Language/PureScript/Pretty/Common.hs b/src/Language/PureScript/Pretty/Common.hs
index 87adc6f3a5..6973caa510 100644
--- a/src/Language/PureScript/Pretty/Common.hs
+++ b/src/Language/PureScript/Pretty/Common.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Strict #-}
 
 -- |
 -- Common pretty-printing utility functions
@@ -9,7 +10,7 @@ import Prelude.Compat
 
 import Control.Monad.State (StateT, modify, get)
 
-import Data.List (elemIndices, intersperse)
+import Data.List (elemIndices, intersperse, foldl')
 import Data.Text (Text)
 import qualified Data.Text as T
 
@@ -54,14 +55,17 @@ newtype StrPos = StrPos (SourcePos, Text, [SMap])
 -- the length of the left.
 --
 instance Semigroup StrPos where
+  {-# INLINE (<>) #-}
   StrPos (a,b,c) <> StrPos (a',b',c') = StrPos (a `addPos` a', b <> b', c ++ (bumpPos a <$> c'))
 
 instance Monoid StrPos where
+  {-# INLINE mempty #-}
   mempty = StrPos (SourcePos 0 0, "", [])
 
+  {-# INLINE mconcat #-}
   mconcat ms =
     let s' = foldMap (\(StrPos(_, s, _)) -> s) ms
-        (p, maps) = foldl plus (SourcePos 0 0, []) ms
+        (p, maps) = foldl' plus (SourcePos 0 0, []) ms
     in
         StrPos (p, s', concat $ reverse maps)
     where
@@ -108,7 +112,7 @@ addPos (SourcePos n m) (SourcePos 0 m') = SourcePos n (m+m')
 addPos (SourcePos n _) (SourcePos n' m') = SourcePos (n+n') m'
 
 
-data PrinterState = PrinterState { indent :: Int }
+newtype PrinterState = PrinterState { indent :: Int }
 
 emptyPrinterState :: PrinterState
 emptyPrinterState = PrinterState { indent = 0 }
diff --git a/src/Language/PureScript/Renamer.hs b/src/Language/PureScript/Renamer.hs
index 4ee82ad0d3..23d3c100b9 100644
--- a/src/Language/PureScript/Renamer.hs
+++ b/src/Language/PureScript/Renamer.hs
@@ -174,7 +174,11 @@ renameInLiteral _ l = return l
 renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)
 renameInCaseAlternative (CaseAlternative bs v) = newScope $
   CaseAlternative <$> traverse renameInBinder bs
-                  <*> eitherM (traverse (pairM renameInValue renameInValue)) renameInValue v
+                  <*> eitherM (traverse (pairM (mapM renameInGuard) renameInValue)) renameInValue v
+
+renameInGuard :: Guard Ann -> Rename (Guard Ann)
+renameInGuard (ConditionGuard e) = ConditionGuard <$> renameInValue e
+renameInGuard (PatternGuard lv rv) = PatternGuard <$> renameInBinder lv <*> renameInValue rv
 
 -- |
 -- Renames within binders.
diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs
index a4efc201d6..1431e0f6a1 100644
--- a/src/Language/PureScript/Sugar/BindingGroups.hs
+++ b/src/Language/PureScript/Sugar/BindingGroups.hs
@@ -87,22 +87,28 @@ createBindingGroups moduleName = mapM f <=< handleDecls
       extractGuardedExpr [MkUnguarded expr] = expr
       extractGuardedExpr _ = internalError "Expected Guards to have been desugared in handleDecls."
 
+flattenBindingGroups :: [Declaration] -> [Declaration]
+flattenBindingGroups =
+  let go (DataBindingGroupDeclaration ds) = NEL.toList ds
+      go (BindingGroupDeclaration ds) =
+        NEL.toList $ fmap (\((sa, ident), nameKind, val) ->
+                             ValueDecl sa ident nameKind [] [MkUnguarded val]) ds
+      go other = [other]
+  in concatMap go
+
 -- |
 -- Collapse all binding groups to individual declarations
 --
 collapseBindingGroups :: [Declaration] -> [Declaration]
-collapseBindingGroups =
+collapseBindingGroups decls =
   let (f, _, _) = everywhereOnValues id collapseBindingGroupsForValue id
-  in fmap f . concatMap go
-  where
-  go (DataBindingGroupDeclaration ds) = NEL.toList ds
-  go (BindingGroupDeclaration ds) =
-    NEL.toList $ fmap (\((sa, ident), nameKind, val) ->
-      ValueDecl sa ident nameKind [] [MkUnguarded val]) ds
-  go other = [other]
+      gone = flattenBindingGroups decls
+      traversed = fmap f gone
+  in traversed
+
 
 collapseBindingGroupsForValue :: Expr -> Expr
-collapseBindingGroupsForValue (Let w ds val) = Let w (collapseBindingGroups ds) val
+collapseBindingGroupsForValue (Let w ds val) = Let w (flattenBindingGroups ds) val
 collapseBindingGroupsForValue other = other
 
 usedIdents :: ModuleName -> ValueDeclarationData Expr -> [Ident]
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
index a03457b61a..2b40c79eb4 100644
--- a/src/Language/PureScript/Sugar/CaseDeclarations.hs
+++ b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -24,6 +24,7 @@ import Language.PureScript.Environment
 import Language.PureScript.Errors
 import Language.PureScript.Names
 import Language.PureScript.TypeChecker.Monad (guardWith)
+import qualified Language.PureScript.Constants as C
 
 -- |
 -- Replace all top-level binders in a module with case expressions.
@@ -58,7 +59,7 @@ desugarGuardedExprs
   -> Expr
   -> m Expr
 desugarGuardedExprs ss (Case scrut alternatives)
-  | any (not . isTrivialExpr) scrut = do
+  | not $ all isTrivialExpr scrut = do
     -- in case the scrutinee is non trivial (e.g. not a Var or Literal)
     -- we may evaluate the scrutinee more than once when a guard occurrs.
     -- We bind the scrutinee to Vars here to mitigate this case.
@@ -80,175 +81,24 @@ desugarGuardedExprs ss (Case scrut alternatives)
 
 desugarGuardedExprs ss (Case scrut alternatives) =
   let
-    -- Alternatives which do not have guards are
-    -- left as-is. Alternatives which
-    --
-    --   1) have multiple clauses of the form
-    --      binder | g_1
-    --             , g_2
-    --             , ...
-    --             , g_n
-    --             -> expr
-    --
-    --   2) and/or contain pattern guards of the form
-    --      binder | pat_bind <- e
-    --             , ...
-    --
-    -- are desugared to a sequence of nested case expressions.
-    --
-    -- Consider an example case expression:
-    --
-    --   case e of
-    --    (T s) | Just info <- Map.lookup s names
-    --          , is_used info
-    --          -> f info
-    --
-    -- We desugar this to
-    --
-    --   case e of
-    --    (T s) -> case Map.lookup s names of
-    --               Just info -> case is_used info of
-    --                              True -> f info
-    --                              (_    -> <partial>)
-    --               (_ -> <partial>)
-    --
-    -- Note that if the original case is partial the desugared
-    -- case is also partial.
-    --
-    -- Consider an exhaustive case expression:
-    --
-    --   case e of
-    --    (T s) | Just info <- Map.lookup s names
-    --          , is_used info
-    --          -> f info
-    --    _     -> Nothing
-    --
-    -- desugars to:
-    --
-    --    case e of
-    --      _ -> let
-    --                v _ = Nothing
-    --           in
-    --             case e of
-    --                (T s) -> case Map.lookup s names of
-    --                          Just info -> f info
-    --                          _ -> v true
-    --                _  -> v true
-    --
-    -- This might look strange but simplifies the algorithm a lot.
-    --
     desugarAlternatives :: [CaseAlternative]
                         -> m [CaseAlternative]
-    desugarAlternatives [] = pure []
-
-    -- the trivial case: no guards
-    desugarAlternatives (a@(CaseAlternative _ [MkUnguarded _]) : as) =
-      (a :) <$> desugarAlternatives as
-
-    -- Special case: CoreFn understands single condition guards on
-    -- binders right hand side.
-    desugarAlternatives (CaseAlternative ab ge : as)
-      | not (null cond_guards) =
-          (CaseAlternative ab cond_guards :)
-            <$> desugarGuardedAlternative ab rest as
-      | otherwise = desugarGuardedAlternative ab ge as
-      where
-        (cond_guards, rest) = span isSingleCondGuard ge
-
-        isSingleCondGuard (GuardedExpr [ConditionGuard _] _) = True
-        isSingleCondGuard _ = False
-
-    desugarGuardedAlternative :: [Binder]
-                              -> [GuardedExpr]
-                              -> [CaseAlternative]
-                              -> m [CaseAlternative]
-    desugarGuardedAlternative _vb [] rem_alts =
-      desugarAlternatives rem_alts
-
-    desugarGuardedAlternative vb (GuardedExpr gs e : ge) rem_alts = do
-      rhs <- desugarAltOutOfLine vb ge rem_alts $ \alt_fail ->
-        let
-          -- if the binder is a var binder we must not add
-          -- the fail case as it results in unreachable
-          -- alternative
-          alt_fail' n | all isIrrefutable vb = []
-                      | otherwise = alt_fail n
-
-
-          -- we are here:
-          --
-          -- case scrut of
-          --   ...
-          --   _ -> let
-          --         v _ = <out of line case>
-          --        in case scrut of -- we are here
-          --            ...
-          --
-        in Case scrut
-            (CaseAlternative vb [MkUnguarded (desugarGuard gs e alt_fail)]
-              : (alt_fail' (length scrut)))
-
-      return [ CaseAlternative scrut_nullbinder [MkUnguarded rhs]]
-
-    desugarGuard :: [Guard] -> Expr -> (Int ->[CaseAlternative]) -> Expr
-    desugarGuard [] e _ = e
-    desugarGuard (ConditionGuard c : gs) e match_failed
-      | isTrueExpr c = desugarGuard gs e match_failed
-      | otherwise =
-        Case [c]
-          (CaseAlternative [LiteralBinder ss (BooleanLiteral True)]
-            [MkUnguarded (desugarGuard gs e match_failed)] : match_failed 1)
-
-    desugarGuard (PatternGuard vb g : gs) e match_failed =
-      Case [g]
-        (CaseAlternative [vb] [MkUnguarded (desugarGuard gs e match_failed)]
-          : match_failed')
-      where
-        -- don't consider match_failed case if the binder is irrefutable
-        match_failed' | isIrrefutable vb = []
-                      | otherwise        = match_failed 1
-
-    -- we generate a let-binding for the remaining guards
-    -- and alternatives. A CaseAlternative is passed (or in
-    -- fact the original case is partial non is passed) to
-    -- mk_body which branches to the generated let-binding.
-    desugarAltOutOfLine :: [Binder]
-                        -> [GuardedExpr]
-                        -> [CaseAlternative]
-                        -> ((Int -> [CaseAlternative]) -> Expr)
-                        -> m Expr
-    desugarAltOutOfLine alt_binder rem_guarded rem_alts mk_body
-      | Just rem_case <- mkCaseOfRemainingGuardsAndAlts = do
-
-        desugared     <- desugarGuardedExprs ss rem_case
-        rem_case_id   <- freshIdent'
-        unused_binder <- freshIdent'
-
-        let
-          goto_rem_case :: Expr
-          goto_rem_case = Var ss (Qualified Nothing rem_case_id)
-            `App` Literal ss (BooleanLiteral True)
-          alt_fail :: Int -> [CaseAlternative]
-          alt_fail n = [CaseAlternative (replicate n NullBinder) [MkUnguarded goto_rem_case]]
-
-        pure $ Let FromLet [
-          ValueDecl (ss, []) rem_case_id Private []
-            [MkUnguarded (Abs (VarBinder ss unused_binder) desugared)]
-          ] (mk_body alt_fail)
-
-      | otherwise
-      = pure $ mk_body (const [])
-      where
-        mkCaseOfRemainingGuardsAndAlts
-          | not (null rem_guarded)
-          = Just $ Case scrut (CaseAlternative alt_binder rem_guarded : rem_alts)
-          | not (null rem_alts)
-          = Just $ Case scrut rem_alts
-          | otherwise
-          = Nothing
-
-    scrut_nullbinder :: [Binder]
-    scrut_nullbinder = replicate (length scrut) NullBinder
+    desugarAlternatives = mapM desugarAlternative
+
+    desugarAlternative (CaseAlternative ab ge) = do
+      dge <- forM ge $ \(GuardedExpr g e) -> GuardedExpr (desugarGuard g) <$> desugarGuardedExprs ss e
+      return $ CaseAlternative ab dge
+
+    desugarGuard :: [Guard] -> [Guard]
+    desugarGuard (ConditionGuard c1 : ConditionGuard c2 : gs) =
+      desugarGuard (ConditionGuard (
+                       App (App (App (Var ss (Qualified (Just (ModuleName "Data.HeytingAlgebra")) (Ident C.conj)))
+                                  (Var ss (Qualified (Just (ModuleName "Data.HeytingAlgebra")) (Ident C.heytingAlgebraBoolean))))
+                                 c1)
+                             c2)
+                     : gs)
+    desugarGuard [] = []
+    desugarGuard (h:t) = h:desugarGuard t
 
     -- case expressions with a single alternative which have
     -- a NullBinder occur frequently after desugaring
diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs
index 1d0bb8aec4..c54999975e 100644
--- a/src/Language/PureScript/Sugar/Operators.hs
+++ b/src/Language/PureScript/Sugar/Operators.hs
@@ -38,7 +38,7 @@ import Data.Traversable (for)
 import qualified Data.Map as M
 
 import qualified Language.PureScript.Constants as C
-
+import Debug.Trace
 -- |
 -- Removes unary negation operators and replaces them with calls to `negate`.
 --
diff --git a/tests/TestBundle.hs b/tests/TestBundle.hs
index ab209d5989..2cb4ae923c 100644
--- a/tests/TestBundle.hs
+++ b/tests/TestBundle.hs
@@ -68,16 +68,20 @@ assertBundles supportModules supportExterns supportForeigns inputFiles outputFil
         process <- findNodeProcess
         jsFiles <- Glob.globDir1 (Glob.compile "**/*.js") modulesDir
         let entryPoint = modulesDir </> "index.js"
-        let entryModule = map (`ModuleIdentifier` Regular) ["Main"] 
+        let entryModule = map (`ModuleIdentifier` Regular) ["Main"]
+        let logFile = entryPoint ++ "." ++ show (sum $ map length inputFiles)
         bundled <- runExceptT $ do
           input <- forM jsFiles $ \filename -> do
             js <- liftIO $ readUTF8File filename
+            -- liftIO $ putStrLn $ "FILE: " ++ filename ++ "\n" ++ js ++ "\n\n"
             mid <- guessModuleIdentifier filename
-            length js `seq` return (mid, Just filename, js) 
+            length js `seq` return (mid, Just filename, js)
           bundleSM input entryModule (Just $ "Main") "PS" (Just entryPoint) Nothing
         case bundled of
             Right (_, js) -> do
               writeUTF8File entryPoint js
+              liftIO $ putStrLn $ "LOG INTO: " ++ logFile
+              writeUTF8File logFile js
               result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process
               hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":"
               case result of
@@ -89,7 +93,7 @@ assertBundles supportModules supportExterns supportForeigns inputFiles outputFil
                  | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out
                 Just (ExitFailure _, _, err) -> return $ Just err
                 Nothing -> return $ Just "Couldn't find node.js executable"
-            Left err -> return . Just $ "Coud not bundle: " ++ show err
+            Left err -> return . Just $ "Could not bundle: " ++ show err
 
 logfile :: FilePath
 logfile = "bundle-tests.out"
diff --git a/tests/TestCoreFn.hs b/tests/TestCoreFn.hs
index 04b9fa9185..9eec09e57b 100644
--- a/tests/TestCoreFn.hs
+++ b/tests/TestCoreFn.hs
@@ -164,7 +164,7 @@ spec = context "CoreFnFromJsonTest" $ do
                     Case ann [Var ann (Qualified Nothing (Ident "x"))]
                       [ CaseAlternative
                         [ NullBinder ann ]
-                        (Left [(Literal ann (BooleanLiteral True), Literal ann (CharLiteral 'a'))])
+                        (Left [([ConditionGuard $ Literal ann (BooleanLiteral True)], Literal ann (CharLiteral 'a'))])
                       ]
                 ]
       parseMod m `shouldSatisfy` isSuccess
diff --git a/tests/TestMake.hs b/tests/TestMake.hs
index dadee27fd7..f90ecca808 100644
--- a/tests/TestMake.hs
+++ b/tests/TestMake.hs
@@ -182,8 +182,10 @@ compileWithResult input = do
     foreigns <- P.inferForeignModules filePathMap
     let makeActions =
           (P.buildMakeActions modulesDir filePathMap foreigns True)
-            { P.progress = \(P.CompilingModule mn) ->
-                liftIO $ modifyMVar_ recompiled (return . Set.insert mn)
+            { P.progress = \p -> case p of
+                (P.CompilingModule mn) ->
+                  liftIO $ modifyMVar_ recompiled (return . Set.insert mn)
+                _ -> return ()
             }
     P.make makeActions (map snd ms)
 
diff --git a/tests/purs/passing/TCOMutRec.purs b/tests/purs/passing/TCOMutRec.purs
deleted file mode 100644
index 6f599c5bd6..0000000000
--- a/tests/purs/passing/TCOMutRec.purs
+++ /dev/null
@@ -1,95 +0,0 @@
-module Main where
-
-import Prelude
-import Effect (Effect)
-import Effect.Console (log)
-import Test.Assert (assertEqual, assertThrows)
-
-tco1 :: Int -> Int
-tco1 = f 0
-  where
-  f x y = g (x + 2) (y - 1)
-    where
-    g x' y' = if y' <= 0 then x' else f x' y'
-
-tco2 :: Int -> Int
-tco2 = f 0
-  where
-  f x y = g (x + 2) (y - 1)
-    where
-    g x' y' = h (y' <= 0) x' y'
-    h test x' y' = if test then x' else f x' y'
-
-tco3 :: Int -> Int
-tco3 y0 = f 0 y0
-  where
-  f x y = g x (h y)
-    where
-    g x' y' =
-      if y' <= 0 then x'
-      else if y' > y0 / 2 then g (j x') (y' - 1)
-      else f (x' + 2) y'
-    h y = y - 1
-  j x = x + 3
-
-tco4 :: Int -> Int
-tco4 = f 0
-  where
-  f x y = if y <= 0 then x else g (y - 1)
-    where
-    g y' = f (x + 2) y'
-
--- The following examples are functions which are prevented from being TCO'd
--- because the arity of the function being looped does not match the function
--- call. In theory, these could be made to optimize via eta-expansion in the
--- future, in which case the assertions can change.
-
-ntco1 :: Int -> Int
-ntco1 y0 = f 0 y0
-  where
-  f x = if x > 10 * y0 then (x + _) else g x
-    where
-    g x' y' = f (x' + 10) (y' - 1)
-
-ntco2 :: Int -> Int
-ntco2 = f 0
-  where
-  f x y = if y <= 0 then x else g x (y - 1)
-    where
-    g x' = f (x' + 2)
-
-ntco3 :: Int -> Int
-ntco3 = f 0
-  where
-  f x y = if y <= 0 then x else g (y - 1)
-    where
-    g = f (x + 2)
-
-ntco4 :: Int -> Int
-ntco4 = f 0
-  where
-  f x y = if y <= 0 then x else g (y - 1)
-    where
-    g = h x
-    h x' y' = f (x' + 2) y'
-
-main :: Effect Unit
-main = do
-  assertEqual { expected: 200000, actual: tco1 100000 }
-  assertEqual { expected: 200000, actual: tco2 100000 }
-  assertEqual { expected: 249997, actual: tco3 100000 }
-  assertEqual { expected: 200000, actual: tco4 100000 }
-
-  assertEqual { expected: 1009, actual: ntco1 100 }
-  assertThrows \_ -> ntco1 100000
-
-  assertEqual { expected: 200, actual: ntco2 100 }
-  assertThrows \_ -> ntco2 100000
-
-  assertEqual { expected: 200, actual: ntco3 100 }
-  assertThrows \_ -> ntco3 100000
-
-  assertEqual { expected: 200, actual: ntco4 100 }
-  assertThrows \_ -> ntco4 100000
-
-  log "Done"