diff --git a/Language/Javascript/JMacro.hs b/Language/Javascript/JMacro.hs
--- a/Language/Javascript/JMacro.hs
+++ b/Language/Javascript/JMacro.hs
@@ -14,53 +14,53 @@
 
 usage:
 
-> renderJs [$jmacro|fun id x -> x|]
+> renderJs [jmacro|fun id x -> x|]
 
 The above produces the id function at the top level.
 
-> renderJs [$jmacro|var id = \x -> x|]
+> renderJs [jmacro|var id = \x -> x;|]
 
 So does the above here. However, as id is brought into scope by the keyword var, you do not get a variable named id in the generated javascript, but a variable with an arbitrary unique identifier.
 
-> renderJs [$jmacro|var !id = \x -> x|]
+> renderJs [jmacro|var !id = \x -> x;|]
 
 The above, by using the bang special form in a var declaration, produces a variable that really is named id.
 
-> renderJs [$jmacro|function id(x) {return x;}|]
+> renderJs [jmacro|function id(x) {return x;}|]
 
 The above is also id.
 
-> renderJs [$jmacro|function !id(x) {return x;}|]
+> renderJs [jmacro|function !id(x) {return x;}|]
 
 As is the above (with the correct name).
 
-> renderJs [$jmacro|fun id x {return x;}|]
+> renderJs [jmacro|fun id x {return x;}|]
 
 As is the above.
 
-> renderJs [$jmacroE|foo(x,y)|]
+> renderJs [jmacroE|foo(x,y)|]
 
 The above is an expression representing the application of foo to x and y.
 
-> renderJs [$jmacroE|foo x y|]]
+> renderJs [jmacroE|foo x y|]]
 
 As is the above.
 
-> renderJs [$jmacroE|foo (x,y)|]
+> renderJs [jmacroE|foo (x,y)|]
 
 While the above is an error. (i.e. standard javascript function application cannot seperate the leading parenthesis of the argument from the function being applied)
 
-> \x -> [$jmacroE|foo `(x)`|]
+> \x -> [jmacroE|foo `(x)`|]
 
 The above is a haskell expression that provides a function that takes an x, and yields an expression representing the application of foo to the value of x as transformed to a Javascript expression.
 
-> [$jmacroE|\x ->`(foo x)`|]
+> [jmacroE|\x ->`(foo x)`|]
 
 Meanwhile, the above lambda is in Javascript, and brings the variable into scope both in javascript and in the enclosed antiquotes. The expression is a Javascript function that takes an x, and yields an expression produced by the application of the Haskell function foo as applied to the identifier x (which is of type JExpr -- i.e. a Javascript expression).
 
 Other than that, the language is essentially Javascript (1.5). Note however that one must use semicolons in a principled fashion -- i.e. to end statements consistently. Otherwise, the parser will mistake the whitespace for a whitespace application, and odd things will occur. A further gotcha exists in regex literals, whicch cannot begin with a space. @x / 5 / 4@ parses as ((x / 5) / 4). However, @x /5 / 4@ will parse as x(/5 /, 4). Such are the perils of operators used as delimeters in the presence of whitespace application.
 
-Additional features in jmacro (documented on the wiki) include an infix application operator, and an enhanced destructuring bind.  
+Additional features in jmacro (documented on the wiki) include an infix application operator, and an enhanced destructuring bind.
 
 Additional datatypes can be marshalled to Javascript by proper instance declarations for the ToJExpr class.
 
diff --git a/Language/Javascript/JMacro/Base.hs b/Language/Javascript/JMacro/Base.hs
--- a/Language/Javascript/JMacro/Base.hs
+++ b/Language/Javascript/JMacro/Base.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, FlexibleInstances, UndecidableInstances, OverlappingInstances, OverloadedStrings, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables, GADTs
+           , GeneralizedNewtypeDeriving, LambdaCase #-}
 
 -----------------------------------------------------------------------------
 {- |
@@ -14,9 +15,9 @@
 
 module Language.Javascript.JMacro.Base (
   -- * ADT
-  JStat(..), JExpr(..), JVal(..), Ident(..), IdentSupply(..),
+  JStat(..), JExpr(..), JVal(..), Ident(..), IdentSupply(..), JsLabel,
   -- * Generic traversal (via compos)
-  JMacro(..), MultiComp(..), Compos(..),
+  JMacro(..), JMGadt(..), Compos(..),
   composOp, composOpM, composOpM_, composOpFold,
   -- * Hygienic transformation
   withHygiene, scopify,
@@ -32,35 +33,54 @@
   -- * Hash combinators
   jhEmpty, jhSingle, jhAdd, jhFromList,
   -- * Utility
-  jsSaturate, jtFromList
+  jsSaturate, jtFromList, SaneDouble(..)
   ) where
 import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
 import Control.Applicative hiding (empty)
-import Control.Arrow (second)
+import Control.Arrow ((***))
+import Control.Monad (ap, return, liftM2)
 import Control.Monad.State.Strict
 import Control.Monad.Identity
 
 import Data.Function
 import Data.Char (toLower,isControl)
-import Data.Maybe (fromMaybe)
-import qualified Data.Set as S
 import qualified Data.Map as M
+import qualified Data.Text.Lazy as T
+import qualified Data.Text as TS
 import Data.Generics
 import Data.Monoid(Monoid, mappend, mempty)
+import Data.Semigroup(Semigroup(..))
 
 import Numeric(showHex)
 import Safe
-import Text.JSON
-import Text.PrettyPrint.HughesPJ as PP
+import Data.Aeson
+import qualified Data.Vector as V
+#if MIN_VERSION_aeson (2,0,0)
+import qualified Data.Aeson.Key    as KM
+import qualified Data.Aeson.KeyMap as KM
+#else
+import qualified Data.HashMap.Strict as HM
+#endif
+import Text.PrettyPrint.Leijen.Text hiding ((<$>))
 
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
 import Language.Javascript.JMacro.Types
 
+-- wl-pprint-text compatibility with pretty
+infixl 5 $$, $+$
+($+$), ($$), ($$$) :: Doc -> Doc -> Doc
+x $+$ y = x PP.<$> y
+x $$ y  = align (x $+$ y)
+x $$$ y = align (nest 2 $ x $+$ y)
+
 {--------------------------------------------------------------------
   ADTs
 --------------------------------------------------------------------}
 
 newtype IdentSupply a = IS {runIdentSupply :: State [Ident] a} deriving Typeable
 
+inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b
 inIdentSupply f x = IS $ f (runIdentSupply x)
 
 instance Data a => Data (IdentSupply a) where
@@ -73,9 +93,11 @@
 
 takeOne :: State [Ident] Ident
 takeOne = do
-  (x:xs) <- get
-  put xs
-  return x
+  get >>= \case
+            (x:xs) -> do
+               put xs
+               return x
+            _ -> error "not enough elements"
 
 newIdentSupply :: Maybe String -> [Ident]
 newIdentSupply Nothing     = newIdentSupply (Just "jmId")
@@ -103,8 +125,8 @@
 data JStat = DeclStat   Ident (Maybe JLocalType)
            | ReturnStat JExpr
            | IfStat     JExpr JStat JStat
-           | WhileStat  JExpr JStat
-           | ForInStat  Bool Ident JExpr JStat
+           | WhileStat  Bool JExpr JStat -- bool is "do"
+           | ForInStat  Bool Ident JExpr JStat -- bool is "each"
            | SwitchStat JExpr [(JExpr, JStat)] JStat
            | TryStat    JStat Ident JStat JStat
            | BlockStat  [JStat]
@@ -114,16 +136,24 @@
            | UnsatBlock (IdentSupply JStat)
            | AntiStat   String
            | ForeignStat Ident JLocalType
-           | BreakStat
+           | LabelStat JsLabel JStat
+           | BreakStat (Maybe JsLabel)
+           | ContinueStat (Maybe JsLabel)
              deriving (Eq, Ord, Show, Data, Typeable)
 
+type JsLabel = String
 
+
+instance Semigroup JStat where
+    (<>) (BlockStat xs) (BlockStat ys) = BlockStat $ xs ++ ys
+    (<>) (BlockStat xs) ys = BlockStat $ xs ++ [ys]
+    (<>) xs (BlockStat ys) = BlockStat $ xs : ys
+    (<>) xs ys = BlockStat [xs,ys]
+
+
 instance Monoid JStat where
     mempty = BlockStat []
-    mappend (BlockStat xs) (BlockStat ys) = BlockStat $ xs ++ ys
-    mappend (BlockStat xs) ys = BlockStat $ xs ++ [ys]
-    mappend xs (BlockStat ys) = BlockStat $ xs : ys
-    mappend xs ys = BlockStat [xs,ys]
+    mappend x y = x <> y
 
 
 -- TODO: annotate expressions with type
@@ -144,7 +174,7 @@
 -- | Values
 data JVal = JVar     Ident
           | JList    [JExpr]
-          | JDouble  Double
+          | JDouble  SaneDouble
           | JInt     Integer
           | JStr     String
           | JRegEx   String
@@ -153,6 +183,19 @@
           | UnsatVal (IdentSupply JVal)
             deriving (Eq, Ord, Show, Data, Typeable)
 
+newtype SaneDouble = SaneDouble Double deriving (Data, Typeable, Fractional, Num)
+
+instance Eq SaneDouble where
+    (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y)
+
+instance Ord SaneDouble where
+    compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y)
+        where fromNaN z | isNaN z = Nothing
+                        | otherwise = Just z
+
+instance Show SaneDouble where
+    show (SaneDouble x) = show x
+
 -- | Identifiers
 newtype Ident = StrI String deriving (Eq, Ord, Show, Data, Typeable)
 
@@ -175,70 +218,68 @@
 {--------------------------------------------------------------------
   Compos
 --------------------------------------------------------------------}
+-- | Compos and ops for generic traversal as defined over
+-- the JMacro ADT.
 
 -- | Utility class to coerce the ADT into a regular structure.
 class JMacro a where
-    toMC :: a -> MultiComp
-    fromMC :: MultiComp -> a
+    jtoGADT :: a -> JMGadt a
+    jfromGADT :: JMGadt a -> a
 
--- | Union type to allow regular traversal by compos.
-data MultiComp = MStat JStat | MExpr JExpr | MVal JVal | MIdent Ident deriving Show
+instance JMacro Ident where
+    jtoGADT = JMGId
+    jfromGADT (JMGId x) = x
+    jfromGADT _ = error "impossible"
 
+instance JMacro JStat where
+    jtoGADT = JMGStat
+    jfromGADT (JMGStat x) = x
+    jfromGADT _ = error "impossible"
 
--- | Compos and ops for generic traversal as defined over
--- the JMacro ADT.
-class Compos t where
-    compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
-           -> (t -> m t) -> t -> m t
+instance JMacro JExpr where
+    jtoGADT = JMGExpr
+    jfromGADT (JMGExpr x) = x
+    jfromGADT _ = error "impossible"
 
+instance JMacro JVal where
+    jtoGADT = JMGVal
+    jfromGADT (JMGVal x) = x
+    jfromGADT _ = error "impossible"
 
-composOp :: Compos t => (t -> t) -> t -> t
+-- | Union type to allow regular traversal by compos.
+data JMGadt a where
+    JMGId   :: Ident -> JMGadt Ident
+    JMGStat :: JStat -> JMGadt JStat
+    JMGExpr :: JExpr -> JMGadt JExpr
+    JMGVal  :: JVal  -> JMGadt JVal
+
+
+composOp :: Compos t => (forall a. t a -> t a) -> t b -> t b
 composOp f = runIdentity . composOpM (Identity . f)
-composOpM :: (Compos t, Monad m) => (t -> m t) -> t -> m t
+composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t b -> m (t b)
 composOpM = compos return ap
-composOpM_ :: (Compos t, Monad m) => (t -> m ()) -> t -> m ()
+composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t b -> m ()
 composOpM_ = composOpFold (return ()) (>>)
-composOpFold :: Compos t => b -> (b -> b -> b) -> (t -> b) -> t -> b
+composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
 composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)
 newtype C b a = C { unC :: b }
 
-instance JMacro Ident where
-    toMC = MIdent
-    fromMC (MIdent x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro JVal where
-    toMC = MVal
-    fromMC (MVal x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro JExpr where
-    toMC = MExpr
-    fromMC (MExpr x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro JStat where
-    toMC = MStat
-    fromMC (MStat x) = x
-    fromMC _ = error "fromMC"
-
-instance JMacro [JStat] where
-    toMC = MStat . BlockStat
-    fromMC (MStat (BlockStat x)) = x
-    fromMC _ = error "fromMC"
+class Compos t where
+    compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
+           -> (forall a. t a -> m (t a)) -> t c -> m (t c)
 
+instance Compos JMGadt where
+    compos = jmcompos
 
-instance Compos MultiComp where
-  compos = mcCompos
-    where
-     mcCompos :: forall m. (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (MultiComp -> m MultiComp) -> MultiComp -> m MultiComp
-     mcCompos ret app f' v = case v of
-        MIdent _ -> ret v
-        MStat v' -> ret MStat `app` case v' of
+jmcompos :: forall m c. (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (forall a. JMGadt a -> m (JMGadt a)) -> JMGadt c -> m (JMGadt c)
+jmcompos ret app f' v =
+    case v of
+     JMGId _ -> ret v
+     JMGStat v' -> ret JMGStat `app` case v' of
            DeclStat i t -> ret DeclStat `app` f i `app` ret t
            ReturnStat i -> ret ReturnStat `app` f i
            IfStat e s s' -> ret IfStat `app` f e `app` f s `app` f s'
-           WhileStat e s -> ret WhileStat `app` f e `app` f s
+           WhileStat b e s -> ret (WhileStat b) `app` f e `app` f s
            ForInStat b i e s -> ret (ForInStat b) `app` f i `app` f e `app` f s
            SwitchStat e l d -> ret SwitchStat `app` f e `app` l' `app` f d
                where l' = mapM' (\(c,s) -> ret (,) `app` f c `app` f s) l
@@ -250,8 +291,10 @@
            UnsatBlock _ -> ret v'
            AntiStat _ -> ret v'
            ForeignStat i t -> ret ForeignStat `app` f i `app` ret t
-           BreakStat -> ret BreakStat
-        MExpr v' -> ret MExpr `app` case v' of
+           ContinueStat l -> ret (ContinueStat l)
+           BreakStat l -> ret (BreakStat l)
+           LabelStat l s -> ret (LabelStat l) `app` f s
+     JMGExpr v' -> ret JMGExpr `app` case v' of
            ValExpr e -> ret ValExpr `app` f e
            SelExpr e e' -> ret SelExpr `app` f e `app` f e'
            IdxExpr e e' -> ret IdxExpr `app` f e `app` f e'
@@ -263,7 +306,7 @@
            AntiExpr _ -> ret v'
            TypeExpr b e t -> ret (TypeExpr b) `app` f e `app` ret t
            UnsatExpr _ -> ret v'
-        MVal v' -> ret MVal `app` case v' of
+     JMGVal v' -> ret JMGVal `app` case v' of
            JVar i -> ret JVar `app` f i
            JList xs -> ret JList `app` mapM' f xs
            JDouble _ -> ret v'
@@ -275,25 +318,12 @@
                      m' = ret (M.fromAscList . zip ls) `app` mapM' f vs
            JFunc xs s -> ret JFunc `app` mapM' f xs `app` f s
            UnsatVal _ -> ret v'
-      where
-        mapM' :: (a -> m a) -> [a] -> m [a]
-        mapM' g = foldr (app . app (ret (:)) . g) (ret [])
-        f :: JMacro a => a -> m a
-        f x = ret fromMC `app` f' (toMC x)
 
-instance Compos JType where
-    compos ret app f v =
-        case v of
-          JTFunc args body -> ret JTFunc `app` mapM' f args `app` f body
-          JTForall vars t -> ret JTForall `app` ret vars `app` f t
-          JTList t -> ret JTList `app` f t
-          JTMap t -> ret JTMap `app` f t
-          JTRecord t m -> ret JTRecord `app` f t `app` m'
-              where (ls,ts) = unzip $ M.toList m
-                    m' = ret (M.fromAscList . zip ls) `app` mapM' f ts
-          x -> ret x
-      where
-        mapM' g = foldr (app . app (ret (:)) . g) (ret [])
+  where
+    mapM' :: forall a. (a -> m a) -> [a] -> m [a]
+    mapM' g = foldr (app . app (ret (:)) . g) (ret [])
+    f :: forall b. JMacro b => b -> m b
+    f x = ret jfromGADT `app` f' (jtoGADT x)
 
 {--------------------------------------------------------------------
   New Identifiers
@@ -336,12 +366,14 @@
 jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str)
 
 jsSaturate_ :: (JMacro a) => a -> IdentSupply a
-jsSaturate_ e = IS $ fromMC <$> go (toMC e)
-    where go v = case v of
-                   MStat (UnsatBlock us) -> go =<< (MStat <$> runIdentSupply us)
-                   MExpr (UnsatExpr  us) -> go =<< (MExpr <$> runIdentSupply us)
-                   MVal  (UnsatVal   us) -> go =<< (MVal  <$> runIdentSupply us)
-                   _ -> composOpM go v
+jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e)
+    where
+      go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
+      go v = case v of
+               JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us)
+               JMGExpr (UnsatExpr  us) -> go =<< (JMGExpr <$> runIdentSupply us)
+               JMGVal  (UnsatVal   us) -> go =<< (JMGVal  <$> runIdentSupply us)
+               _ -> composOpM go v
 
 {--------------------------------------------------------------------
   Transformation
@@ -349,11 +381,13 @@
 
 --doesn't apply to unsaturated bits
 jsReplace_ :: JMacro a => [(Ident, Ident)] -> a -> a
-jsReplace_ xs e = fromMC $ go (toMC e)
-    where go v = case v of
-                   MIdent i -> maybe v MIdent (M.lookup i mp)
+jsReplace_ xs e = jfromGADT $ go (jtoGADT e)
+    where
+      go :: forall a. JMGadt a -> JMGadt a
+      go v = case v of
+                   JMGId i -> maybe v JMGId (M.lookup i mp)
                    _ -> composOp go v
-          mp = M.fromList xs
+      mp = M.fromList xs
 
 --only works on fully saturated things
 jsUnsat_ :: JMacro a => [Ident] -> a -> IdentSupply a
@@ -365,60 +399,73 @@
 -- | Apply a transformation to a fully saturated syntax tree,
 -- taking care to return any free variables back to their free state
 -- following the transformation. As the transformation preserves
--- free variables, it is hygienic. Cannot be used nested.
-withHygiene:: JMacro a => (a -> a) -> a -> a
-withHygiene f x = fromMC $ case mx of
-              MStat _  -> toMC $ UnsatBlock (coerceMC <$> jsUnsat_ is' x'')
-              MExpr _  -> toMC $ UnsatExpr  (coerceMC <$> jsUnsat_ is' x'')
-              MVal  _  -> toMC $ UnsatVal   (coerceMC <$> jsUnsat_ is' x'')
-              MIdent _ -> toMC $ f x
-    where (x', (StrI l:_)) = runState (runIdentSupply $ jsSaturate_ x) is
-          x'' = f x'
-          is = newIdentSupply (Just "inSat")
-          lastVal = readNote "inSat" (drop 6 l) :: Int
-          is' = take lastVal is
-          mx = toMC x
-          coerceMC :: (JMacro a, JMacro b) => a -> b
-          coerceMC = fromMC . toMC
-
-
+-- free variables, it is hygienic.
+withHygiene ::  JMacro a => (a -> a) -> a -> a
+withHygiene f x = jfromGADT $ case jtoGADT x of
+    JMGExpr z -> JMGExpr $ UnsatExpr $ inScope z
+    JMGStat z -> JMGStat $ UnsatBlock $ inScope z
+    JMGVal  z -> JMGVal $ UnsatVal $ inScope z
+    JMGId _ -> jtoGADT $ f x
+    where
+        inScope z = IS $ do
+            splitAt 1 `fmap` get >>= \case
+              ([StrI a], b) -> do
+                put b
+                return $ withHygiene_ a f z
+              _ -> error "Not as string"
 
+withHygiene_ :: JMacro a => String -> (a -> a) -> a -> a
+withHygiene_ un f x = jfromGADT $ case jtoGADT x of
+    JMGStat _ -> jtoGADT $ UnsatBlock (jsUnsat_ is' x'')
+    JMGExpr _ -> jtoGADT $ UnsatExpr (jsUnsat_ is' x'')
+    JMGVal  _ -> jtoGADT $ UnsatVal (jsUnsat_ is' x'')
+    JMGId _ -> jtoGADT $ f x
+    where
+        (x', (StrI l : _)) = runState (runIdentSupply $ jsSaturate_ x) is
+        is' = take lastVal is
+        x'' = f x'
+        lastVal = readNote ("inSat" ++ un) (reverse . takeWhile (/= '_') . reverse $ l) :: Int
+        is = newIdentSupply $ Just ("inSat" ++ un)
 
 -- | Takes a fully saturated expression and transforms it to use unique variables that respect scope.
 scopify :: JStat -> JStat
-scopify x = evalState (fromMC <$> go (toMC x)) (newIdentSupply Nothing)
-    where go v = case v of
-                   (MStat (BlockStat ss)) -> MStat . BlockStat <$>
+scopify x = evalState (jfromGADT <$> go (jtoGADT x)) (newIdentSupply Nothing)
+    where go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
+          go v = case v of
+                   (JMGStat (BlockStat ss)) -> JMGStat . BlockStat <$>
                                              blocks ss
                        where blocks [] = return []
                              blocks (DeclStat (StrI i) t : xs) =  case i of
                                 ('!':'!':i') -> (DeclStat (StrI i') t:) <$> blocks xs
                                 ('!':i') -> (DeclStat (StrI i') t:) <$> blocks xs
-                                _ -> do
-                                  (newI:st) <- get
-                                  put st
-                                  rest <- blocks xs
-                                  return $ [DeclStat newI t `mappend` jsReplace_ [(StrI i, newI)] (BlockStat rest)]
-                             blocks (x':xs) = (fromMC <$> go (toMC x')) <:> blocks xs
+                                _ -> get >>= \case
+                                     (newI:st) -> do
+                                       put st
+                                       rest <- blocks xs
+                                       return $ [DeclStat newI t `mappend` jsReplace_ [(StrI i, newI)] (BlockStat rest)]
+                                     _ -> error "scopify"
+                             blocks (x':xs) = (jfromGADT <$> go (jtoGADT x')) <:> blocks xs
                              (<:>) = liftM2 (:)
-                   (MStat (ForInStat b (StrI i) e s)) -> do
-                          (newI:st) <- get
-                          put st
-                          rest <- fromMC <$> go (toMC s)
-                          return $ MStat . ForInStat b newI e $ jsReplace_ [(StrI i, newI)] rest
-                   (MStat (TryStat s (StrI i) s1 s2)) -> do
-                          (newI:st) <- get
-                          put st
-                          t <- fromMC <$> go (toMC s)
-                          c <- fromMC <$> go (toMC s1)
-                          f <- fromMC <$> go (toMC s2)
-                          return . MStat . TryStat t newI (jsReplace_ [(StrI i, newI)] c) $ f
-                   (MExpr (ValExpr (JFunc is s))) -> do
+                   (JMGStat (ForInStat b (StrI i) e s)) -> get >>= \case
+                          (newI:st) -> do
+                             put st
+                             rest <- jfromGADT <$> go (jtoGADT s)
+                             return $ JMGStat . ForInStat b newI e $ jsReplace_ [(StrI i, newI)] rest
+                          _ -> error "scopify2"
+                   (JMGStat (TryStat s (StrI i) s1 s2)) -> get >>= \case
+                          (newI:st) -> do
+                            put st
+                            t <- jfromGADT <$> go (jtoGADT s)
+                            c <- jfromGADT <$> go (jtoGADT s1)
+                            f <- jfromGADT <$> go (jtoGADT s2)
+                            return . JMGStat . TryStat t newI (jsReplace_ [(StrI i, newI)] c) $ f
+                          _ -> error "scopify3"
+                   (JMGExpr (ValExpr (JFunc is s))) -> do
                             st <- get
                             let (newIs,newSt) = splitAt (length is) st
                             put (newSt)
-                            rest <- fromMC <$> go (toMC s)
-                            return . MExpr . ValExpr $ JFunc newIs $ (jsReplace_ $ zip is newIs) rest
+                            rest <- jfromGADT <$> go (jtoGADT s)
+                            return . JMGExpr . ValExpr $ JFunc newIs $ (jsReplace_ $ zip is newIs) rest
                    _ -> composOpM go v
 
 {--------------------------------------------------------------------
@@ -436,10 +483,10 @@
 renderPrefixJs pfx = jsToDoc . jsSaturate (Just $ "jmId_"++pfx)
 
 braceNest :: Doc -> Doc
-braceNest x = char '{' $$ nest 2 x $$ char '}'
+braceNest x = char '{' <+> nest 2 x $$ char '}'
 
 braceNest' :: Doc -> Doc
-braceNest' x = char '{' $+$ nest 2 x $$ char '}'
+braceNest' x = nest 2 (char '{' $+$ x) $$ char '}'
 
 class JsToDoc a
     where jsToDoc :: a -> Doc
@@ -452,17 +499,28 @@
         where rest = case t of
                        Nothing -> text ""
                        Just tp -> text " /* ::" <+> jsToDoc tp <+> text "*/"
-    jsToDoc (WhileStat p b)  = text "while" <> parens (jsToDoc p) $$ braceNest' (jsToDoc b)
+    jsToDoc (WhileStat False p b)  = text "while" <> parens (jsToDoc p) $$ braceNest' (jsToDoc b)
+    jsToDoc (WhileStat True  p b)  = (text "do" $$ braceNest' (jsToDoc b)) $+$ text "while" <+> parens (jsToDoc p)
     jsToDoc (UnsatBlock e) = jsToDoc $ sat_ e
-    jsToDoc BreakStat = text "break"
+
+    jsToDoc (BreakStat l) = maybe (text "break") (((<+>) `on` text) "break" . T.pack) l
+    jsToDoc (ContinueStat l) = maybe (text "continue") (((<+>) `on` text) "continue" . T.pack) l
+    jsToDoc (LabelStat l s) = text (T.pack l) <> char ':' $$ printBS s
+        where
+          printBS (BlockStat ss) = vcat $ interSemi $ flattenBlocks ss
+          printBS x = jsToDoc x
+          interSemi [x] = [jsToDoc x]
+          interSemi [] = []
+          interSemi (x:xs) = (jsToDoc x <> semi) : interSemi xs
+
     jsToDoc (ForInStat each i e b) = text txt <> parens (text "var" <+> jsToDoc i <+> text "in" <+> jsToDoc e) $$ braceNest' (jsToDoc b)
         where txt | each = "for each"
                   | otherwise = "for"
     jsToDoc (SwitchStat e l d) = text "switch" <+> parens (jsToDoc e) $$ braceNest' cases
-        where l' = map (\(c,s) -> text "case" <+> parens (jsToDoc c) <> char ':' $$ nest 2 (jsToDoc [s])) l ++ [text "default:" $$ nest 2 (jsToDoc [d])]
+        where l' = map (\(c,s) -> (text "case" <+> parens (jsToDoc c) <> char ':') $$$ (jsToDoc s)) l ++ [text "default:" $$$ (jsToDoc d)]
               cases = vcat l'
     jsToDoc (ReturnStat e) = text "return" <+> jsToDoc e
-    jsToDoc (ApplStat e es) = jsToDoc e <> (parens . fsep . punctuate comma $ map jsToDoc es)
+    jsToDoc (ApplStat e es) = jsToDoc e <> (parens . fillSep . punctuate comma $ map jsToDoc es)
     jsToDoc (TryStat s i s1 s2) = text "try" $$ braceNest' (jsToDoc s) $$ mbCatch $$ mbFinally
         where mbCatch | s1 == BlockStat [] = PP.empty
                       | otherwise = text "catch" <> parens (jsToDoc i) $$ braceNest' (jsToDoc s1)
@@ -470,49 +528,56 @@
                         | otherwise = text "finally" $$ braceNest' (jsToDoc s2)
     jsToDoc (AssignStat i x) = jsToDoc i <+> char '=' <+> jsToDoc x
     jsToDoc (PPostStat isPre op x)
-        | isPre = text op <> jsToDoc x
-        | otherwise = jsToDoc x <> text op
-    jsToDoc (AntiStat s) = text $ "`(" ++ s ++ ")`"
+        | isPre = text (T.pack op) <> optParens x
+        | otherwise = optParens x <> text (T.pack op)
+    jsToDoc (AntiStat s) = text . T.pack $ "`(" ++ s ++ ")`"
     jsToDoc (ForeignStat i t) = text "//foriegn" <+> jsToDoc i <+> text "::" <+> jsToDoc t
     jsToDoc (BlockStat xs) = jsToDoc (flattenBlocks xs)
-        where flattenBlocks (BlockStat y:ys) = flattenBlocks y ++ flattenBlocks ys
-              flattenBlocks (y:ys) = y : flattenBlocks ys
-              flattenBlocks [] = []
 
+flattenBlocks :: [JStat] -> [JStat]
+flattenBlocks (BlockStat y:ys) = flattenBlocks y ++ flattenBlocks ys
+flattenBlocks (y:ys) = y : flattenBlocks ys
+flattenBlocks [] = []
+
+optParens :: JExpr -> Doc
+optParens x = case x of
+                (PPostExpr _ _ _) -> parens (jsToDoc x)
+                _ -> jsToDoc x
+
 instance JsToDoc JExpr where
     jsToDoc (ValExpr x) = jsToDoc x
     jsToDoc (SelExpr x y) = cat [jsToDoc x <> char '.', jsToDoc y]
     jsToDoc (IdxExpr x y) = jsToDoc x <> brackets (jsToDoc y)
     jsToDoc (IfExpr x y z) = parens (jsToDoc x <+> char '?' <+> jsToDoc y <+> char ':' <+> jsToDoc z)
-    jsToDoc (InfixExpr op x y) = parens $ sep [jsToDoc x, text op', jsToDoc y]
+    jsToDoc (InfixExpr op x y) = parens $ sep [jsToDoc x, text (T.pack op'), jsToDoc y]
         where op' | op == "++" = "+"
                   | otherwise = op
 
     jsToDoc (PPostExpr isPre op x)
-        | isPre = text op <> jsToDoc x
-        | otherwise = jsToDoc x <> text op
+        | isPre = text (T.pack op) <> optParens x
+        | otherwise = optParens x <> text (T.pack op)
 
-    jsToDoc (ApplExpr je xs) = jsToDoc je <> (parens . fsep . punctuate comma $ map jsToDoc xs)
+    jsToDoc (ApplExpr je xs) = jsToDoc je <> (parens . fillSep . punctuate comma $ map jsToDoc xs)
     jsToDoc (NewExpr e) = text "new" <+> jsToDoc e
-    jsToDoc (AntiExpr s) = text $ "`(" ++ s ++ ")`"
+    jsToDoc (AntiExpr s) = text . T.pack $ "`(" ++ s ++ ")`"
     jsToDoc (TypeExpr b e t)  = parens $ jsToDoc e <+> text (if b then "/* ::!" else "/* ::") <+> jsToDoc t <+> text "*/"
     jsToDoc (UnsatExpr e) = jsToDoc $ sat_ e
 
 instance JsToDoc JVal where
     jsToDoc (JVar i) = jsToDoc i
-    jsToDoc (JList xs) = brackets . fsep . punctuate comma $ map jsToDoc xs
-    jsToDoc (JDouble d) = double d
+    jsToDoc (JList xs) = brackets . fillSep . punctuate comma $ map jsToDoc xs
+    jsToDoc (JDouble (SaneDouble d)) = double d
     jsToDoc (JInt i) = integer i
-    jsToDoc (JStr s) = text ("\""++encodeJson s++"\"")
-    jsToDoc (JRegEx s) = text ("/"++s++"/")
+    jsToDoc (JStr s) = text . T.pack $ "\""++encodeJson s++"\""
+    jsToDoc (JRegEx s) = text . T.pack $ "/"++s++"/"
     jsToDoc (JHash m)
             | M.null m = text "{}"
-            | otherwise = braceNest . fsep . punctuate comma . map (\(x,y) -> quotes (text x) <> colon <+> jsToDoc y) $ M.toList m
-    jsToDoc (JFunc is b) = parens $ text "function" <> parens (fsep . punctuate comma . map jsToDoc $ is) $$ braceNest' (jsToDoc b)
+            | otherwise = braceNest . fillSep . punctuate comma . map (\(x,y) -> squotes (text (T.pack x)) <> colon <+> jsToDoc y) $ M.toList m
+    jsToDoc (JFunc is b) = parens $ text "function" <> parens (fillSep . punctuate comma . map jsToDoc $ is) $$ braceNest' (jsToDoc b)
     jsToDoc (UnsatVal f) = jsToDoc $ sat_ f
 
 instance JsToDoc Ident where
-    jsToDoc (StrI s) = text s
+    jsToDoc (StrI s) = text (T.pack s)
 
 instance JsToDoc [JExpr] where
     jsToDoc = vcat . map ((<> semi) . jsToDoc)
@@ -526,14 +591,14 @@
     jsToDoc JTBool = text "Bool"
     jsToDoc JTStat = text "()"
     jsToDoc JTImpossible = text "_|_" -- "⊥"
-    jsToDoc (JTForall vars t) = text "forall" <+> fsep  (punctuate comma (map ppRef vars)) <> text "." <+> jsToDoc t
-    jsToDoc (JTFunc args ret) = fsep . punctuate (text " ->") . map ppType $ args' ++ [ret]
+    jsToDoc (JTForall vars t) = text "forall" <+> fillSep  (punctuate comma (map ppRef vars)) <> text "." <+> jsToDoc t
+    jsToDoc (JTFunc args ret) = fillSep . punctuate (text " ->") . map ppType $ args' ++ [ret]
         where args'
                | null args = [JTStat]
                | otherwise = args
     jsToDoc (JTList t) = brackets $ jsToDoc t
     jsToDoc (JTMap t) = text "Map" <+> ppType t
-    jsToDoc (JTRecord t mp) = braces (fsep . punctuate comma . map (\(x,y) -> text x <+> text "::" <+> jsToDoc y) $ M.toList mp) <+> text "[" <> jsToDoc t <> text "]"
+    jsToDoc (JTRecord t mp) = braces (fillSep . punctuate comma . map (\(x,y) -> text (T.pack x) <+> text "::" <+> jsToDoc y) $ M.toList mp) <+> text "[" <> jsToDoc t <> text "]"
     jsToDoc (JTFree ref) = ppRef ref
     jsToDoc (JTRigid ref cs) = text "[" <> ppRef ref <> text "]"
 {-
@@ -545,16 +610,19 @@
 instance JsToDoc JLocalType where
     jsToDoc (cs,t) = maybe (text "") (<+> text "=> ") (ppConstraintList cs) <> jsToDoc t
 
+ppConstraintList :: Show a => [((Maybe String, a), Constraint)] -> Maybe Doc
 ppConstraintList cs
     | null cs = Nothing
-    | otherwise = Just . parens . fsep . punctuate comma $ map go cs
+    | otherwise = Just . parens . fillSep . punctuate comma $ map go cs
     where
       go (vr,Sub   t') = ppRef vr   <+> text "<:" <+> jsToDoc t'
       go (vr,Super t') = jsToDoc t' <+> text "<:" <+> ppRef vr
 
+ppRef :: Show a => (Maybe String, a) -> Doc
+ppRef (Just n,_) = text . T.pack $ n
+ppRef (_,i) = text . T.pack $ "t_"++show i
 
-ppRef (Just n,_) = text n
-ppRef (_,i) = text $ "t_"++show i
+ppType :: JType -> Doc
 ppType x@(JTFunc _ _) = parens $ jsToDoc x
 ppType x@(JTMap _) = parens $ jsToDoc x
 ppType x = jsToDoc x
@@ -591,7 +659,7 @@
     toJExpr = ValExpr . JHash . M.map toJExpr
 
 instance ToJExpr Double where
-    toJExpr = ValExpr . JDouble
+    toJExpr = ValExpr . JDouble . SaneDouble
 
 instance ToJExpr Int where
     toJExpr = ValExpr . JInt . fromIntegral
@@ -604,6 +672,13 @@
     toJExprFromList = ValExpr . JStr
 --        where escQuotes = tailDef "" . initDef "" . show
 
+instance ToJExpr TS.Text where
+    toJExpr t = toJExpr (TS.unpack t)
+
+instance ToJExpr T.Text where
+    toJExpr t = toJExpr (T.unpack t)
+
+
 instance (ToJExpr a, ToJExpr b) => ToJExpr (a,b) where
     toJExpr (a,b) = ValExpr . JList $ [toJExpr a, toJExpr b]
 
@@ -705,7 +780,7 @@
 jsv = ValExpr . JVar . StrI
 
 jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat
-jFor before p after b = BlockStat [before, WhileStat (toJExpr p) b']
+jFor before p after b = BlockStat [before, WhileStat False (toJExpr p) b']
     where b' = case toStat b of
                  BlockStat xs -> BlockStat $ xs ++ [after]
                  x -> BlockStat [x,after]
@@ -728,19 +803,24 @@
 nullStat :: JStat
 nullStat = BlockStat []
 
-
--- JSON instance
-instance ToJExpr JSValue where
-    toJExpr JSNull             = ValExpr $ JVar $ StrI "null"
-    toJExpr (JSBool b)         = ValExpr $ JVar $ StrI $ map toLower (show b)
-    toJExpr (JSRational b rat) = ValExpr $ JDouble $ realToFrac rat
-    toJExpr (JSString s)       = ValExpr $ JStr $ fromJSString s
-    toJExpr (JSArray vs)       = ValExpr $ JList $ map toJExpr vs
-    toJExpr (JSObject obj)     = ValExpr $ JHash $ M.fromList $ map (second toJExpr) $ fromJSObject obj
+-- Aeson instance
+instance ToJExpr Value where
+    toJExpr Null             = ValExpr $ JVar $ StrI "null"
+    toJExpr (Bool b)         = ValExpr $ JVar $ StrI $ map toLower (show b)
+    toJExpr (Number n)       = ValExpr $ JDouble $ realToFrac n
+    toJExpr (String s)       = ValExpr $ JStr $ TS.unpack s
+    toJExpr (Array vs)       = ValExpr $ JList $ map toJExpr $ V.toList vs
+#if MIN_VERSION_aeson (2,0,0)
+    toJExpr (Object obj)     = ValExpr $ JHash $ M.fromList $ map (KM.toString *** toJExpr) $ KM.toList obj
+#else
+    toJExpr (Object obj)     = ValExpr $ JHash $ M.fromList $ map (TS.unpack *** toJExpr) $ HM.toList obj
+#endif
 
 -------------------------
 
 -- Taken from json package by Sigbjorn Finne.
+
+encodeJson :: String -> String
 encodeJson = concatMap encodeJsonChar
 
 encodeJsonChar :: Char -> String
@@ -759,4 +839,3 @@
     | c < '\x1000' = '\\' : 'u' : '0' : hexxs
     where hexxs = showHex (fromEnum c) "" -- FIXME
 encodeJsonChar c = [c]
-
diff --git a/Language/Javascript/JMacro/Benchmark.hs b/Language/Javascript/JMacro/Benchmark.hs
new file mode 100644
--- /dev/null
+++ b/Language/Javascript/JMacro/Benchmark.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+import Criterion.Main
+import Language.Javascript.JMacro
+import Text.PrettyPrint.Leijen.Text (renderPretty, renderCompact, displayT)
+
+main = defaultMain [pretty, compact]
+
+pretty = bench "pretty" $ nf (displayT . renderPretty 0.4 100 . renderJs) jmPrelude
+
+compact = bench "compact" $ nf (displayT . renderCompact . renderJs) jmPrelude
diff --git a/Language/Javascript/JMacro/Executable.hs b/Language/Javascript/JMacro/Executable.hs
--- a/Language/Javascript/JMacro/Executable.hs
+++ b/Language/Javascript/JMacro/Executable.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE GADTs, RankNTypes #-}
+
 module Main where
 
+import Text.PrettyPrint.Leijen.Text (hPutDoc)
 import Control.Applicative
 import Control.Monad
 import Language.Javascript.JMacro
@@ -17,7 +20,7 @@
    let s = gotArg args "Scope"
    infile <- getArgStdio args "Infile" ReadMode
    outfile <- getArgStdio args "Outfile" WriteMode
-   either (hPrint stderr) (hPrint outfile) . parseIt s =<< hGetContents infile
+   either (hPrint stderr) (hPutDoc outfile) . parseIt s =<< hGetContents infile
   where
     parseIt True  = onRight (renderJs . scopify)  . parseJM
     parseIt False = onRight (renderJs . fixIdent) . parseJM
@@ -25,8 +28,10 @@
     onRight f (Right x) = Right (f x)
     onRight _ (Left x) = (Left x)
 
-    fixIdent x = fromMC $ composOp go (toMC x) :: JStat
-        where go v = case v of
-                       (MStat (DeclStat (StrI ('!':'!':i')) t)) -> MStat (DeclStat (StrI i') t)
-                       (MStat (DeclStat (StrI ('!':i')) t)) -> MStat (DeclStat (StrI i') t)
+    fixIdent x = jfromGADT $ composOp go (jtoGADT x) :: JStat
+        where
+          go :: forall a. JMGadt a -> JMGadt a
+          go v = case v of
+                       (JMGStat (DeclStat (StrI ('!':'!':i')) t)) -> JMGStat (DeclStat (StrI i') t)
+                       (JMGStat (DeclStat (StrI ('!':i')) t)) -> JMGStat (DeclStat (StrI i') t)
                        _ -> composOp go v
diff --git a/Language/Javascript/JMacro/Prelude.hs b/Language/Javascript/JMacro/Prelude.hs
--- a/Language/Javascript/JMacro/Prelude.hs
+++ b/Language/Javascript/JMacro/Prelude.hs
@@ -12,10 +12,11 @@
 import Language.Javascript.JMacro.Base
 import Language.Javascript.JMacro.QQ
 
+
 -- | This provides a set of basic functional programming primitives, a few utility functions
 -- and, more importantly, a decent sample of idiomatic jmacro code. View the source for details.
 jmPrelude :: JStat
-jmPrelude = [$jmacro|
+jmPrelude = [jmacro|
 
     fun withHourglass f {
           document.body.style.cursor="wait";
diff --git a/Language/Javascript/JMacro/QQ.hs b/Language/Javascript/JMacro/QQ.hs
--- a/Language/Javascript/JMacro/QQ.hs
+++ b/Language/Javascript/JMacro/QQ.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, TemplateHaskell, QuasiQuotes #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, TemplateHaskell, QuasiQuotes, RankNTypes, GADTs #-}
 
 -----------------------------------------------------------------------------
 {- |
@@ -12,12 +12,12 @@
 -}
 -----------------------------------------------------------------------------
 
-module Language.Javascript.JMacro.QQ(jmacro,jmacroE,parseJM) where
+module Language.Javascript.JMacro.QQ(jmacro,jmacroE,parseJM,parseJME) where
 import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
-import Control.Applicative hiding ((<|>),many,optional,(<*))
+import Control.Applicative hiding ((<|>),many,optional)
 import Control.Arrow(first)
+import Control.Monad (ap, return, liftM2, liftM3, when, mzero, guard)
 import Control.Monad.State.Strict
-import qualified Data.ByteString.Char8 as BS
 import Data.Char(digitToInt, toLower, isUpper)
 import Data.List(isPrefixOf, sort)
 import Data.Generics(extQ,Data)
@@ -46,9 +46,7 @@
 import System.IO.Unsafe
 import Numeric(readHex)
 
--- import Web.Encodings
-
---import Debug.Trace
+-- import Debug.Trace
 
 {--------------------------------------------------------------------
   QuasiQuotation
@@ -96,23 +94,25 @@
 -- Don't replace identifiers on the right hand side of selector
 -- expressions.
 antiIdent :: JMacro a => String -> a -> a
-antiIdent s e = fromMC $ go (toMC e)
-    where go (MExpr (ValExpr (JVar (StrI s'))))
-             | s == s' = MExpr (AntiExpr $ fixIdent s)
-          go (MExpr (SelExpr x i)) =
-              MExpr (SelExpr (antiIdent s x) i)
+antiIdent s e = jfromGADT $ go (jtoGADT e)
+    where go :: forall a. JMGadt a -> JMGadt a
+          go (JMGExpr (ValExpr (JVar (StrI s'))))
+             | s == s' = JMGExpr (AntiExpr $ fixIdent s)
+          go (JMGExpr (SelExpr x i)) =
+              JMGExpr (SelExpr (antiIdent s x) i)
           go x = composOp go x
 
 antiIdents :: JMacro a => [String] -> a -> a
 antiIdents ss x = foldr antiIdent x ss
 
 fixIdent :: String -> String
+fixIdent "_" = "_x_"
 fixIdent css@(c:_)
     | isUpper c = '_' : escapeDollar css
     | otherwise = escapeDollar css
   where
     escapeDollar = map (\x -> if x =='$' then 'dž' else x)
-fixIdent _ = "_"
+fixIdent _ = "_x_"
 
 
 jm2th :: Data a => a -> TH.ExpQ
@@ -233,13 +233,17 @@
 
 jsLang :: P.LanguageDef ()
 jsLang = javaStyle {
-           P.reservedNames = ["var","return","if","else","while","for","in","break","new","function","switch","case","default","fun","try","catch","finally","foreign"],
-           P.reservedOpNames = ["|>","<|","+=","-=","*=","/=","%=","--","*","/","+","-",".","%","?","=","==","!=","<",">","&&","||","++","===",">=","<=","->","::","::!",":|","@"],
+           P.reservedNames = ["var","return","if","else","while","for","in","break","continue","new","function","switch","case","default","fun","try","catch","finally","foreign","do"],
+           P.reservedOpNames = ["|>","<|","+=","-=","*=","/=","%=","<<=", ">>=", ">>>=", "&=", "^=", "|=", "--","*","/","+","-",".","%","?","=","==","!=","<",">","&&","||","&", "^", "|", "++","===","!==", ">=","<=","!", "~", "<<", ">>", ">>>", "->","::","::!",":|","@"],
            P.identLetter = alphaNum <|> oneOf "_$",
            P.identStart  = letter <|> oneOf "_$",
+           P.opStart = oneOf "|+-/*%<>&^.?=!~:@",
+           P.opLetter = oneOf "|+-/*%<>&^.?=!~:@",
            P.commentLine = "//",
            P.commentStart = "/*",
-           P.commentEnd = "*/"}
+           P.commentEnd = "*/",
+           P.caseSensitive = True
+           }
 
 identifierWithBang = P.identifier $ P.makeTokenParser $ jsLang {P.identStart = letter <|> oneOf "_$!"}
 
@@ -260,8 +264,8 @@
 lexeme :: JMParser a -> JMParser a
 lexeme    = P.lexeme lexer
 
-(<*) :: Monad m => m b -> m a -> m b
-x <* y = do
+(<<*) :: Monad m => m b -> m a -> m b
+x <<* y = do
   xr <- x
   _ <- y
   return xr
@@ -357,6 +361,7 @@
 patternBlocks :: JMParser ([Ident],[JStat])
 patternBlocks = fmap concat . unzip . zipWith (\i efr -> either (\f -> (i, f i)) id efr) (map (StrI . ("jmId_match_" ++) . show) [(1::Int)..]) <$> many patternBinding
 
+destructuringDecl :: JMParser [JStat]
 destructuringDecl = do
     (i,patDecls) <- either (\f -> (matchVar, f matchVar)) id <$> patternBinding
     optAssignStat <- optionMaybe $ do
@@ -386,16 +391,20 @@
             <|> functionDecl
             <|> foreignStat
             <|> returnStat
+            <|> labelStat
             <|> ifStat
             <|> whileStat
             <|> switchStat
             <|> forStat
+            <|> doWhileStat
             <|> braces statblock
             <|> assignOpStat
             <|> tryStat
             <|> applStat
             <|> breakStat
+            <|> continueStat
             <|> antiStat
+            <|> antiStatSimple
           <?> "statement"
     where
       declStat = do
@@ -427,12 +436,12 @@
 
       foreignStat = do
           reserved "foreign"
-          i <- try $ identdecl <* reservedOp "::"
+          i <- try $ identdecl <<* reservedOp "::"
           t <- runTypeParser
           return [ForeignStat i t]
 
       returnStat =
-        reserved "return" >> (:[]) . ReturnStat <$> option (ValExpr $ JVar $ StrI "null") expr
+        reserved "return" >> (:[]) . ReturnStat <$> option (ValExpr $ JVar $ StrI "undefined") expr
 
       ifStat = do
         reserved "if"
@@ -447,9 +456,12 @@
           else return $ [IfStat p b nullStat]
 
       whileStat =
-          reserved "while" >> liftM2 (\e b -> [WhileStat e (l2s b)])
+          reserved "while" >> liftM2 (\e b -> [WhileStat False e (l2s b)])
                               (parens expr) statementOrEmpty
 
+      doWhileStat = reserved "do" >> liftM2 (\b e -> [WhileStat True e (l2s b)])
+                    statementOrEmpty (reserved "while" *> parens expr)
+
       switchStat = do
         reserved "switch"
         e <- parens $ expr
@@ -457,7 +469,7 @@
         return $ [SwitchStat e l (l2s d)]
 
       caseStat =
-        reserved "case" >> liftM2 (,) expr (char ':' >> l2s <$> statblock0)
+        reserved "case" >> liftM2 (,) expr (char ':' >> l2s <$> statblock)
 
       tryStat = do
         reserved "try"
@@ -499,11 +511,11 @@
         b <- statement
         return $ jFor' before after p b
           where threeStat =
-                    liftM3 (,,) (statement)
-                                (expr)
-                                (semi >> statement)
-                jFor' :: (ToJExpr a) => [JStat] -> a -> [JStat] -> [JStat] -> [JStat]
-                jFor' before p after bs = before ++ [WhileStat (toJExpr p) b']
+                    liftM3 (,,) (option [] statement <<* optional semi)
+                                (optionMaybe expr <<* semi)
+                                (option [] statement)
+                jFor' :: [JStat] -> Maybe JExpr -> [JStat]-> [JStat] -> [JStat]
+                jFor' before p after bs = before ++ [WhileStat False (fromMaybe (jsv "true") p) b']
                     where b' = BlockStat $ bs ++ after
 
       assignOpStat = do
@@ -511,14 +523,21 @@
           (e1,op) <- try $ liftM2 (,) dotExpr (fmap (take 1) $
                                                    rop "="
                                                <|> rop "+="
+                                               <|> rop "-="
                                                <|> rop "*="
                                                <|> rop "/="
                                                <|> rop "%="
+                                               <|> rop "<<="
+                                               <|> rop ">>="
+                                               <|> rop ">>>="
+                                               <|> rop "&="
+                                               <|> rop "^="
+                                               <|> rop "|="
                                               )
-          let gofail = fail ("Invalid assignment.")
+          let gofail  = fail ("Invalid assignment.")
+              badList = ["this","true","false","undefined","null"]
           case e1 of
-            ValExpr (JVar (StrI "this")) -> gofail
-            ValExpr (JVar _) -> return ()
+            ValExpr (JVar (StrI s)) -> if s `elem` badList then gofail else return ()
             ApplExpr _ _ -> gofail
             ValExpr _ -> gofail
             _ -> return ()
@@ -541,17 +560,40 @@
       expr2stat' _ = fail "Value expression used as statement"
 -}
 
-      breakStat = reserved "break" >> return [BreakStat]
+      breakStat = do
+        reserved "break"
+        l <- optionMaybe myIdent
+        return [BreakStat l]
 
+      continueStat = do
+        reserved "continue"
+        l <- optionMaybe myIdent
+        return [ContinueStat l]
+
+      labelStat = do
+        lbl <- try $ do
+                    l <- myIdent <<* char ':'
+                    guard (l /= "default")
+                    return l
+        s <- l2s <$> statblock0
+        return [LabelStat lbl s]
+
       antiStat  = return . AntiStat <$> do
         x <- (try (symbol "`(") >> anyChar `manyTill` try (symbol ")`"))
         either (fail . ("Bad AntiQuotation: \n" ++))
                (const (return x))
                (parseHSExp x)
 
+      antiStatSimple  = return . AntiStat <$> do
+        x <- (symbol "`" >> anyChar `manyTill` symbol "`")
+        either (fail . ("Bad AntiQuotation: \n" ++))
+               (const (return x))
+               (parseHSExp x)
+
 --args :: JMParser [JExpr]
 --args = parens $ commaSep expr
 
+compileRegex :: String -> Either WrapError Regex
 compileRegex s = unsafePerformIO $ compile co eo s
     where co = compExtended
           eo = execBlank
@@ -577,23 +619,33 @@
           let ans = (IfExpr e t el)
           addIf ans <|> return ans
     rawExpr = buildExpressionParser table dotExpr <?> "expression"
-    table = [[iop "*", iop "/", iop "%"],
+    table = [[pop "~", pop "!", negop],
+             [iop "*", iop "/", iop "%"],
              [pop "++", pop "--"],
              [iop "++", iop "+", iop "-", iop "--"],
+             [iop "<<", iop ">>", iop ">>>"],
              [consOp],
              [iope "==", iope "!=", iope "<", iope ">",
-              iope ">=", iope "<=", iope "==="],
-             [iop "&&", iop "||"],
+              iope ">=", iope "<=", iope "===", iope "!=="],
+             [iop "&"],
+             [iop "^"],
+             [iop "|"],
+             [iop "&&"],
+             [iop "||"],
              [applOp, applOpRev]
             ]
     pop  s  = Prefix (reservedOp s >> return (PPostExpr True s))
     iop  s  = Infix (reservedOp s >> return (InfixExpr s)) AssocLeft
     iope s  = Infix (reservedOp s >> return (InfixExpr s)) AssocNone
     applOp  = Infix (reservedOp "<|" >> return (\x y -> ApplExpr x [y])) AssocRight
-    applOpRev  = Infix (reservedOp "|>" >> return (\x y -> ApplExpr y [x])) AssocLeft
+    applOpRev = Infix (reservedOp "|>" >> return (\x y -> ApplExpr y [x])) AssocLeft
     consOp  = Infix (reservedOp ":|" >> return consAct) AssocRight
     consAct x y = ApplExpr (ValExpr (JFunc [StrI "x",StrI "y"] (BlockStat [BlockStat [DeclStat (StrI "tmp") Nothing, AssignStat tmpVar (ApplExpr (SelExpr (ValExpr (JVar (StrI "x"))) (StrI "slice")) [ValExpr (JInt 0)]),ApplStat (SelExpr tmpVar (StrI "unshift")) [ValExpr (JVar (StrI "y"))],ReturnStat tmpVar]]))) [x,y]
         where tmpVar = ValExpr (JVar (StrI "tmp"))
+    negop   = Prefix (reservedOp "-" >> return negexp)
+    negexp (ValExpr (JDouble n)) = ValExpr (JDouble (-n))
+    negexp (ValExpr (JInt    n)) = ValExpr (JInt    (-n))
+    negexp x                     = PPostExpr True "-" x
 
 dotExpr :: JMParser JExpr
 dotExpr = do
@@ -604,7 +656,7 @@
     _ -> error "exprApp"
 
 dotExprOne :: JMParser JExpr
-dotExprOne = addNxt =<< valExpr <|> antiExpr <|> parens' expr <|> notExpr <|> newExpr
+dotExprOne = addNxt =<< valExpr <|> antiExpr <|> antiExprSimple <|> parens' expr <|> notExpr <|> newExpr
   where
     addNxt e = do
             nxt <- (Just <$> lookAhead anyChar <|> return Nothing)
@@ -629,9 +681,14 @@
                 (const (return x))
                 (parseHSExp x)
 
-    valExpr = ValExpr <$> (num <|> negnum <|> str <|> try regex <|> list <|> hash <|> func <|> var) <?> "value"
+    antiExprSimple  = AntiExpr <$> do
+         x <- (symbol "`" >> anyChar `manyTill` string "`")
+         either (fail . ("Bad AntiQuotation: \n" ++))
+                (const (return x))
+                (parseHSExp x)
+
+    valExpr = ValExpr <$> (num <|> str <|> try regex <|> list <|> hash <|> func <|> var) <?> "value"
         where num = either JInt JDouble <$> try natFloat
-              negnum = either (JInt . negate) (JDouble . negate) <$> try (char '-' >> natFloat)
               str   = JStr   <$> (myStringLiteral '"' <|> myStringLiteral '\'')
               regex = do
                 s <- regexLiteral --myStringLiteralNoBr '/'
@@ -649,22 +706,22 @@
               statOrEblock  = try (ReturnStat <$> expr `folBy` '}') <|> (l2s <$> statblock)
               propPair = liftM2 (,) myIdent (colon >> expr)
 
---notFolBy a b = a <* notFollowedBy (char b)
+--notFolBy a b = a <<* notFollowedBy (char b)
 folBy :: JMParser a -> Char -> JMParser a
-folBy a b = a <* (lookAhead (char b) >>= const (return ()))
+folBy a b = a <<* (lookAhead (char b) >>= const (return ()))
 
 --Parsers without Lexeme
 braces', brackets', parens', oxfordBraces :: JMParser a -> JMParser a
 brackets' = around' '[' ']'
 braces' = around' '{' '}'
 parens' = around' '(' ')'
-oxfordBraces x = lexeme (reservedOp "{|") >> (lexeme x <* reservedOp "|}")
+oxfordBraces x = lexeme (reservedOp "{|") >> (lexeme x <<* reservedOp "|}")
 
 around' :: Char -> Char -> JMParser a -> JMParser a
-around' a b x = lexeme (char a) >> (lexeme x <* char b)
+around' a b x = lexeme (char a) >> (lexeme x <<* char b)
 
 myIdent :: JMParser String
-myIdent = lexeme $ many1 (alphaNum <|> oneOf "_-!@#$%^&*();") <|> myStringLiteral '\''
+myIdent = lexeme $ many1 (alphaNum <|> oneOf "_-!@#$%^&*()") <|> myStringLiteral '\''
 
 ident' :: JMParser Ident
 ident' = do
@@ -758,35 +815,35 @@
 
 -- Taken from json package by Sigbjorn Finne.
 decodeJson :: String -> JMParser String
-decodeJson x = parse [] x
+decodeJson x = parseIt [] x
  where
-  parse rs cs =
+  parseIt rs cs =
     case cs of
       '\\' : c : ds -> esc rs c ds
       c    : ds
-       | c >= '\x20' && c <= '\xff'    -> parse (c:rs) ds
+       | c >= '\x20' && c <= '\xff'    -> parseIt (c:rs) ds
        | c < '\x20'     -> fail $ "Illegal unescaped character in string: " ++ x
-       | i <= 0x10ffff  -> parse (c:rs) ds
+       | i <= 0x10ffff  -> parseIt (c:rs) ds
        | otherwise -> fail $ "Illegal unescaped character in string: " ++ x
        where
         i = (fromIntegral (fromEnum c) :: Integer)
       [] -> return $ reverse rs
 
   esc rs c cs = case c of
-   '\\' -> parse ('\\' : rs) cs
-   '"'  -> parse ('"'  : rs) cs
-   'n'  -> parse ('\n' : rs) cs
-   'r'  -> parse ('\r' : rs) cs
-   't'  -> parse ('\t' : rs) cs
-   'f'  -> parse ('\f' : rs) cs
-   'b'  -> parse ('\b' : rs) cs
-   '/'  -> parse ('/'  : rs) cs
+   '\\' -> parseIt ('\\' : rs) cs
+   '"'  -> parseIt ('"'  : rs) cs
+   'n'  -> parseIt ('\n' : rs) cs
+   'r'  -> parseIt ('\r' : rs) cs
+   't'  -> parseIt ('\t' : rs) cs
+   'f'  -> parseIt ('\f' : rs) cs
+   'b'  -> parseIt ('\b' : rs) cs
+   '/'  -> parseIt ('/'  : rs) cs
    'u'  -> case cs of
              d1 : d2 : d3 : d4 : cs' ->
                case readHex [d1,d2,d3,d4] of
-                 [(n,"")] -> parse (toEnum n : rs) cs'
+                 [(n,"")] -> parseIt (toEnum n : rs) cs'
 
-                 x -> fail $ "Unable to parse JSON String: invalid hex: " ++ (show x)
+                 badHex -> fail $ "Unable to parse JSON String: invalid hex: " ++ show badHex
              _ -> fail $ "Unable to parse JSON String: invalid hex: " ++ cs
    _ ->  fail $ "Unable to parse JSON String: invalid escape char: " ++ [c]
 
diff --git a/Language/Javascript/JMacro/Rpc.hs b/Language/Javascript/JMacro/Rpc.hs
deleted file mode 100644
--- a/Language/Javascript/JMacro/Rpc.hs
+++ /dev/null
@@ -1,122 +0,0 @@
-{-# LANGUAGE QuasiQuotes, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}
-
-{- |
-Module      :  Language.Javascript.JMacro.Rpc
-Copyright   :  (c) Gershom Bazerman, 2010
-License     :  BSD 3 Clause
-Maintainer  :  gershomb@gmail.com
-Stability   :  experimental
-
-Allows for the creation of rpc server/client pairs from monomorphic functions.
-The server portion
-is a function from a json-encoded list of parameters to a json
-response. A list of server functions are expected to be wrapped by a
-dispatch function in the server framework of your choice.
-
-The client
-portion generated from a function of arity n is a function from a
-string identifying a server or a subdirectory on a server to an arity
-n function from javascript expressions (of type
-'Language.Javascript.JMacro.Base.JExpr') to a single javascript
-expression. This expression, when evaluated on the client side, will
-call back to the provided server with json-serialized arguments and yield
-the result (deserialized from json). This client function is expected to be embedded
-via antiquotation into a larger block of jmacro code.
-
-Client portions must unfortunately be given explicit type signatures.
-
-The following example is a server/client pair providing an ajax call to add integers.
-
-> testRPCCall :: String -> JExpr -> JExpr -> JExpr
-> (testRPC, testRPCCall) = mkWebRPC "test" $ \x y -> asIO $ return (x + (y::Int))
-
-This code uses a simple request/response type based on strings to be as agnostic as possible about choice of web service stack. It can be used as is, or used as a model for code which targets a particular web stack (Happstack, Snap, FastCGI, etc.).
-
-The jQuery Javascript library is used to handle ajax requests, and hence pages which embed RPC calls must have the jQuery javascript library loaded.
-
--}
-
-module Language.Javascript.JMacro.Rpc (
-  -- * API
-  mkWebRPC, asIO, Request, Response(..), WebRPCDesc,
-  -- * Helper Classes
-  CallWebRPC(..),ToWebRPC(..)
-) where
-
-import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
-
-
-import Language.Javascript.JMacro.Base
-import Language.Javascript.JMacro.QQ
-
-import Text.JSON
-import Text.JSON.String
-
-type WebRPCDesc = (String, Request -> IO Response)
-
--- | A String containing a json representation of function arguments encoded as a list of parameters. Generally would be passed as part of an HTTP request.
-type Request = String
-
--- | Either a success or failure (with code). Generally would be turned back into a proper HTTP response.
-data Response = GoodResponse String
-              | BadResponse Int String
-
-returnResp :: JSON a => a -> IO Response
-returnResp r = return $ GoodResponse (encode r)
-respCode c e = BadResponse c e
-badData e = return $ respCode 400 ("Bad Data format: " ++ e)
-
-class ToWebRPC a where
-    toWebRPC_ :: a -> ([JSValue] -> IO Response)
-
-instance (JSON b) => ToWebRPC (IO b) where
-    toWebRPC_ f _ =  returnResp =<< f
-
-instance (JSON a, ToWebRPC b) => ToWebRPC (a -> b) where
-    toWebRPC_ f (x:xs) = case readJSON x of
-                           Ok v -> toWebRPC_ (f v) xs
-                           Error s -> badData s
-    toWebRPC_ _ _ = badData "missing parameter"
-
-toWebRPC :: ToWebRPC a => a -> Request -> IO Response
-toWebRPC f = \req -> case runGetJSON readJSArray req of
-                       (Right (JSArray xs)) ->f' xs
-                       (Left e) -> badData e
-                       _ -> badData "toWebRPC error"
-    where f' = toWebRPC_ f
-
-class CallWebRPC a b | a -> b where
-    callWebRPC_ :: [JExpr] -> String -> a -> b
-
-instance CallWebRPC (IO b) JExpr where
-    callWebRPC_ xs serverLoc _ =
-        [$jmacroE|
-         (\() { var res;
-//                $.post(`(serverLoc)`, { args : JSON.stringify `(reverse xs)` }, \(d) {res = d}, "json");
-                $.ajax({type    : "POST",
-                        url     : `(serverLoc)`,
-                        data    : { args : JSON.stringify `(reverse xs)` },
-                        success : \d {res = d},
-                        dataType: "json",
-                        async   : false
-                      });
-                return res;
-               }())|]
-
-instance (CallWebRPC b c, ToJExpr d) => CallWebRPC (a -> b) (d -> c) where
-    callWebRPC_ xs serverLoc f = \x -> callWebRPC_ (toJExpr x : xs) serverLoc (f undefined)
-
-callWebRPC :: (CallWebRPC a b) => String -> a -> b
-callWebRPC s f = callWebRPC_ [] s f
-
--- | Produce a pair of (ServerFunction, ClientFunction) from a function in IO
-mkWebRPC :: (ToWebRPC a, CallWebRPC a b) => String -> a -> (WebRPCDesc, String -> b)
-mkWebRPC name rpcFun = ((name,toWebRPC rpcFun), \server -> callWebRPC (server ++ "/" ++ name) rpcFun)
-
-
-testRPCCall :: String -> JExpr -> JExpr -> JExpr
-(testRPC, testRPCCall) = mkWebRPC "test" $ \x y -> asIO $ return (x + (y::Int))
-
--- | id with a helpful type.
-asIO :: IO a -> IO a
-asIO = id
diff --git a/Language/Javascript/JMacro/TypeCheck.hs b/Language/Javascript/JMacro/TypeCheck.hs
--- a/Language/Javascript/JMacro/TypeCheck.hs
+++ b/Language/Javascript/JMacro/TypeCheck.hs
@@ -1,36 +1,36 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, PatternGuards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, PatternGuards, RankNTypes, FlexibleContexts #-}
 
 module Language.Javascript.JMacro.TypeCheck where
 
 import Language.Javascript.JMacro.Base
 import Language.Javascript.JMacro.Types
-import Language.Javascript.JMacro.QQ
 
 import Control.Applicative
-import Control.Arrow((&&&))
 import Control.Monad
+import Control.Monad.Identity
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Writer
-import Control.Monad.Error
+import Control.Monad.Except
 import Data.Either
 import Data.Map (Map)
-import Data.Maybe(catMaybes, fromMaybe)
+import Data.Maybe(catMaybes)
 import Data.List(intercalate, nub, transpose)
 import qualified Data.Traversable as T
 import qualified Data.Foldable as F
 import qualified Data.Map as M
+import qualified Data.Text.Lazy as T
 import Data.Set(Set)
 import qualified Data.Set as S
 
-import Text.PrettyPrint.HughesPJ
+import Text.PrettyPrint.Leijen.Text hiding ((<$>))
 
-import Debug.Trace
 
 -- Utility
 
-isLeft (Left _) = True
-isLeft _ = False
+eitherIsLeft :: Either a b -> Bool
+eitherIsLeft (Left _) = True
+eitherIsLeft _ = False
 
 partitionOut :: (a -> Maybe b) -> [a] -> ([b],[a])
 partitionOut f xs' = foldr go ([],[]) xs'
@@ -53,6 +53,34 @@
 intersectionWithM :: (Monad m, Ord key) => (val -> val -> m b) -> Map key val -> Map key val -> m (Map key b)
 intersectionWithM f m1 m2 = T.sequence $ M.intersectionWith f m1 m2
 
+class Compos1 t where
+    compos1 :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
+           -> (t -> m t) -> t -> m t
+
+instance Compos1 JType where
+    compos1 ret app f v =
+        case v of
+          JTFunc args body -> ret JTFunc `app` mapM' f args `app` f body
+          JTForall vars t -> ret JTForall `app` ret vars `app` f t
+          JTList t -> ret JTList `app` f t
+          JTMap t -> ret JTMap `app` f t
+          JTRecord t m -> ret JTRecord `app` f t `app` m'
+              where (ls,ts) = unzip $ M.toList m
+                    m' = ret (M.fromAscList . zip ls) `app` mapM' f ts
+          x -> ret x
+      where
+        mapM' g = foldr (app . app (ret (:)) . g) (ret [])
+
+composOp1 :: Compos1 t => (t -> t) -> t -> t
+composOp1 f = runIdentity . composOpM1 (Identity . f)
+composOpM1 :: (Compos1 t, Monad m) => (t -> m t) -> t -> m t
+composOpM1 = compos1 return ap
+composOpM1_ :: (Compos1 t, Monad m) => (t -> m ()) -> t -> m ()
+composOpM1_ = composOpFold1 (return ()) (>>)
+composOpFold1 :: Compos1 t => b -> (b -> b -> b) -> (t -> b) -> t -> b
+composOpFold1 z c f = unC . compos1 (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f)
+newtype C b a = C { unC :: b }
+
 -- Basic Types and TMonad
 data StoreVal = SVType JType
               | SVConstrained (Set Constraint)
@@ -74,9 +102,10 @@
         "frozen: " ++ show frozen ++ "\n" ++
         "varCt: " ++ show varCt
 
+tcStateEmpty :: TCState
 tcStateEmpty = TCS [M.empty] M.empty [S.empty] S.empty 0 []
 
-newtype TMonad a = TMonad (ErrorT String (State TCState) a) deriving (Functor, Monad, MonadState TCState, MonadError String)
+newtype TMonad a = TMonad (ExceptT String (State TCState) a) deriving (Functor, Monad, MonadState TCState, MonadError String)
 
 instance Applicative TMonad where
     pure = return
@@ -85,9 +114,11 @@
 class JTypeCheck a where
     typecheck :: a -> TMonad JType
 
-evalTMonad (TMonad x) = evalState (runErrorT x) tcStateEmpty
+evalTMonad :: TMonad a -> Either String a
+evalTMonad (TMonad x) = evalState (runExceptT x) tcStateEmpty
 
-runTMonad (TMonad x) = runState (runErrorT x) tcStateEmpty
+runTMonad :: TMonad a -> (Either String a, TCState)
+runTMonad (TMonad x) = runState (runExceptT x) tcStateEmpty
 
 withContext :: TMonad a -> TMonad String -> TMonad a
 withContext act cxt = do
@@ -109,7 +140,7 @@
       go :: JType -> StateT (Map Int (Either String Int), Set String, Int) TMonad ()
       go (JTFree vr) = handleVR vr
       go (JTRigid vr cs) = handleVR vr >> traversem_ (go . fromC) cs
-      go v = composOpM_ go v
+      go v = composOpM1_ go v
 
       handleVR (mbName, ref) = do
         (m,ns,ct) <- get
@@ -129,6 +160,7 @@
         let n' = mkUnique ns n 0
         put (M.insert ref (Left n') m, S.insert n' ns, ct)
 
+      mkUnique :: Set String -> String -> Int -> String
       mkUnique ns n i
           | n' `S.member` ns = mkUnique ns n (i + 1)
           | otherwise = n'
@@ -145,12 +177,14 @@
                     where (q,r) = divMod i 26
                           letter = toEnum (fromEnum 'a' + r)
 
+
+prettyType :: JType -> TMonad String
 prettyType x = do
   xt <- resolveType x
   names <- freeVarsWithNames xt
   let replaceNames (JTFree ref) = JTFree $ fixRef ref
       replaceNames (JTForall refs t) = JTForall (map fixRef refs) $ replaceNames t
-      replaceNames v = composOp replaceNames v
+      replaceNames v = composOp1 replaceNames v
 
       fixRef (_,ref) = (M.lookup ref names, ref)
 
@@ -190,20 +224,25 @@
 prettyEnv :: TMonad [Map Ident String]
 prettyEnv = mapM (T.mapM prettyType) . tc_env =<< get
 
+runTypecheckRaw :: JTypeCheck a => a -> (Either String JType, TCState)
 runTypecheckRaw x = runTMonad (typecheckMain x)
 
+runTypecheckFull :: JTypeCheck a => a -> (Either String (String, [Map Ident String]), TCState)
 runTypecheckFull x = runTMonad $ do
                        r <- prettyType =<< typecheckMain x
                        e <- prettyEnv
                        return (r,e)
 
+runTypecheck :: JTypeCheck a => a -> Either String String
 runTypecheck x = evalTMonad $ prettyType =<< typecheckMain x
 
+evalTypecheck :: JTypeCheck a => a -> Either String [Map Ident String]
 evalTypecheck x = evalTMonad $ do
                     _ <- typecheckMain x
                     e <- prettyEnv
                     return e
 
+typecheckMain :: JTypeCheck a => a -> TMonad JType
 typecheckMain x = go `catchError` handler
     where go = do
             r <- typecheck x
@@ -216,6 +255,7 @@
 
 -- Manipulating VarRefs and Constraints
 
+addToStack :: Ord a => a -> [Set a] -> [Set a]
 addToStack v (s:ss) = S.insert v s : ss
 addToStack _ _ = error "addToStack: no sets" --[S.singleton v]
 
@@ -233,6 +273,7 @@
 mapConstraint f (Sub t) = Sub <$> f t
 mapConstraint f (Super t) = Super <$> f t
 
+partitionCs :: [Constraint] -> ([JType],[JType])
 partitionCs [] = ([],[])
 partitionCs (Sub t:cs) = (t:subs,sups)
     where (subs,sups) = partitionCs cs
@@ -273,7 +314,7 @@
 occursCheck :: Int -> JType -> TMonad ()
 occursCheck ref (JTFree (_,i))
   | i == ref = tyErr1 "Occurs check: cannot construct infinite type" (JTFree (Nothing,i))
-occursCheck ref x = composOpM_ (occursCheck ref) x
+occursCheck ref x = composOpM1_ (occursCheck ref) x
 
 checkConstraints :: JType -> [Constraint] -> TMonad ()
 checkConstraints t cs = mapM_ go cs
@@ -408,6 +449,7 @@
       normalizeConstraints cl = putCs =<< cannonicalizeConstraints cl
 
 
+cannonicalizeConstraints :: [Constraint] -> TMonad [Constraint]
 cannonicalizeConstraints constraintList = do
         -- trace ("ccl: " ++ show constraintList) $ return ()
         let (subs,restCs)  = findForallSubs constraintList
@@ -535,16 +577,17 @@
 
       unifyGroup :: [Int] -> ReaderT [Either Int Int] TMonad ()
       unifyGroup (vr:vrs) = lift $ mapM_ (\x -> instantiateVarRef (Nothing, x) (JTFree (Nothing,vr))) vrs
+      unifyGroup [] = return ()
 
       findLoop i cs@(c:_) = go [] cs
           where
-            cTyp = isLeft c
+            cTyp = eitherIsLeft c
             go accum (r:rs)
-               | either id id r == i && isLeft r == cTyp = Just $ Just (either id id r : accum)
+               | either id id r == i && eitherIsLeft r == cTyp = Just $ Just (either id id r : accum)
                   -- i.e. there's a cycle to close
                | either id id r == i = Just Nothing
                   -- i.e. there's a "dull" cycle
-               | isLeft r /= cTyp = Nothing -- we stop looking for a cycle because the chain is broken
+               | eitherIsLeft r /= cTyp = Nothing -- we stop looking for a cycle because the chain is broken
                | otherwise = go (either id id r : accum) rs
             go _ [] = Nothing
 
@@ -574,6 +617,7 @@
 
 -- addRefsToStack x = modify (\s -> s {tc_stack = F.foldr addToStack (tc_stack s) x })
 
+frame2VarRefs :: Set t -> [(Maybe a, t)]
 frame2VarRefs frame = (\x -> (Nothing,x)) <$> S.toList frame
 
 addEnv :: Ident -> JType -> TMonad ()
@@ -616,7 +660,7 @@
           Just (SVType t) -> return Nothing
           _ -> return $ Just x
 
-resolveType = resolveTypeGen composOpM
+resolveType = resolveTypeGen composOpM1
 resolveTypeShallow = resolveTypeGen (const return)
 
 --TODO create proper bounds for records
@@ -643,7 +687,7 @@
           (Super t) -> lift . (<: newTy) =<< cloneType t
 
       cloneType (JTFree vr) = getRef vr
-      cloneType x = composOpM cloneType x
+      cloneType x = composOpM1 cloneType x
 
 lookupEnv :: Ident -> TMonad JType
 lookupEnv ident = resolveType =<< go . tc_env =<< get
@@ -656,7 +700,7 @@
 freeVars :: JType -> TMonad (Set Int)
 freeVars t = execWriterT . go =<< resolveType t
     where go (JTFree (_, ref)) = tell (S.singleton ref)
-          go x = composOpM_ go x
+          go x = composOpM1_ go x
 
 --only works on resolved types
 instantiateScheme :: [VarRef] -> JType -> TMonad JType
@@ -674,7 +718,7 @@
                            put $ M.insert ref (JTFree newRef) m
                            mapM_ (lift . addConstraint newRef <=< mapConstraint go) =<< lift (lookupConstraintsList vr)
                            return (JTFree newRef)
-      go x = composOpM go x
+      go x = composOpM1 go x
 
 --only works on resolved types
 instantiateRigidScheme :: [VarRef] -> JType -> TMonad JType
@@ -691,7 +735,7 @@
                            newRef <- JTRigid vr . S.fromList <$> lift (lookupConstraintsList vr)
                            put $ M.insert ref newRef m
                            return newRef
-      go x = composOpM go x
+      go x = composOpM1 go x
 
 --only works on resolved types
 checkEscapedVars :: [VarRef] -> JType -> TMonad ()
@@ -701,7 +745,7 @@
       go t@(JTRigid (_,ref) _)
           | ref `S.member` vs = tyErr1 "Qualified var escapes into environment" t
           | otherwise = return ()
-      go x = composOpM_ go x
+      go x = composOpM1_ go x
 
 -- Subtyping
 (<:) :: JType -> JType -> TMonad ()
@@ -751,6 +795,7 @@
         | M.isSubmapOfBy (\_ _ -> True) ym xm = xt <: yt >> intersectionWithM (<:) xm ym >> return () --TODO not right?
     go xt yt = tyErr2Sub xt yt
 
+(<<:>) :: TMonad JType -> TMonad JType -> TMonad ()
 x <<:> y = join $ liftA2 (<:) x y
 
 someUpperBound :: [JType] -> TMonad JType
@@ -769,6 +814,7 @@
 --  b <- (mapM_ (res <:) xs >> return True) `catchError` \e -> return False
 --  if b then return res else return JTImpossible
 
+(=.=) :: JType -> JType -> TMonad JType
 x =.= y = do
       x <: y
       y <: x
@@ -798,7 +844,7 @@
         | s `elem` ["==","/="] = do
                             et <- typecheck e
                             e1t <- typecheck e1
-                            et =.= e1t
+                            _ <- et =.= e1t
                             return JTBool
         | s `elem` ["||","&&"] = setFixed JTBool >> return JTBool
         | otherwise = throwError $ "Unhandled operator: " ++ s
@@ -838,7 +884,7 @@
 
 
     typecheck (UnsatExpr _) = undefined --saturate (avoiding creation of existing ids) then typecheck
-    typecheck (AntiExpr s) = fail $ "Antiquoted expression not provided with explicit signature: " ++ show s
+    typecheck (AntiExpr s) = error $ "Antiquoted expression not provided with explicit signature: " ++ show s
 
     --TODO: if we're typechecking a function, we can assign the types of the args to the given args
     typecheck (TypeExpr forceType e t)
@@ -859,7 +905,7 @@
     typecheck (JInt _) = return JTNum
     typecheck (JDouble _) = return JTNum
     typecheck (JStr _) = return JTString
-    typecheck (JList xs) = typecheck (JHash $ M.fromList $ zip (map show [0..]) xs)
+    typecheck (JList xs) = typecheck (JHash $ M.fromList $ zip (map show [(0::Int)..]) xs)
                            -- fmap JTList . someUpperBound =<< mapM typecheck xs
     typecheck (JRegEx _) = undefined --regex object
     typecheck (JHash mp) = do
@@ -889,7 +935,7 @@
     typecheck (IfStat e s s1) = do
                             typecheck e <<:> return JTBool
                             join $ liftA2 (\x y -> someUpperBound [x,y]) (typecheck s) (typecheck s1)
-    typecheck (WhileStat e s) = do
+    typecheck (WhileStat _ e s) = do
                             typecheck e <<:> return JTBool
                             typecheck s
     typecheck (ForInStat _ _ _ _) = undefined -- yipe!
@@ -909,7 +955,8 @@
       return JTStat
     typecheck (UnsatBlock _) = undefined --oyvey
     typecheck (AntiStat _) = undefined --oyvey
-    typecheck BreakStat = return JTStat
+    typecheck (BreakStat _) = return JTStat
     typecheck (ForeignStat i t) = integrateLocalType t >>= addEnv i >> return JTStat
 
-typecheckWithBlock stat = typecheck stat `withContext` (return $ "In statement: " ++ renderStyle (style {mode = OneLineMode}) (renderJs stat))
+typecheckWithBlock :: (JsToDoc a, JMacro a, JTypeCheck a) => a -> TMonad JType
+typecheckWithBlock stat = typecheck stat `withContext` (return $ "In statement: " ++ (T.unpack . displayT . renderCompact $ renderJs stat))
diff --git a/Language/Javascript/JMacro/Types.hs b/Language/Javascript/JMacro/Types.hs
--- a/Language/Javascript/JMacro/Types.hs
+++ b/Language/Javascript/JMacro/Types.hs
@@ -48,6 +48,8 @@
 
 type TypeParserState = (Int, Map String Int)
 
+type TypeParser a = CharParser TypeParserState a
+
 typLang :: P.LanguageDef TypeParserState
 typLang = emptyDef {
            P.reservedNames = ["()","->"],
@@ -56,18 +58,17 @@
            P.identStart  = letter <|> oneOf "_$"
           }
 
+lexer :: P.TokenParser TypeParserState
 lexer = P.makeTokenParser typLang
 
-whiteSpace= P.whiteSpace lexer
-symbol    = P.symbol lexer
+reservedOp :: String -> TypeParser ()
+parens, braces, brackets, lexeme :: TypeParser a -> TypeParser a
+identifier :: TypeParser String
+commaSep, commaSep1 :: TypeParser a -> TypeParser [a]
 parens    = P.parens lexer
 braces    = P.braces lexer
 brackets  = P.brackets lexer
-dot       = P.dot lexer
-colon     = P.colon lexer
-semi      = P.semi lexer
 identifier= P.identifier lexer
-reserved  = P.reserved lexer
 reservedOp= P.reservedOp lexer
 commaSep1 = P.commaSep1 lexer
 commaSep  = P.commaSep  lexer
@@ -77,8 +78,10 @@
 parseType :: String -> Either ParseError JType
 parseType s = runParser anyType (0,M.empty) "" s
 
+parseConstrainedType :: String -> Either ParseError JLocalType
 parseConstrainedType s = runParser constrainedType (0,M.empty) "" s
 
+runTypeParser :: CharParser a JLocalType
 runTypeParser = withLocalState (0,M.empty) (try (parens constrainedType) <|> constrainedType) -- anyType
 
 withLocalState :: (Functor m, Monad m) => st -> ParsecT s st m a -> ParsecT s st' m a
@@ -90,7 +93,6 @@
                   go (Error e) = (Error e)
 
 
-type TypeParser a = CharParser TypeParserState a
 
 constrainedType :: TypeParser JLocalType
 constrainedType = do
@@ -115,9 +117,9 @@
 funOrAtomType :: TypeParser JType
 funOrAtomType = do
   r <- anyNestedType `sepBy1` (lexeme (string "->"))
-  return $ case r of
+  return $ case reverse r of
     [x] -> x
-    (x:xs) -> JTFunc (init r) (last r)
+    (x:xs) -> JTFunc (reverse xs) x
     _ -> error "funOrAtomType"
 
 listType :: TypeParser JType
@@ -126,6 +128,7 @@
 anyNestedType :: TypeParser JType
 anyNestedType = nullType <|> parens anyType <|> atomicType <|> listType <|> recordType
 
+nullType :: TypeParser JType
 nullType = reservedOp "()" >> return JTStat
 
 atomicType :: TypeParser JType
@@ -135,8 +138,8 @@
     "Num" -> return JTNum
     "String" -> return JTString
     "Bool" -> return JTBool
-    (x:xs) | isUpper x -> fail $ "Unknown type: " ++ a
-           | otherwise -> JTFree <$> freeVarRef a
+    (x:_) | isUpper x -> fail $ "Unknown type: " ++ a
+          | otherwise -> JTFree <$> freeVarRef a
     _ -> error "typeAtom"
 
 recordType :: TypeParser JType
diff --git a/Language/Javascript/JMacro/Util.hs b/Language/Javascript/JMacro/Util.hs
--- a/Language/Javascript/JMacro/Util.hs
+++ b/Language/Javascript/JMacro/Util.hs
@@ -43,7 +43,7 @@
 ifElse x y z = IfStat (toJExpr x) (toStat y) (toStat z)
 
 while :: ToJExpr a => a -> JStat -> JStat
-while x y = WhileStat (toJExpr x) y
+while x y = WhileStat False (toJExpr x) y
 
 return :: ToJExpr a => a -> JStat
 return x = ReturnStat (toJExpr x)
diff --git a/jmacro.cabal b/jmacro.cabal
--- a/jmacro.cabal
+++ b/jmacro.cabal
@@ -1,5 +1,5 @@
 name:                jmacro
-version:             0.5.8
+version:             0.6.18
 synopsis:            QuasiQuotation library for programmatic generation of Javascript code.
 description:         Javascript syntax, functional syntax, hygienic names, compile-time guarantees of syntactic correctness, limited typechecking. Additional documentation available at <http://www.haskell.org/haskellwiki/Jmacro>
 category:            Language
@@ -7,29 +7,92 @@
 license-file:        LICENSE
 author:              Gershom Bazerman
 maintainer:          gershomb@gmail.com
-Tested-With:         GHC == 7.0.2
+tested-with:         GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.2, GHC==9.5.2, GHC==9.6.1
 Build-Type:          Simple
-Cabal-Version:       >= 1.6
-
+Cabal-Version:       >= 1.10
 
 library
-  build-depends:     base >= 4, base < 5, containers, pretty, safe >= 0.2, parsec > 3.0, template-haskell >= 2.3, mtl > 1.1 , haskell-src-exts, haskell-src-meta, bytestring >= 0.9, syb, json, regex-posix > 0.9
+  default-language:  Haskell2010
+  build-depends:     aeson >= 0.5,
+                     base >= 4.9 && < 5,
+                     bytestring >= 0.9,
+                     containers,
+                     haskell-src-exts,
+                     haskell-src-meta,
+                     mtl > 2.2.1,
+                     parsec > 3.0,
+                     regex-posix > 0.9,
+                     safe >= 0.2,
+                     syb,
+                     template-haskell >= 2.3,
+                     text,
+                     unordered-containers >= 0.2,
+                     vector >= 0.8,
+                     wl-pprint-text
 
   exposed-modules:   Language.Javascript.JMacro
                      Language.Javascript.JMacro.Util
                      Language.Javascript.JMacro.TypeCheck
                      Language.Javascript.JMacro.Types
                      Language.Javascript.JMacro.Prelude
-                     Language.Javascript.JMacro.Rpc
   other-modules:     Language.Javascript.JMacro.Base
                      Language.Javascript.JMacro.QQ
                      Language.Javascript.JMacro.ParseTH
   ghc-options:       -Wall
 
+flag benchmarks
+  description: Build the benchmarks
+  default: False
+
 executable jmacro
-  build-depends: parseargs
-  main-is: Language/Javascript/JMacro/Executable.hs
+   default-language:  Haskell2010
+   build-depends:     aeson >= 0.5,
+                      base >= 4 && < 5,
+                      bytestring >= 0.9,
+                      containers,
+                      haskell-src-exts,
+                      haskell-src-meta,
+                      mtl > 1.1 ,
+                      parseargs,
+                      parsec > 3.0,
+                      regex-posix > 0.9,
+                      safe >= 0.2,
+                      syb,
+                      template-haskell >= 2.3,
+                      text,
+                      unordered-containers >= 0.2,
+                      vector >= 0.8,
+                      wl-pprint-text
 
+   main-is: Language/Javascript/JMacro/Executable.hs
+   other-modules: Language.Javascript.JMacro.Util
+                   Language.Javascript.JMacro.TypeCheck
+                   Language.Javascript.JMacro.Types
+                   Language.Javascript.JMacro.Prelude
+                   Language.Javascript.JMacro.Base
+                   Language.Javascript.JMacro.QQ
+                   Language.Javascript.JMacro.ParseTH
+                   Language.Javascript.JMacro
+
+
+executable jmacro-bench
+  default-language:  Haskell2010
+  main-is: Language/Javascript/JMacro/Benchmark.hs
+  if flag(benchmarks)
+    buildable: True
+    build-depends: criterion
+    other-modules: Language.Javascript.JMacro.Util
+                   Language.Javascript.JMacro.TypeCheck
+                   Language.Javascript.JMacro.Types
+                   Language.Javascript.JMacro.Prelude
+                   Language.Javascript.JMacro.Base
+                   Language.Javascript.JMacro.QQ
+                   Language.Javascript.JMacro.ParseTH
+                   Language.Javascript.JMacro
+
+  else
+    buildable: False
+
 source-repository head
-  type:      darcs
-  location:  http://patch-tag.com/r/gershomb/jmacro
+  type:      git
+  location:  https://github.com/Happstack/jmacro.git