diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) Gershom Bazerman 2009
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
diff --git a/Language/Javascript/JMacro.hs b/Language/Javascript/JMacro.hs
new file mode 100644
--- /dev/null
+++ b/Language/Javascript/JMacro.hs
@@ -0,0 +1,74 @@
+-----------------------------------------------------------------------------
+{- |
+Module      :  Language.Javascript.JMacro
+Copyright   :  (c) Gershom Bazerman, 2009
+License     :  BSD 3 Clause
+Maintainer  :  gershomb@gmail.com
+Stability   :  experimental
+
+Simple DSL for lightweight (untyped) programmatic generation of Javascript.
+
+usage:
+
+> renderJs [$jmacro|fun id x -> x|]
+
+The above produces the id function at the top level.
+
+> 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|]
+
+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;}|]
+
+The above is also id.
+
+> renderJs [$jmacro|function !id(x) {return x;}|]
+
+As is the above (with the correct name).
+
+> renderJs [$jmacro|fun id x {return x;}|]
+
+As is the above.
+
+> renderJs [$jmacroE|foo(x,y)|]
+
+The above is an expression representing the application of foo to x and y.
+
+> renderJs [$jmacroE|foo x y|]]
+
+As is the above.
+
+> 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
+
+> \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)`|]]
+
+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.
+
+Additional datatypes can be marshalled to Javascript by proper instance declarations for the ToJExpr class.
+
+An experimental typechecker is available in the Typed module.
+
+-}
+-----------------------------------------------------------------------------
+
+module Language.Javascript.JMacro (
+  module Language.Javascript.JMacro.Base,
+  module Language.Javascript.JMacro.QQ
+ ) where
+
+import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
+
+import Language.Javascript.JMacro.Base hiding (expr2stat)
+import Language.Javascript.JMacro.QQ
diff --git a/Language/Javascript/JMacro/Base.hs b/Language/Javascript/JMacro/Base.hs
new file mode 100644
--- /dev/null
+++ b/Language/Javascript/JMacro/Base.hs
@@ -0,0 +1,547 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+{- |
+Module      :  Language.Javascript.JMacro.Base
+Copyright   :  (c) Gershom Bazerman, 2009
+License     :  BSD 3 Clause
+Maintainer  :  gershomb@gmail.com
+Stability   :  experimental
+
+Simple DSL for lightweight (untyped) programmatic generation of Javascript.
+-}
+-----------------------------------------------------------------------------
+
+module Language.Javascript.JMacro.Base (
+  -- * ADT
+  JStat(..), JExpr(..), JVal(..), Ident(..),
+  -- * Generic traversal (via compos)
+  JMacro(..), MultiComp(..), Compos(..),
+  composOp, composOpM, composOpM_, composOpFold,
+  -- * Hygienic transformation
+  withHygiene,
+  -- * Display/Output
+  renderJs, JsToDoc(..),
+  -- * ad-hoc data marshalling
+  ToJExpr(..),
+  -- * helpful combinators
+  jLam, jVar, jFor, jForIn, jForEachIn,
+  expr2stat, ToStat(..), nullStat,
+  -- * hash combinators
+  jhEmpty, jhSingle, jhAdd, jhFromList,
+  -- * utility
+  jsSaturate
+  ) where
+import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
+import Control.Applicative hiding (empty)
+import Data.Function
+import qualified Data.Map as M
+import Text.PrettyPrint.HughesPJ
+import Control.Monad.State.Strict
+import Safe
+import Control.Monad.Identity
+import Data.Generics
+
+{--------------------------------------------------------------------
+  ADTs
+--------------------------------------------------------------------}
+
+--switch
+--Yield statement?
+--destructuring/pattern matching functions --pattern matching in lambdas.
+--array comprehensions/generators?
+--add postfix stat
+
+-- | Statements
+data JStat = DeclStat   Ident
+           | ReturnStat JExpr
+           | IfStat     JExpr JStat JStat
+           | WhileStat  JExpr JStat
+           | ForInStat  Bool Ident JExpr JStat
+           | SwitchStat JExpr [(JExpr, JStat)] JStat
+           | BlockStat  [JStat]
+           | ApplStat   JExpr [JExpr]
+           | PostStat   String JExpr
+           | AssignStat JExpr JExpr
+           | UnsatBlock (State [Ident] JStat)
+           | AntiStat   String
+           | BreakStat
+             deriving (Eq, Ord, Show, Data, Typeable)
+
+-- | Expressions
+data JExpr = ValExpr    JVal
+           | SelExpr    JExpr Ident
+           | IdxExpr    JExpr JExpr
+           | InfixExpr  String JExpr JExpr
+           | PostExpr   String JExpr
+           | IfExpr     JExpr JExpr JExpr
+           | NewExpr    JExpr
+           | ApplExpr   JExpr [JExpr]
+           | UnsatExpr  (State [Ident] JExpr)
+           | AntiExpr   String
+             deriving (Eq, Ord, Show, Data, Typeable)
+
+-- | Values
+data JVal = JVar     Ident
+          | JList    [JExpr]
+          | JDouble  Double
+          | JInt     Integer
+          | JStr     String
+          | JRegEx   String
+          | JHash    (M.Map String JExpr)
+          | JFunc    [Ident] JStat
+          | UnsatVal (State [Ident] JVal)
+            deriving (Eq, Ord, Show, Data, Typeable)
+
+-- | Identifiers
+newtype Ident = StrI String deriving (Eq, Ord, Show, Data, Typeable)
+
+
+deriving instance Typeable2 State
+deriving instance Data (State [Ident] JVal)
+deriving instance Data (State [Ident] JExpr)
+deriving instance Data (State [Ident] JStat)
+
+
+
+expr2stat :: JExpr -> JStat
+expr2stat (ApplExpr x y) = (ApplStat x y)
+expr2stat (IfExpr x y z) = IfStat x (expr2stat y) (expr2stat z)
+expr2stat (PostExpr s x) = PostStat s x
+expr2stat (AntiExpr x) = AntiStat x
+expr2stat _ = nullStat
+
+{--------------------------------------------------------------------
+  Compos
+--------------------------------------------------------------------}
+
+-- | Utility class to coerce the ADT into a regular structure.
+class JMacro a where
+    toMC :: a -> MultiComp
+    fromMC :: MultiComp -> a
+
+-- | Union type to allow regular traversal by compos.
+data MultiComp = MStat JStat | MExpr JExpr | MVal JVal | MIdent Ident deriving Show
+
+
+-- | 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
+
+
+composOp :: Compos t => (t -> t) -> t -> t
+composOp f = runIdentity . composOpM (Identity . f)
+composOpM :: (Compos t, Monad m) => (t -> m t) -> t -> m t
+composOpM = compos return ap
+composOpM_ :: (Compos t, Monad m) => (t -> m ()) -> t -> m ()
+composOpM_ = composOpFold (return ()) (>>)
+composOpFold :: Compos t => b -> (b -> b -> b) -> (t -> b) -> t -> 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"
+
+instance Compos MultiComp where
+    compos ret app f' v = case v of
+        MIdent _ -> ret v
+        MStat v' -> ret MStat `app` case v' of
+           DeclStat i -> ret DeclStat `app` f i
+           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
+           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
+           BlockStat xs -> ret BlockStat `app` mapM' f xs
+           ApplStat  e xs -> ret ApplStat `app` f e `app` mapM' f xs
+           PostStat o e -> ret (PostStat o) `app` f e
+           AssignStat e e' -> ret AssignStat `app` f e `app` f e'
+           UnsatBlock _ -> ret v'
+           AntiStat _ -> ret v'
+           BreakStat -> ret BreakStat
+        MExpr v' -> ret MExpr `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'
+           InfixExpr o e e' -> ret (InfixExpr o) `app` f e `app` f e'
+           PostExpr o e -> ret (PostExpr o) `app` f e
+           IfExpr e e' e'' -> ret IfExpr `app` f e `app` f e' `app` f e''
+           NewExpr e -> ret NewExpr `app` f e
+           ApplExpr e xs -> ret ApplExpr `app` f e `app` mapM' f xs
+           AntiExpr _ -> ret v'
+           UnsatExpr _ -> ret v'
+        MVal v' -> ret MVal `app` case v' of
+           JVar i -> ret JVar `app` f i
+           JList xs -> ret JList `app` mapM' f xs
+           JDouble _ -> ret v'
+           JInt    _ -> ret v'
+           JStr    _ -> ret v'
+           JRegEx  _ -> ret v'
+           JHash   m -> ret JHash `app` m'
+               where (ls, vs) = unzip (M.toList m)
+                     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' g = foldr (app . app (ret (:)) . g) (ret [])
+        f x = ret fromMC `app` f' (toMC x)
+
+
+{--------------------------------------------------------------------
+  New Identifiers
+--------------------------------------------------------------------}
+
+sat_ :: State [Ident] a -> a
+sat_ x = evalState x $ newIdentSupply (Just "<<unsatId>>")
+
+instance Eq a => Eq (State [Ident] a) where
+    (==) = (==) `on` sat_
+instance Ord a => Ord (State [Ident] a) where
+    compare = compare `on` sat_
+instance Show a => Show (State [Ident] a) where
+    show x = "(" ++ show (sat_ x) ++ ")"
+
+class ToSat a where
+    toSat_ :: a -> [Ident] -> State [Ident] (JStat, [Ident])
+
+instance ToSat [JStat] where
+    toSat_ f vs = return $ (BlockStat f, reverse vs)
+
+instance ToSat JStat where
+    toSat_ f vs = return $ (f, reverse vs)
+
+instance ToSat JExpr where
+    toSat_ f vs = return $ (expr2stat f, reverse vs)
+
+instance ToSat [JExpr] where
+    toSat_ f vs = return $ (BlockStat $ map expr2stat f, reverse vs)
+
+instance (ToSat a, b ~ JExpr) => ToSat (b -> a) where
+    toSat_ f vs = do
+      x <- takeOne
+      toSat_ (f (ValExpr $ JVar x)) (x:vs)
+
+takeOne :: (Monad m, MonadState [b] m) => m b
+takeOne = do
+  (x:xs) <- get
+  put xs
+  return x
+
+newIdentSupply :: Maybe String -> [Ident]
+newIdentSupply Nothing     = newIdentSupply (Just "jmId")
+newIdentSupply (Just pfx') = [StrI (pfx ++ show x) | x <- [(0::Integer)..]]
+    where pfx = pfx'++['_']
+
+{-
+splitIdentSupply :: ([Ident] -> ([Ident], [Ident]))
+splitIdentSupply is = (takeAlt is, takeAlt (drop 1 is))
+    where takeAlt (x:_:xs) = x : takeAlt xs
+          takeAlt _ = error "splitIdentSupply: stream is not infinite"
+-}
+
+{--------------------------------------------------------------------
+  Saturation
+--------------------------------------------------------------------}
+
+jsSaturate :: (JMacro a) => Maybe String -> a -> a
+jsSaturate str x = evalState (jsSaturate_ x) (newIdentSupply str)
+
+jsSaturate_ :: (JMacro a) => a -> State [Ident] a
+jsSaturate_ e = fromMC <$> go (toMC e)
+    where go v = case v of
+                   MStat (UnsatBlock us) -> composOpM go =<< (MStat <$> us)
+                   MExpr (UnsatExpr  us) -> composOpM go =<< (MExpr <$> us)
+                   MVal  (UnsatVal   us) -> composOpM go =<< (MVal  <$> us)
+                   _ -> composOpM go v
+
+{--------------------------------------------------------------------
+  Transformation
+--------------------------------------------------------------------}
+
+--doesn't apply to unsaturated bits
+jsReplace_ :: JMacro a => [(Ident, Ident)] -> a -> a
+jsReplace_ xs e = fromMC $ composOp go (toMC e)
+    where go v = case v of
+                   MIdent i -> maybe v MIdent (M.lookup i mp)
+                   _ -> composOp go v
+          mp = M.fromList xs
+
+--only works on fully saturated things
+jsUnsat_ :: JMacro a => [Ident] -> a -> State [Ident] a
+jsUnsat_ xs e = do
+  (idents,is') <- splitAt (length xs) <$> get
+  put is'
+  return $ jsReplace_ (zip xs idents) e
+
+-- | 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.
+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 (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
+
+{-
+jsReplace :: JMacro a => [(Ident, Ident)] -> a -> a
+jsReplace xs = withHygiene (jsReplace_ xs)
+-}
+
+{--------------------------------------------------------------------
+  Pretty Printing
+--------------------------------------------------------------------}
+
+-- | Render a syntax tree as a pretty-printable document
+-- (simply showing the resultant doc produces a nice,
+-- well formatted String).
+renderJs :: (JsToDoc a, JMacro a) => a -> Doc
+renderJs = jsToDoc . jsSaturate Nothing
+
+braceNest :: Doc -> Doc
+braceNest x = char '{' $$ nest 2 x $$ char '}'
+
+braceNest' :: Doc -> Doc
+braceNest' x = char '{' $+$ nest 2 x $$ char '}'
+
+class JsToDoc a
+    where jsToDoc :: a -> Doc
+
+instance JsToDoc JStat where
+    jsToDoc (IfStat cond x y) = text "if" <> parens (jsToDoc cond) $$ braceNest' (jsToDoc x) $$ mbElse
+        where mbElse | y == BlockStat []  = empty
+                     | otherwise = text "else" $$ braceNest' (jsToDoc y)
+    jsToDoc (DeclStat x) = text "var" <+> jsToDoc x
+    jsToDoc (WhileStat p b)  = text "while" <> parens (jsToDoc p) $$ braceNest' (jsToDoc b)
+    jsToDoc (UnsatBlock e) = jsToDoc $ sat_ e
+    jsToDoc BreakStat = text "break"
+    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])]
+              cases = vcat l'
+    jsToDoc (ReturnStat e) = text "return" <+> jsToDoc e
+    jsToDoc (ApplStat e es) = jsToDoc e <> (parens . fsep . punctuate comma $ map jsToDoc es)
+    jsToDoc (AssignStat i x) = jsToDoc i <+> char '=' <+> jsToDoc x
+    jsToDoc (PostStat op x) = jsToDoc x <> text op
+    jsToDoc (AntiStat s) = text $ "`(" ++ s ++ ")`"
+    jsToDoc (BlockStat xs) = jsToDoc (flattenBlocks xs)
+        where flattenBlocks (BlockStat y:ys) = flattenBlocks y ++ flattenBlocks ys
+              flattenBlocks (y:ys) = y : flattenBlocks ys
+              flattenBlocks [] = []
+
+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 (PostExpr op x) = jsToDoc x <> text op
+    jsToDoc (ApplExpr je xs) = jsToDoc je <> (parens . fsep . punctuate comma $ map jsToDoc xs)
+    jsToDoc (NewExpr e) = text "new" <+> jsToDoc e
+    jsToDoc (AntiExpr s) = text $ "`(" ++ s ++ ")`"
+    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 (JInt i) = integer i
+    jsToDoc (JStr s) = text ("\""++s++"\"")
+    jsToDoc (JRegEx s) = text ("/"++s++"/")
+    jsToDoc (JHash m) = 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)
+    jsToDoc (UnsatVal f) = jsToDoc $ sat_ f
+
+instance JsToDoc Ident where
+    jsToDoc (StrI s) = text s
+
+instance JsToDoc [JExpr] where
+    jsToDoc = vcat . map ((<> semi) . jsToDoc)
+
+instance JsToDoc [JStat] where
+    jsToDoc = vcat . map ((<> semi) . jsToDoc)
+
+{--------------------------------------------------------------------
+  ToJExpr Class
+--------------------------------------------------------------------}
+
+-- | Things that can be marshalled into javascript values.
+-- Instantiate for any necessary data structures.
+class ToJExpr a where
+    toJExpr :: a -> JExpr
+    toJExprFromList :: [a] -> JExpr
+    toJExprFromList = ValExpr . JList . map toJExpr
+
+instance ToJExpr a => ToJExpr [a] where
+    toJExpr = toJExprFromList
+
+instance ToJExpr JExpr where
+    toJExpr = id
+
+instance ToJExpr () where
+    toJExpr _ = ValExpr $ JList []
+
+instance ToJExpr Bool where
+    toJExpr True  = jsv "true"
+    toJExpr False = jsv "false"
+
+instance ToJExpr JVal where
+    toJExpr = ValExpr
+
+instance ToJExpr a => ToJExpr (M.Map String a) where
+    toJExpr = ValExpr . JHash . M.map toJExpr
+
+instance ToJExpr Double where
+    toJExpr = ValExpr . JDouble
+
+instance ToJExpr Int where
+    toJExpr = ValExpr . JInt . fromIntegral
+
+instance ToJExpr Integer where
+    toJExpr = ValExpr . JInt
+
+instance ToJExpr Char where
+    toJExpr = ValExpr . JStr . (:[])
+    toJExprFromList = ValExpr . JStr . escQuotes
+        where escQuotes = tailDef "" . initDef "" . show
+
+instance (ToJExpr a, ToJExpr b) => ToJExpr (a,b) where
+    toJExpr (a,b) = ValExpr . JList $ [toJExpr a, toJExpr b]
+
+instance (ToJExpr a, ToJExpr b, ToJExpr c) => ToJExpr (a,b,c) where
+    toJExpr (a,b,c) = ValExpr . JList $ [toJExpr a, toJExpr b, toJExpr c]
+
+instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d) => ToJExpr (a,b,c,d) where
+    toJExpr (a,b,c,d) = ValExpr . JList $ [toJExpr a, toJExpr b, toJExpr c, toJExpr d]
+instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e) => ToJExpr (a,b,c,d,e) where
+    toJExpr (a,b,c,d,e) = ValExpr . JList $ [toJExpr a, toJExpr b, toJExpr c, toJExpr d, toJExpr e]
+instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e, ToJExpr f) => ToJExpr (a,b,c,d,e,f) where
+    toJExpr (a,b,c,d,e,f) = ValExpr . JList $ [toJExpr a, toJExpr b, toJExpr c, toJExpr d, toJExpr e, toJExpr f]
+
+instance Num JExpr where
+    fromInteger = ValExpr . JInt . fromIntegral
+    x + y = InfixExpr "+" x y
+    x - y = InfixExpr "-" x y
+    x * y = InfixExpr "*" x y
+    abs x = ApplExpr (jsv "Math.abs") [x]
+    signum x = IfExpr (InfixExpr ">" x 0) 1 (IfExpr (InfixExpr "==" x 0) 0 (-1))
+
+{--------------------------------------------------------------------
+  Block Sugar
+--------------------------------------------------------------------}
+
+class ToStat a where
+    toStat :: a -> JStat
+
+instance ToStat JStat where
+    toStat = id
+
+instance ToStat [JStat] where
+    toStat = BlockStat
+
+instance ToStat JExpr where
+    toStat = expr2stat
+
+instance ToStat [JExpr] where
+    toStat = BlockStat . map expr2stat
+
+{--------------------------------------------------------------------
+  Combinators
+--------------------------------------------------------------------}
+
+-- | Create a new anonymous function. The result is an expression.
+-- Usage:
+-- @jLam $ \ x y -> {JExpr involving x and y}@
+jLam :: (ToSat a) => a -> JExpr
+jLam f = ValExpr . UnsatVal $ do
+           (block,is) <- toSat_ f []
+           return $ JFunc is block
+
+-- | Introduce a new variable into scope for the duration
+-- of the enclosed expression. The result is a block statement.
+-- Usage:
+-- @jVar $ \ x y -> {JExpr involving x and y}@
+jVar :: (ToSat a) => a -> JStat
+jVar f = UnsatBlock $ do
+           (block, is) <- toSat_ f []
+           let addDecls (BlockStat ss) =
+                  BlockStat $ map DeclStat is ++ ss
+               addDecls x = x
+           return $ addDecls block
+
+
+-- | Create a for in statement.
+-- Usage:
+-- @jForIn {expression} $ \x -> {block involving x}@
+jForIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
+jForIn e f = UnsatBlock $ do
+               (block, is) <- toSat_ f []
+               return $ ForInStat False (headNote "jForIn" is) e block
+
+-- | As with "jForIn" but creating a \"for each in\" statement.
+jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
+jForEachIn e f = UnsatBlock $ do
+               (block, is) <- toSat_ f []
+               return $ ForInStat True (headNote "jForIn" is) e block
+
+jsv :: String -> JExpr
+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']
+    where b' = case toStat b of
+                 BlockStat xs -> BlockStat $ xs ++ [after]
+                 x -> BlockStat [x,after]
+
+jhEmpty :: M.Map String JExpr
+jhEmpty = M.empty
+
+jhSingle :: ToJExpr a => String -> a -> M.Map String JExpr
+jhSingle k v = jhAdd k v $ jhEmpty
+
+jhAdd :: ToJExpr a => String -> a -> M.Map String JExpr -> M.Map String JExpr
+jhAdd  k v m = M.insert k (toJExpr v) m
+
+jhFromList :: [(String, JExpr)] -> JVal
+jhFromList = JHash . M.fromList
+
+nullStat :: JStat
+nullStat = BlockStat []
diff --git a/Language/Javascript/JMacro/QQ.hs b/Language/Javascript/JMacro/QQ.hs
new file mode 100644
--- /dev/null
+++ b/Language/Javascript/JMacro/QQ.hs
@@ -0,0 +1,584 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TemplateHaskell, QuasiQuotes #-}
+
+-----------------------------------------------------------------------------
+{- |
+Module      :  Language.Javascript.JMacro
+Copyright   :  (c) Gershom Bazerman, 2009
+License     :  BSD 3 Clause
+Maintainer  :  gershomb@gmail.com
+Stability   :  experimental
+
+Simple EDSL for lightweight (untyped) programmatic generation of Javascript.
+-}
+-----------------------------------------------------------------------------
+
+module Language.Javascript.JMacro.QQ(jmacro,jmacroE) where
+import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
+import Control.Applicative hiding ((<|>),many,optional,(<*))
+import Control.Monad.State.Strict
+import qualified Data.ByteString.Char8 as BS
+import Data.Char(digitToInt, toLower)
+import Data.List(isPrefixOf, sort)
+import Data.Generics(extQ,Data)
+import qualified Data.Map as M
+
+import Language.Haskell.Meta.Parse
+import qualified Language.Haskell.TH as TH
+import Language.Haskell.TH(mkName)
+import qualified Language.Haskell.TH.Lib as TH
+import Language.Haskell.TH.Quote
+
+import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec.Expr
+import Text.ParserCombinators.Parsec.Error
+import qualified Text.ParserCombinators.Parsec.Token as P
+import Text.ParserCombinators.Parsec.Language(javaStyle)
+
+-- import Text.Regex.PCRE.Light (compileM)
+
+import Language.Javascript.JMacro.Base
+
+-- import Debug.Trace
+
+compileM _ _ = Right "hack"
+
+{--------------------------------------------------------------------
+  QuasiQuotation
+--------------------------------------------------------------------}
+
+-- | QuasiQuoter for a block of JMacro statements.
+jmacro :: QuasiQuoter
+jmacro = QuasiQuoter quoteJMExp quoteJMPat
+
+-- | QuasiQuoter for a JMacro expression.
+jmacroE :: QuasiQuoter
+jmacroE = QuasiQuoter quoteJMExpE quoteJMPatE
+
+quoteJMPat :: String -> TH.PatQ
+quoteJMPat s = case parseJM s of
+               Right x -> dataToPatQ (const Nothing) x
+               Left err -> fail (show err)
+
+quoteJMExp :: String -> TH.ExpQ
+quoteJMExp s = case parseJM s of
+               Right x -> jm2th x
+               Left err -> do
+                   (line,_) <- TH.loc_start <$> TH.location
+                   let pos = errorPos err
+                   let newPos = setSourceLine pos $ line + sourceLine pos - 1
+                   fail (show $ setErrorPos newPos err)
+
+quoteJMPatE :: String -> TH.PatQ
+quoteJMPatE s = case parseJME s of
+               Right x -> dataToPatQ (const Nothing) x
+               Left err -> fail (show err)
+
+quoteJMExpE :: String -> TH.ExpQ
+quoteJMExpE s = case parseJME s of
+               Right x -> jm2th x
+               Left err -> do
+                   (line,_) <- TH.loc_start <$> TH.location
+                   let pos = errorPos err
+                   let newPos = setSourceLine pos $ line + sourceLine pos - 1
+                   fail (show $ setErrorPos newPos err)
+
+
+-- | Traverse a syntax tree, replace an identifier by an
+-- antiquotation of a free variable.
+-- 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 s)
+          go (MExpr (SelExpr x i)) =
+              MExpr (SelExpr (antiIdent s x) i)
+          go x = composOp go x
+
+antiIdents :: JMacro a => [String] -> a -> a
+antiIdents ss x = foldr antiIdent x ss
+
+
+jm2th :: Data a => a -> TH.ExpQ
+jm2th v = dataToExpQ (const Nothing
+                      `extQ` handleStat
+                      `extQ` handleExpr
+                      `extQ` handleVal
+                     ) v
+
+    where handleStat :: JStat -> Maybe (TH.ExpQ)
+          handleStat (BlockStat ss) = Just $
+                                      appConstr "BlockStat" $
+                                      TH.listE (blocks ss)
+              where blocks :: [JStat] -> [TH.ExpQ]
+                    blocks [] = []
+
+                    blocks (DeclStat (StrI i):xs) = case i of
+                     ('!':i') -> jm2th (DeclStat (StrI i')) : blocks xs
+                     _ ->
+                        [TH.appE (TH.varE $ mkName "jVar")
+                              (TH.lamE [TH.varP . mkName $ i] $
+                                 appConstr "BlockStat"
+                                 (TH.listE $ blocks $ map (antiIdent i) xs))]
+
+                    blocks (x:xs) = jm2th x : blocks xs
+          handleStat (ForInStat b (StrI i) e s) = Just $
+                 appFun (TH.varE $ forFunc)
+                        [jm2th e,
+                         TH.lamE [TH.varP $ mkName i]
+                                 (jm2th $ antiIdent i s)
+                         ]
+              where forFunc
+                        | b = mkName "jForEachIn"
+                        | otherwise = mkName "jForIn"
+          handleStat (AntiStat s) = case parseExp s of
+                                      Right ans -> Just $ TH.appE (TH.varE (mkName "toStat"))
+                                                                  (return ans)
+                                      Left err -> Just $ fail err
+          handleStat _ = Nothing
+
+          handleExpr :: JExpr -> Maybe (TH.ExpQ)
+          handleExpr (AntiExpr s) = case parseExp s of
+                                      Right ans -> Just $ TH.appE (TH.varE (mkName "toJExpr")) (return ans)
+                                      Left err -> Just $ fail err
+          handleExpr (ValExpr (JFunc is' s)) = Just $
+              TH.appE (TH.varE $ mkName "jLam")
+                      (TH.lamE (map (TH.varP . mkName) is)
+                               (jm2th $ antiIdents is s))
+            where is = map (\(StrI i) -> i) is'
+
+          handleExpr _ = Nothing
+
+          handleVal :: JVal -> Maybe (TH.ExpQ)
+          handleVal (JHash m) = Just $
+                                TH.appE (TH.varE $ mkName "jhFromList") $
+                                jm2th (M.toList m)
+          handleVal _ = Nothing
+
+          appFun x = foldl (TH.appE) x
+          appConstr n = TH.appE (TH.conE $ mkName n)
+
+
+{--------------------------------------------------------------------
+  Parsing
+--------------------------------------------------------------------}
+
+type JMParser a =  CharParser () a
+
+lexer :: P.TokenParser ()
+symbol :: String -> JMParser String
+parens, braces :: JMParser a -> JMParser a
+dot, colon, semi, identifier, identifierWithBang :: JMParser String
+whiteSpace :: JMParser ()
+reserved, reservedOp :: String -> JMParser ()
+commaSep, commaSep1 :: JMParser a -> JMParser [a]
+
+lexer = P.makeTokenParser jsLang
+
+jsLang :: P.LanguageDef ()
+jsLang = javaStyle {
+           P.reservedNames = ["var","return","if","else","while","for","in","break","new","function","switch","case","default","fun"],
+           P.reservedOpNames = ["--","*","/","+","-",".","?","=","==","!=","<",">","&&","||","++","===",">=","<=","->"],
+           P.identLetter = alphaNum <|> oneOf "_$",
+           P.identStart  = letter <|> oneOf "_$",
+           P.commentLine = "//",
+           P.commentStart = "/*",
+           P.commentEnd = "*/"}
+
+identifierWithBang = P.identifier $ P.makeTokenParser $ jsLang {P.identStart = letter <|> oneOf "_$!"}
+
+whiteSpace= P.whiteSpace lexer
+symbol    = P.symbol lexer
+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
+
+lexeme :: JMParser a -> JMParser a
+lexeme    = P.lexeme lexer
+
+(<*) :: Monad m => m b -> m a -> m b
+x <* y = do
+  xr <- x
+  y
+  return xr
+
+parseJM :: String -> Either ParseError JStat
+parseJM s = BlockStat <$> runParser jmacroParser () "" s
+    where jmacroParser = do
+            ans <- statblock
+            eof
+            return ans
+
+parseJME :: String -> Either ParseError JExpr
+parseJME s = runParser jmacroParserE () "" s
+    where jmacroParserE = do
+            ans <- whiteSpace >> expr
+            eof
+            return ans
+
+{-
+ident :: JMParser Ident
+ident = do
+  i <- identifier
+  when ("jmId_" `isPrefixOf` i) $ fail "Illegal use of reserved jmId_ prefix in variable name."
+  return (StrI i)
+-}
+
+varidentdecl :: JMParser Ident
+varidentdecl = do
+  i <- identifierWithBang
+  when ("jmId_" `isPrefixOf` i || "!jmId_" `isPrefixOf` i) $ fail "Illegal use of reserved jmId_ prefix in variable name."
+  when (i=="this" || i=="!this") $ fail "Illegal attempt to name variable 'this'."
+  return (StrI i)
+
+
+identdecl :: JMParser Ident
+identdecl = do
+  i <- identifier
+  when ("jmId_" `isPrefixOf` i) $ fail "Illegal use of reserved jmId_ prefix in variable name."
+  when (i=="this") $ fail "Illegal attempt to name variable 'this'."
+  return (StrI i)
+
+identAssignDecl :: JMParser [JStat]
+identAssignDecl = varidentdecl >>= \i ->
+                  (do
+                    reservedOp "="
+                    e <- expr
+                    return [DeclStat i, AssignStat (ValExpr (JVar (clean i))) e]
+                  )
+                  <|> return [DeclStat i]
+    where clean (StrI ('!':x)) = StrI x
+          clean x = x
+
+statblock :: JMParser [JStat]
+statblock = concat <$> (sepEndBy1 (whiteSpace >> statement) (semi <|> return ""))
+
+l2s :: [JStat] -> JStat
+l2s xs = BlockStat xs
+
+
+-- return either an expression or a statement
+statement :: JMParser [JStat]
+statement = declStat
+            <|> funDecl
+            <|> functionDecl
+            <|> returnStat
+            <|> ifStat
+            <|> whileStat
+            <|> switchStat
+            <|> forStat
+            <|> braces statblock
+            <|> assignStat
+            <|> applStat
+            <|> breakStat
+            <|> antiStat
+          <?> "statement"
+    where
+      declStat =
+          reserved "var" >> concat <$> commaSep1 identAssignDecl
+      -- take assignment
+
+      functionDecl = do
+        reserved "function"
+        n <- varidentdecl
+        as <- parens (commaSep identdecl) <|> many1 identdecl
+        b <- try (ReturnStat <$> braces expr) <|> (l2s <$> statement)
+        return $ [DeclStat n, AssignStat (ValExpr $ JVar (clean n)) (ValExpr $ JFunc as b)]
+            where clean (StrI ('!':x)) = StrI x
+                  clean x = x
+
+      funDecl = do
+        reserved "fun"
+        n <- identdecl
+        as <- many identdecl
+        b <- try (ReturnStat <$> braces expr) <|> (l2s <$> statement) <|> (symbol "->" >> ReturnStat <$> expr)
+        return $ [DeclStat (addBang n), AssignStat (ValExpr $ JVar n) (ValExpr $ JFunc as b)]
+            where addBang (StrI x) = StrI ('!':x)
+
+      returnStat =
+        reserved "return" >> (:[]) . ReturnStat <$> expr
+
+      ifStat = do
+        reserved "if"
+        p <- parens expr
+        b <- l2s <$> statement
+        isElse <- (lookAhead (reserved "else") >> return True)
+                  <|> return False
+        if isElse
+          then do
+            reserved "else"
+            return . IfStat p b . l2s <$> statement
+          else return $ [IfStat p b nullStat]
+
+      whileStat =
+          reserved "while" >> liftM2 (\e b -> [WhileStat e (l2s b)])
+                              (parens expr) statement
+
+      switchStat = do
+        reserved "switch"
+        e <- parens $ expr
+        (l,d) <- braces (liftM2 (,) (many caseStat) (option ([]) dfltStat))
+        return $ [SwitchStat e l (l2s d)]
+
+      caseStat =
+        reserved "case" >> liftM2 (,) expr (char ':' >> l2s <$> statblock)
+
+      dfltStat =
+        reserved "default:" >> statblock
+
+      forStat =
+        reserved "for" >> ((reserved "each" >> inBlock True)
+                           <|> try (inBlock False)
+                           <|> simpleForStat)
+
+      inBlock isEach = do
+        char '(' >> whiteSpace >> optional (reserved "var")
+        i <- identdecl
+        reserved "in"
+        e <- expr
+        char ')' >> whiteSpace
+        s <- l2s <$> statement
+        return $ [ForInStat isEach i e s]
+
+      simpleForStat = do
+        (before,after,p) <- parens threeStat
+        b <- statement
+        return $ jFor' before after p b
+          where threeStat =
+                    liftM3 (,,) (statement)
+                                (semi >> expr)
+                                (semi >> statement)
+                jFor' :: (ToJExpr a) => [JStat] -> a -> [JStat] -> [JStat] -> [JStat]
+                jFor' before p after bs = before ++ [WhileStat (toJExpr p) b']
+                    where b' = BlockStat $ bs ++ after
+
+
+      assignStat = do
+          e1 <- try $ dotExpr <* reservedOp "="
+          let gofail = fail ("Invalid assignment.")
+          case e1 of
+            ValExpr (JVar (StrI "this")) -> gofail
+            ValExpr (JVar _) -> return ()
+            ValExpr _ -> gofail
+            _ -> return ()
+          e2 <- expr
+          return [AssignStat e1 e2]
+
+      applStat = expr2stat' =<< expr
+
+--fixme: don't handle ifstats
+      expr2stat' e = case expr2stat e of
+                       BlockStat [] -> pzero
+                       x -> return [x]
+{-
+      expr2stat' :: JExpr -> JStat
+      expr2stat' (ApplExpr x y) = return $ (ApplStat x y)
+      expr2stat' (IfExpr x y z) = liftM2 (IfStat x) (expr2stat' y) (expr2stat' z)
+      expr2stat' (PostExpr s x) = return $ PostStat s x
+      expr2stat' (AntiExpr x)   = return $ AntiStat x
+      expr2stat' _ = fail "Value expression used as statement"
+-}
+
+      breakStat = reserved "break" >> return [BreakStat]
+
+      antiStat  = return . AntiStat <$> do
+        x <- (try (symbol "`(") >> anyChar `manyTill` try (symbol ")`"))
+        either (fail . ("Bad AntiQuotation: \n" ++))
+               (const (return x))
+               (parseExp x)
+
+--args :: JMParser [JExpr]
+--args = parens $ commaSep expr
+
+expr :: JMParser JExpr
+expr = do
+    e <- expr'
+    addIf e <|> return e
+  where addIf e = do
+          symbol "?"
+          t <- expr
+          colon
+          el <- expr
+          let ans = (IfExpr e t el)
+          addIf ans <|> return ans
+
+        expr' = buildExpressionParser table dotExpr <?> "expression"
+
+        table = [[iop "*", iop "/"],
+                 [iop "+", iop "-"],
+                 [iope "==", iope "!=", iope "<", iope ">",
+                  iope ">=", iope "<=", iope "==="],
+                 [iop "&&", iop "||"]
+                ]
+        iop  s  = Infix (reservedOp s >> return (InfixExpr s)) AssocLeft
+        iope s  = Infix (reservedOp s >> return (InfixExpr s)) AssocNone
+
+dotExpr :: JMParser JExpr
+dotExpr = do
+  e <- many1 (lexeme dotExprOne) <?> "simple expression"
+  case e of
+    [e'] -> return e'
+    (e':es) -> return $ ApplExpr e' es
+    _ -> error "exprApp"
+
+dotExprOne :: JMParser JExpr
+dotExprOne = addNxt =<< valExpr <|> antiExpr <|> parens' expr <|> notExpr <|> newExpr
+  where
+    addNxt e = do
+            nxt <- (Just <$> lookAhead anyChar <|> return Nothing)
+            case nxt of
+              Just '.' -> addNxt =<< (dot >> (SelExpr e <$> ident'))
+              Just '[' -> addNxt =<< (IdxExpr e <$> brackets' expr)
+              Just '(' -> addNxt =<< (ApplExpr e <$> args')
+              Just '-' -> try (reservedOp "--" >> return (PostExpr "--" e)) <|> return e
+              Just '+' -> try (reservedOp "++" >> return (PostExpr "++" e)) <|> return e
+              _   -> return e
+
+    notExpr = try (symbol "!" >> dotExpr) >>= \e ->
+              return (ApplExpr (ValExpr (JVar (StrI "!"))) [e])
+
+    newExpr = NewExpr <$> (reserved "new" >> dotExpr)
+
+    antiExpr  = AntiExpr <$> do
+         x <- (try (symbol "`(") >> anyChar `manyTill` try (string ")`"))
+         either (fail . ("Bad AntiQuotation: \n" ++))
+                (const (return x))
+                (parseExp x)
+
+    valExpr = ValExpr <$> (num <|> negnum <|> str <|> 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 <- myStringLiteral '/'
+                case compileM (BS.pack s) [] of
+                  Right _ -> return (JRegEx s)
+                  Left err -> fail ("Parse error in regexp: " ++ err)
+              list  = JList  <$> brackets' (commaSep expr)
+              hash  = JHash  . M.fromList <$> braces' (commaSep propPair)
+              var = JVar <$> ident'
+              func = do
+                (symbol "\\" >> return ()) <|> reserved "function"
+                liftM2 JFunc (parens (commaSep identdecl) <|> many identdecl)
+                             (braces' statOrEblock <|>
+                               (symbol "->" >> (ReturnStat <$> expr)))
+              statOrEblock  = try (ReturnStat <$> expr `folBy` '}') <|> (l2s <$> statblock)
+              propPair = liftM2 (,) myIdent (colon >> expr)
+
+--notFolBy a b = a <* notFollowedBy (char b)
+folBy :: JMParser a -> Char -> JMParser a
+folBy a b = a <* (lookAhead (char b) >>= const (return ()))
+args' :: JMParser [JExpr]
+args' = parens $ commaSep expr
+
+--Parsers without Lexeme
+
+braces', brackets', parens' :: JMParser a -> JMParser a
+brackets' = around' '[' ']'
+braces' = around' '{' '}'
+parens' = around' '(' ')'
+
+around' :: Char -> Char -> JMParser a -> JMParser a
+around' a b x = lexeme (char a) >> (lexeme x <* char b)
+
+myIdent :: JMParser String
+myIdent = lexeme $ many1 (alphaNum <|> oneOf "_-!@#$%^&*();") <|> myStringLiteral '\''
+
+ident' :: JMParser Ident
+ident' = do
+    i <- identifier'
+    when ("jmId_" `isPrefixOf` i) $ fail "Illegal use of reserved jmId_ prefix in variable name."
+    return (StrI i)
+  where
+    identifier' =
+        try $
+        do{ name <- ident''
+          ; if isReservedName name
+             then unexpected ("reserved word " ++ show name)
+             else return name
+          }
+    ident''
+        = do{ c <- P.identStart jsLang
+            ; cs <- many (P.identLetter jsLang)
+            ; return (c:cs)
+            }
+        <?> "identifier"
+    isReservedName name
+        = isReserved theReservedNames caseName
+        where
+          caseName      | P.caseSensitive jsLang  = name
+                        | otherwise               = map toLower name
+    isReserved names name
+        = scan names
+        where
+          scan []       = False
+          scan (r:rs)   = case (compare r name) of
+                            LT  -> scan rs
+                            EQ  -> True
+                            GT  -> False
+    theReservedNames
+        | P.caseSensitive jsLang  = sortedNames
+        | otherwise               = map (map toLower) sortedNames
+        where
+          sortedNames   = sort (P.reservedNames jsLang)
+
+
+natFloat :: Fractional a => JMParser (Either Integer a)
+natFloat = (char '0' >> zeroNumFloat)
+           <|> decimalFloat <?> "number"
+ where
+    zeroNumFloat    =  (Left <$> (hexadecimal <|> octal))
+                       <|> decimalFloat
+                       <|> fractFloat 0
+                       <|> return (Left 0)
+
+    decimalFloat    = do n <- decimal
+                         option (Left n)(fractFloat n)
+    fractFloat n    = Right <$> fractExponent n
+    fractExponent n = (do fract <- fraction
+                          expo  <- option 1.0 exponent'
+                          return ((fromInteger n + fract)*expo)
+                      )
+                      <|> ((fromInteger n *) <$> exponent')
+    fraction        = char '.' >> (foldr op 0.0 <$> many1 digit <?> "fraction")
+                    where
+                      op d f    = (f + fromIntegral (digitToInt d))/10.0
+    exponent'       = do oneOf "eE"
+                         f <- sign
+                         power . f <$> decimal
+                    where
+                       power e  | e < 0      = 1.0/power(-e)
+                                | otherwise  = fromInteger (10^e)
+
+    sign            =   (char '-' >> return negate)
+                    <|> (char '+' >> return id)
+                    <|> return id
+
+    decimal         = number 10 digit
+    hexadecimal     = oneOf "xX" >> number 16 hexDigit
+    octal           = oneOf "oO" >> number 8 octDigit
+
+    number base baseDig = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 <$> many1 baseDig
+
+myStringLiteral :: Char -> JMParser String
+myStringLiteral t = do
+    char t
+    x <- concat <$> many myChar
+    char t
+    return x
+ where myChar = do
+         c <- noneOf [t]
+         case c of
+           '\\' -> do
+                  c2 <- anyChar
+                  return [c,c2]
+           '\n' -> return "\\n"
+           _ -> return [c]
diff --git a/Language/Javascript/JMacro/Typed.hs b/Language/Javascript/JMacro/Typed.hs
new file mode 100644
--- /dev/null
+++ b/Language/Javascript/JMacro/Typed.hs
@@ -0,0 +1,1342 @@
+{-# LANGUAGE QuasiQuotes, FlexibleInstances #-}
+module Language.Javascript.JMacro.Typed where
+
+import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
+
+import Language.Javascript.JMacro.Base
+import Language.Javascript.JMacro.QQ
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Error
+import Control.Applicative
+import Data.List (intercalate, deleteFirstsBy, find)
+import Data.Function(on)
+import qualified Data.Map as M
+import Data.Map(Map)
+import Data.Maybe
+import qualified Data.Set as S
+import Data.Set(Set)
+import Text.PrettyPrint.HughesPJ
+import Debug.Trace
+
+
+--todo: collect errors
+--pretty types, bump down variable nums
+--infer missing vs. assert missing
+--type parser
+--intersection types
+--lists, new/this, extensible records
+--flag to automatically introduce new things into environment
+--seperate resAtoms function
+
+{--------------------------------------------------------------------
+  Main Interface
+--------------------------------------------------------------------}
+
+runTypecheck :: JTypeCheck a => a -> IO ()
+runTypecheck x =  either putStrLn print $ evalState (runErrorT go) tcStateEmpty
+    where go = do
+            res <- typecheck x
+            showenv <- do
+                 (env:topenv:_) <- tc_env <$> get
+                 r@(JTRec i) <- newRec
+                 putRec i (M.toList env)
+                 r'@(JTRec i') <- newRec
+                 putRec i' (M.toList topenv)
+--                 killSats
+                 s <- showType r
+                 s' <- prettyType' r'
+                 pres <- showType res
+                 return (pres,s,s')
+            return showenv
+
+{--------------------------------------------------------------------
+  Types
+--------------------------------------------------------------------}
+
+data JType = JTNum
+           | JTStr
+           | JTBool
+           | JTRec Int
+           | JTFunc [JType] JType
+           | JTList (Maybe Int) (Maybe JType) --can be multityped, monotyped, or neither
+                                              --jtint is an index into a record
+           | JTStat
+           | JTSat Int
+           | BotOf JType
+           | JTVar Int deriving (Show, Eq)
+
+data JConstr = Sub JType | Super JType deriving Show
+
+--canextend needs scoping, to deal with inner lambdas. oyvey. things can only be extended in the scope that they are introduced in. this scoping should be introduced in a scopedRecs thang
+data TCState = TCS {tc_env :: [Map Ident JType],
+                    tc_vars :: Map Int JType,
+                    tc_constrs :: Map Int [JConstr],
+                    tc_recs :: Map Int [(Ident, JType)],
+                    tc_scopedSat :: [Set Int],
+                    tc_varCt :: Int,
+                    tc_strictnull :: Bool,
+                    tc_canextend :: Bool,
+                    tc_debug :: Bool,
+                    tc_expandFree :: Bool} deriving Show
+
+tcStateEmpty :: TCState
+tcStateEmpty = TCS [M.empty,M.empty] M.empty M.empty M.empty [S.empty] 0 True True True True
+
+
+type JMonad a = ErrorT String (State TCState) a
+
+orElse :: JMonad a -> JMonad a -> JMonad a
+x `orElse` y = do
+  st <- get
+  x `catchError` \e1 -> do
+       put st
+       y `catchError` \e2 -> do
+          throwError $ e1 ++ ",\n" ++ e2
+
+{--------------------------------------------------------------------
+  Env utilities
+--------------------------------------------------------------------}
+
+--fix to maybe do it, or insert top level
+lookupEnvErr :: Ident -> JMonad JType
+lookupEnvErr i@(StrI s) = do
+  ans <- msum . map (M.lookup i) . tc_env <$> get
+  case ans of
+    Just x -> return x
+    Nothing -> do
+             b <- tc_expandFree <$> get
+             if b
+                then do
+                  ns <- newTopSat
+                  addTopEnv i ns
+                  return ns
+                else throwError $ "Variable not in scope: " ++ s
+
+--puts idents in scope, as constrained free variables
+withLocalScope :: [Ident] -> JMonad a -> JMonad a
+withLocalScope args act = do
+  env <- tc_env <$> get
+  sats <- tc_scopedSat <$> get
+  modify (\tcs -> tcs {tc_scopedSat = S.empty : sats, tc_env = M.empty : env})
+  mapM (addNewSat) args
+  res <- act
+  (_:restSats) <- tc_scopedSat <$> get
+  (_:restEnv) <- tc_env <$> get
+  modify (\tcs -> tcs {tc_env = restEnv, tc_scopedSat = restSats})
+  return res
+
+--puts idents in scope, as normal free variables
+withLocalScope' :: [Ident] -> JMonad a -> JMonad a
+withLocalScope' args act = do
+  env <- tc_env <$> get
+  modify (\tcs -> tcs {tc_env = M.empty : env})
+  mapM (addNewVar) args
+  res <- act
+  (_:restEnv) <- tc_env <$> get
+  modify (\tcs -> tcs {tc_env = restEnv})
+  return res
+
+inConditional :: JMonad a -> JMonad a
+inConditional act = do
+  oldCE <- tc_canextend <$> get
+  modify (\tcs -> tcs {tc_canextend = False})
+  res <- act
+  modify (\tcs -> tcs {tc_canextend = oldCE})
+  return res
+
+addEnv :: Ident -> JType -> JMonad ()
+addEnv i t = do
+  (env:envs) <- tc_env <$> get
+  modify (\tcs -> tcs {tc_env = M.insert i t env : envs})
+
+addTopEnv :: Ident -> JType -> JMonad ()
+addTopEnv i t = do
+  (env:envs) <- reverse . tc_env <$> get
+  modify (\tcs -> tcs {tc_env = reverse $ M.insert i t env : envs})
+
+newV :: JMonad Int
+newV = do
+  x <- tc_varCt <$> get
+  modify (\tcs -> tcs {tc_varCt = x + 1})
+  return x
+
+newVar :: JMonad JType
+newVar = JTVar <$> newV
+
+newSat :: JMonad JType
+newSat = do
+  x <- newV
+  (sat:sats) <- tc_scopedSat <$> get
+  modify (\tcs -> tcs {tc_scopedSat = S.insert x sat : sats})
+  return (JTSat x)
+
+addNewSat :: Ident -> JMonad ()
+addNewSat i = addEnv i =<< newSat
+
+addNewVar :: Ident -> JMonad ()
+addNewVar i = addEnv i =<< newVar
+
+newTopSat :: JMonad JType
+newTopSat = do
+  x <- newV
+  (sat:sats) <- reverse . tc_scopedSat <$> get
+  modify (\tcs -> tcs {tc_scopedSat = reverse $ S.insert x sat : sats})
+  return (JTSat x)
+
+killSats :: JMonad ()
+killSats = modify (\tcs -> tcs {tc_scopedSat = [S.empty]})
+
+newSatAtScope :: [Int] -> JMonad JType
+newSatAtScope is = do
+  x <- newV
+  let go (s:ss) = if any (flip S.member s) is
+                  then S.insert x s : ss
+                  else s : go ss
+      go [] = []
+  modify (\tcs -> tcs {tc_scopedSat = reverse $ go $ reverse (tc_scopedSat tcs)})
+--  trace ("nsas: " ++ show is ++ ", " ++ show x) $ return ()
+  return (JTSat x)
+
+satInScope :: Int -> JMonad Bool
+satInScope i = any (S.member i) . tc_scopedSat <$> get
+
+incScope :: Int -> Int -> JMonad ()
+incScope i ni = do --move i up to scope of ni
+  let go (s:ss) = if S.member ni s && not (S.member i s)
+                  then S.insert i s : ss
+                  else s : go ss
+      go [] = []
+  modify (\tcs -> tcs {tc_scopedSat = reverse $ go $ reverse (tc_scopedSat tcs)})
+
+
+bumpScope :: Int -> JType -> JMonad ()
+bumpScope i x@(JTVar _) = do
+  xt <- resolveType x
+  case xt of
+    (JTVar _) -> return ()
+    _ -> bumpScope i xt
+
+--bump constraints?
+bumpScope i (JTSat i') = incScope i' i
+
+bumpScope i (JTFunc args ret) = do
+  mapM (bumpScope i) args
+  bumpScope i ret
+
+bumpScope i(JTRec i') = mapM_ go =<< getRec i'
+  where go (_,v) = bumpScope i v
+bumpScope _ _ = return ()
+
+
+{--------------------------------------------------------------------
+  Record utilities
+--------------------------------------------------------------------}
+
+getRec :: Int -> JMonad [(Ident, JType)]
+getRec i = fromMaybe [] . (M.lookup i) . tc_recs <$> get
+
+putRec :: Int -> [(Ident, JType)] -> JMonad ()
+putRec i xs = do
+  recs <- tc_recs <$> get
+  modify (\tcs -> tcs {tc_recs = M.insert i xs recs})
+
+recLookup :: Ident -> JType -> JMonad (Maybe JType)
+recLookup v (JTRec i) = maybe Nothing (lookup v) . M.lookup i . tc_recs <$> get
+recLookup _ _ = return $ Nothing
+
+newRec :: JMonad JType
+newRec = do
+  x <- tc_varCt <$> get
+  modify (\tcs -> tcs {tc_varCt = x + 1})
+  return (JTRec x)
+
+{--------------------------------------------------------------------
+  Constraint utilities
+--------------------------------------------------------------------}
+
+unzipConstrs :: [JConstr] -> ([JType],[JType])
+unzipConstrs = foldr go ([],[])
+            where
+              go (Sub l)   ~(ls, rs) = (l:ls, rs)
+              go (Super r) ~(ls, rs) = (ls, r:rs)
+
+zipConstrs :: [JType] -> [JType] -> [JConstr]
+zipConstrs subs supers = map Sub subs ++ map Super supers
+
+lookupConstraints :: Int -> JMonad [JConstr]
+lookupConstraints i = fromMaybe [] . M.lookup i . tc_constrs <$> get
+
+--move simplification away from here, delay to last possible moment
+addConstraint :: Int -> JConstr -> JMonad ()
+addConstraint i c = do
+  cs <- lookupConstraints i
+  constrs <- tc_constrs <$> get
+  modify (\tcs -> tcs {tc_constrs = M.insert i (c:cs) constrs})
+
+
+{--------------------------------------------------------------------
+  Type utilities
+--------------------------------------------------------------------}
+
+chkNoNull :: [JType] -> JMonad ()
+chkNoNull xs = do
+    strictnull <- tc_strictnull <$> get
+    if strictnull
+       then mapM_ (chkNull <=< resolveType) xs
+       else return ()
+  where chkNull x@(JTVar _) = tyErr1 "Attempt to return a (potentially) null variable" x
+        chkNull _ = return ()
+
+showType :: JType -> JMonad String
+showType (JTVar (-1)) = return ""
+showType x@(JTVar _) = do
+  xt <- resolveType x
+  case xt of
+    (JTVar i') -> return $ "t"++show i'
+    _ -> showType xt
+showType (JTSat i) = do
+    cs <- lookupConstraints i
+    case cs of
+      [] -> return $ "ct" ++ show i
+      _ -> do
+        cst <- mapM go cs
+        return $ "ct" ++ show i ++ " <= [" ++ intercalate ", " cst ++ "]"
+  where go (Sub x) = do
+             str <- showType x
+             return ("<: " ++ str)
+        go (Super x) = do
+             str <- showType x
+             return (">: " ++ str)
+
+
+showType JTNum = return "Num"
+showType JTStr = return "String"
+showType JTBool = return "Bool"
+showType (JTRec i) = do
+  rs <- getRec i
+  strs <- mapM go rs
+  return $ "{" ++ intercalate ", " strs ++ "...}"
+    where go (StrI s, t) = do
+                           st <- showType t
+                           return (s ++ ": " ++ st)
+showType (JTFunc args res) = do
+  strs <- mapM showType args
+  rest <- showType res
+  if length strs == -1 --fixme
+     then return $ concat strs ++ " -> " ++  rest
+     else return $ "((" ++ intercalate ", " strs ++ ") -> " ++ rest++")"
+showType JTStat = return $ "()"
+
+showType (JTList _ (Just mono)) = do
+  m <- showType mono
+  return $ "[" ++ m ++ "]"
+
+showType (JTList (Just multi) _) = do
+  showType (JTRec multi)
+
+showType (JTList Nothing Nothing) = error "trying to show bad list"
+
+prettyType :: JType -> JMonad String
+prettyType x = showType x -- =<< resC False x
+
+prettyType' :: JType -> JMonad String
+prettyType' x = showType =<< resC False x
+
+resolveType :: JType -> JMonad JType
+resolveType (JTSat i) = return $ JTSat i
+resolveType (JTVar i) = do
+  vars <- tc_vars <$> get
+  case M.lookup i vars of
+    Just t -> do
+      rt <- resolveType t
+      when (t /= rt) $ do
+                modify (\tcs -> tcs {tc_vars = M.insert i rt vars})
+      return rt
+    _ -> return (JTVar i)
+resolveType r@(JTRec i) = do
+  (is, ts) <- unzip <$> getRec i
+  ts' <-  mapM resolveType ts
+  putRec i (zip is ts')
+  return r
+
+resolveType (JTFunc argst rett) = do
+  argst' <- mapM resolveType argst
+  rett' <- resolveType rett
+  return (JTFunc argst' rett')
+resolveType x = return x
+
+resolveState :: JMonad ()
+resolveState = do
+  envs <- tc_env <$> get
+  envs' <- forM envs $ \env ->
+                      let (is,ts) = unzip $ M.toList env
+                      in  M.fromList . zip is <$> mapM (resC False <=< resolveType) ts
+  modify (\tcs -> tcs {tc_env = envs'})
+
+{--------------------------------------------------------------------
+  Trace/Error utilities
+--------------------------------------------------------------------}
+
+ifDbg :: JMonad () -> JMonad ()
+ifDbg x = flip when x . tc_debug =<< get
+
+traceSats :: JMonad ()
+traceSats = ifDbg $ do
+              ss <- tc_scopedSat <$> get
+              trace ("scoped sats: " ++ show ss) $ return ()
+
+traceVars :: JMonad ()
+traceVars = ifDbg $ do
+  resolveState
+  vars <- tc_vars <$> get
+  trace (show vars) $ return ()
+
+traceConstrs:: JMonad ()
+traceConstrs = ifDbg $ do
+  resolveState
+  cs <- tc_constrs <$> get
+  trace (show cs) $ return ()
+
+tyErr1 :: String -> JType -> JMonad a
+tyErr1 s t = do
+  st <- prettyType t
+  throwError $ s ++ ": " ++ st
+
+tyErr2 :: String -> JType -> JType -> JMonad a
+tyErr2 s t t' = do
+  st <- prettyType t
+  st' <- prettyType t'
+  throwError $ s ++ ". Expected: " ++ st ++ ", Inferred: " ++ st'
+
+tyErr2l :: String -> [JType] -> [JType] -> JMonad a
+tyErr2l s t t' = do
+  sts <- mapM showType t
+  sts' <- mapM showType t'
+  throwError $ s ++ ". Expected: (" ++ intercalate ", " sts ++
+                 "), Inferred: (" ++ intercalate "," sts' ++")"
+
+traceTy :: String -> JType -> JMonad ()
+traceTy s x = ifDbg $ do
+    xt <- showType x
+    trace (s ++ ": " ++ show xt) $ return ()
+
+traceTys :: String -> JType -> JType -> JMonad ()
+traceTys s x y = ifDbg $ do
+       xt <- showType x
+       yt <- showType y
+       trace (s ++": " ++ xt ++ ", " ++ yt) $ return ()
+
+{--------------------------------------------------------------------
+  Subtyping
+--------------------------------------------------------------------}
+
+--subtype {} {x:a} fails
+--subtype {x:a} {} succeeds with {}
+-- x is a subtype of y
+--subtype enforces subtype relation
+(<:) :: JType -> JType -> JMonad ()
+x <: y = do
+  xr <- resolveType x
+  yr <- resolveType y
+  if xr == yr
+     then return ()
+     else traceTys "subtyping" xr yr >> subtype xr yr
+
+subtype :: JType -> JType -> JMonad ()
+subtype x@(JTSat i) y@(JTSat i') = do
+  addConstraint i (Sub y)
+  bumpScope i y
+
+--assigning a free variable to a fixed type
+--is incoherent, as it implies usage of a null variable
+subtype x@(JTVar _) y = do
+  x' <- resolveType x
+  case x' of
+    JTVar _ -> tyErr1 "Cannot subtype a free variable in" y
+    _ -> x' <: y
+
+--assigning to a free variable fixes it
+subtype x y@(JTVar _) = do
+  y' <- resolveType y
+  case y' of
+    JTVar _ -> do
+            y' =.= x
+    _ -> x <: y'
+
+subtype x (JTSat i') = do
+  cs <- lookupConstraints i'
+  mapM_ go cs
+  addConstraint i' (Super x)
+      where go (Sub c) = x <: c
+            go (Super c) = c <: x
+
+subtype (JTSat i) y = do
+  cs <- lookupConstraints i
+  mapM_ go cs
+  addConstraint i (Sub y)
+      where go (Sub c) = c <: y
+            go (Super c) = y <: c
+
+--lookup ys in xs
+subtype x@(JTRec i) y@(JTRec i') = do
+  yl <- getRec i'
+  xl <- getRec i
+  let go [] = return ()
+      go ((ident@(StrI s),v):ls) = do
+            case lookup ident xl of
+              Just t -> do
+                        t <: v
+                        go ls
+              Nothing -> tyErr2 ("Couldn't subtype, missing property " ++ s) x y
+
+  go yl
+
+subtype x@(JTFunc argsx retx) y@(JTFunc argsy rety) = do
+ when (length argsy < length argsx) $ tyErr2 "Couldn't match" x y
+ zipWithM_ (<:) argsy argsx -- functions are contravariant in argument type
+ retx <: rety -- functions are covariant in return type
+
+--List case
+subtype x y
+    | x == y = return ()
+    | otherwise = tyErr2 "Couldn't subtype" x y
+
+
+{--------------------------------------------------------------------
+  Unification
+--------------------------------------------------------------------}
+
+--Unification should be very limited, and really only occur with
+--free variables or atoms. Everything else is constraints.
+
+--deal with constraints!?
+occursCheck :: Int -> JType -> JMonad ()
+occursCheck i typ = go typ >>= \b -> if b
+                  then do
+                    xt <- showType (JTVar i)
+                    yt <- showType typ
+                    throwError $ "Could not construct infinite type when unifying " ++ xt ++" and " ++ yt
+                  else return ()
+    where go t@(JTVar _) = resolveType t >>= \rt -> case rt of
+                                                      (JTVar i') -> return (i==i')
+                                                      _ -> go rt
+          go (JTRec i') = or <$> (mapM (go . snd) =<< getRec i')
+          go (JTFunc args ret) = or <$> mapM go (ret:args)
+          go _ = return False
+          --list case
+
+--unify, but fail if first argument is free
+(<=.=) :: JType -> JType -> JMonad ()
+x <=.= y = do
+    strictnull <- tc_strictnull <$> get
+    xr <- resolveType x
+    if strictnull
+        then case xr of
+               (JTVar _) -> tyErr1 "Attempt to use null variable as type" y
+               _ -> return ()
+        else return ()
+    case xr of
+      (JTSat _) -> xr <: y
+      _ -> xr =.= y
+
+(=.=) :: JType -> JType -> JMonad ()
+x =.= y = do
+  xr <- resolveType x
+  yr <- resolveType y
+  if (xr == yr)
+     then return ()
+     else traceTys "unifying" xr yr >> unify xr yr
+
+unify (JTVar i) t' = do
+  occursCheck i t'
+  case t' of
+    (JTVar i') -> do
+            newt <- newVar
+            vars <- tc_vars <$> get
+            modify (\tcs -> tcs {tc_vars = M.insert i' newt $
+                                           M.insert i  newt $
+                                           vars})
+    _ -> do
+      vars <- tc_vars <$> get
+      modify (\tcs -> tcs {tc_vars = M.insert i t' vars})
+
+unify t t'@(JTVar _)  =  t' =.= t
+
+--force actual unification with free vars?
+{-
+unify :: JType -> JType -> JMonad ()
+unify (JTSat _) (JTSat _) = throwError "unification of two constrained type variables is unimplemented"
+
+unify (JTSat i) t' = do
+  cs <- lookupConstraints i
+  mapM_ go cs
+  let (subs,supers) = unzipConstrs cs
+  luball subs
+  glball supers
+  addConstraint i (Sub t')
+  b <- satInScope i
+  when (not b) $ addConstraint i (Super t')
+      where go (Sub x) = t' <: x
+            go (Super x) = x <: t'
+
+unify y x@(JTSat _) = unify x y
+
+unify (JTRec i) (JTRec i') = do
+  xl <- getRec i
+  yl <- getRec i'
+
+  --find every value in x in y, and unify each
+  let go ((l,v):lvs) = case find ((==l) . fst) yl of
+                         Nothing -> go lvs
+                         Just (_,v') -> v =.= v'
+      go _ = return ()
+
+  go xl
+
+  let xld = deleteFirstsBy ((==) `on` fst) xl yl --xs not in ys
+      yld = deleteFirstsBy ((==) `on` fst) yl xl --ys not in xs
+
+  putRec i  (xl++yld)
+  putRec i' (yl++xld)
+  return ()
+
+unify x@(JTFunc argsx retx) y@(JTFunc argsy rety) = do
+ when (length argsx /= length argsy) $ tyErr2 "Couldn't match functions" x y
+ zipWithM_ (=.=) argsx argsy
+ retx =.= rety
+-}
+unify t t' = do
+  rt  <- resolveType t
+  rt' <- resolveType t'
+  if rt == rt'
+     then return ()
+     else tyErr2 "Type error" t t'
+
+
+{--------------------------------------------------------------------
+  Clone -- i.e. schema instantiation
+--------------------------------------------------------------------}
+type JMonadClone a = StateT [(Int,JType)] (ErrorT String (State TCState)) a
+
+addSub :: (Int,JType) -> JMonadClone ()
+addSub x = do
+  st <- get
+  put (x:st)
+
+findSub :: Int -> JMonadClone (Maybe JType)
+findSub i = do
+  sub <- lookup i <$> get
+  case sub of
+    Just x -> do
+              newsub <- case x of
+                          (JTVar i') -> if i' /= i then findSub i' else return $ Just x
+                          (JTRec i') -> if i' /= i then findSub i' else return $ Just x
+                          (JTSat i') -> if i' /= i then findSub i' else return $ Just x
+                          _ -> return $ Just x
+              case newsub of
+                Just ans -> return $ Just ans
+                Nothing -> return $ Just x
+    _ -> return Nothing
+
+traceSubs :: JMonadClone ()
+traceSubs = do
+  st <- get
+  trace (show st) $ return ()
+
+traceC :: JConstr -> JMonadClone ()
+traceC (Sub x) = lift $ traceTy "Sub" x
+traceC (Super x) = lift $ traceTy "Super" x
+
+clone :: JType -> JMonad JType
+clone t = evalStateT (clone'' t) []
+
+cloneMany :: [JType] -> JMonad [JType]
+cloneMany ts = evalStateT (mapM clone'' ts) []
+
+--clone just replaces free variables
+clone'' :: JType -> JMonadClone JType
+clone'' x = do
+  lift $ traceTy "Cloning" x
+  c <- clone' x
+  lift $ traceTy "Clone Result" c
+  return c
+
+clone' :: JType -> JMonadClone JType
+clone' x@(JTVar _) = do
+  xt <- lift $ resolveType x
+  case xt of
+    (JTVar i) -> do
+            mbsub <- findSub i
+            case mbsub of
+              Just sub -> return sub
+              _ -> do
+                   nv <- lift $ newVar
+                   addSub (i,nv)
+                   return $ nv
+    _ -> clone' xt
+
+clone' (JTSat i) = do
+    mbsub <- findSub i
+    b <- lift $ satInScope i
+    case (mbsub,b) of
+      (Just sub,_) -> return sub
+      (_,False) -> do
+        cs <- lift $ lookupConstraints i
+        let (subs,supers) = unzipConstrs cs
+        subs' <- mapM clone' subs
+        supers' <- mapM clone' supers
+        ns@(JTSat i') <- lift $ newSatAtScope [i]
+        lift $ mapM (addConstraint i') $ zipConstrs subs' supers'
+        addSub (i,ns)
+        return ns
+      _ -> do
+        cs <- lift $ lookupConstraints i
+        let (subs,supers) = unzipConstrs cs
+        subs' <- mapM clone' subs
+        supers' <- mapM clone' supers
+        constrs <- lift $ tc_constrs <$> get
+        lift $ modify (\tcs -> tcs {tc_constrs = M.insert i (zipConstrs subs' supers') constrs})
+        addSub (i,JTSat i)
+        return (JTSat i)
+
+clone' (JTFunc args ret) = do
+  args' <- mapM clone' args
+  ret' <- clone' ret
+  return (JTFunc args' ret')
+
+clone' (JTRec i) = do
+    mbsub <- findSub i
+    case mbsub of
+      Just sub -> return sub
+      _ -> do
+        rl <- lift $ getRec i
+        rl' <- mapM go rl
+        r'@(JTRec i') <- lift $ newRec
+        lift $ putRec i' rl'
+        return r'
+  where go (i',v) = do
+             v' <- clone' v
+             return (i',v')
+
+clone' (JTList mbmulti mbmono) = do
+  mbmulti' <- maybe (return Nothing) (fmap Just . cloneRec) mbmulti
+  mbmono'  <- maybe (return Nothing) (fmap Just . clone') mbmono
+  return $ JTList mbmulti' mbmono'
+         where cloneRec x = do
+                 (JTRec i) <- clone' (JTRec x)
+                 return i
+
+clone' x = return x
+
+substitute :: JType -> JMonadClone JType
+substitute x@(JTVar _) = do
+  xt <- lift $ resolveType x
+  case xt of
+    (JTVar i) -> do
+            mbsub <- findSub i
+            case mbsub of
+              Just sub -> return sub
+              _ -> return xt
+    _ -> substitute xt
+
+substitute (JTSat i) = do
+    mbsub <- findSub i
+    b <- lift $ satInScope i
+    case (mbsub,b) of
+      (Just sub,_) -> return sub
+      (_,False) -> do
+        cs <- lift $ lookupConstraints i
+        let (subs,supers) = unzipConstrs cs
+        subs' <- mapM substitute subs
+        supers' <- mapM substitute supers
+        ns@(JTSat i') <- lift $ newSatAtScope [i]
+        lift $ mapM (addConstraint i') $ zipConstrs subs' supers'
+        addSub (i,ns)
+        return ns
+      _ -> do
+        cs <- lift $ lookupConstraints i
+        let (subs,supers) = unzipConstrs cs
+        subs' <- mapM substitute subs
+        supers' <- mapM substitute supers
+        constrs <- lift $ tc_constrs <$> get
+        lift $ modify (\tcs -> tcs {tc_constrs = M.insert i (zipConstrs subs' supers') constrs})
+        return (JTSat i)
+
+substitute (JTFunc args ret) = do
+  args' <- mapM substitute args
+  ret' <- substitute ret
+  return (JTFunc args' ret')
+
+substitute (JTRec i) = do
+    mbsub <- findSub i
+    case mbsub of
+      Just sub -> return sub
+      _ -> do
+        rl <- lift $ getRec i
+        rl' <- mapM go rl
+        r'@(JTRec i') <- lift $ newRec
+        lift $ putRec i' rl'
+        return r'
+  where go (i',v) = do
+          v' <- substitute v
+          return (i',v')
+substitute x = return x
+
+
+{--------------------------------------------------------------------
+  Constraint Resolution
+--------------------------------------------------------------------}
+
+resC :: Bool -> JType -> JMonad JType
+resC inApp x = flip evalStateT [] $ do
+  lift $ traceTy "resC" x
+  c <- resC' inApp False x
+  lift $ traceTy "resC Ans" c
+  return c
+
+resC' :: Bool -> Bool -> JType -> JMonadClone JType
+resC' inApp contra x@(JTVar _) = do
+  xt <- lift $ resolveType x
+  case xt of
+    (JTVar i) -> return (JTVar i)
+    _ -> resC' inApp contra xt
+
+resC' inApp contra (JTFunc args ret) = do
+  args' <- mapM (resC' inApp True) args --mapM (resC' (not contra)) args
+  ret'  <- resC' False False ret
+  return (JTFunc args' ret')
+
+resC' inApp contra r@(JTRec i) = do
+  rl  <- lift $ getRec i
+  rl' <- mapM go rl
+  lift $ putRec i rl'
+  return r
+      where go (i',v) = do
+              v' <- resC' inApp contra v
+              return (i',v')
+
+--in app we substitute, otherwise we keep as constrained
+resC' inApp contra x@(JTSat i) = do
+    mbsub <- findSub i
+    b <- lift $ satInScope i
+    case (mbsub,b) of
+      (Just sub, _) -> return sub
+      (_, False) -> do
+        JTSat (i') <- substitute (JTSat i)
+        cs <- lift (lookupConstraints i')
+        cs' <- simplifyCs cs
+        mapM traceC cs'
+        ans <- resCs cs'
+        --keep supertype, subtype constraints distinct
+        ans' <- case (contra && not inApp, ans) of
+          (True,(JTRec _)) -> trace "wao" $do
+                      ns@(JTSat i'') <- lift $ newSat --newSatAtScope [i]
+                      lift $ addConstraint i'' (Sub ans)
+                      addSub (i,ns)
+                      return ns
+          (True,(JTFunc _ _ )) -> do
+                      ns@(JTSat i'') <- lift $ newSat --newSatAtScope [i]
+                      lift $ addConstraint i'' (Sub ans)
+                      addSub (i,ns)
+                      return ns
+          _ -> return ans
+        addSub (i,ans')
+        lift $ traceTy "hai" ans'
+        return ans'
+      _ -> do
+        cs <- lift (lookupConstraints i)
+        cs' <- simplifyCs cs
+        if any isAtom cs'
+          then do
+              ans <- resCs cs'
+              addSub (i,ans)
+              return ans
+          else return x {- do
+              ns@(JTSat i') <- lift $ newSat
+              mapM (addConstraint i') cs'
+              addSub (i,ns)
+              return ns-}
+    where
+      resCs cs = do
+        let (subs,supers) = unzipConstrs cs
+        subs' <- mapM (resC' inApp contra) subs
+        supers' <- mapM (resC' inApp contra) supers
+        lubsubs   <- lift $ resolveType =<< luball subs'
+        glbsupers <- lift $ resolveType =<< glball supers'
+        case (length subs', length supers') of
+          (0,0) -> return lubsubs
+          (0,_) -> return glbsupers
+          (_,0) -> return lubsubs
+          _     -> lift $ glbsupers \/ lubsubs
+      isAtom (Sub JTNum) = True
+      isAtom (Super JTNum) = True
+      isAtom (Sub JTStr) = True
+      isAtom (Super JTStr) = True
+      isAtom _ = False
+      --isatom should go deeper into sats
+
+resC' inApp contra (JTList mbmulti mbmono) = do
+  mbmulti' <- maybe (return Nothing) (fmap Just . resRec) mbmulti
+  mbmono'  <- maybe (return Nothing) (fmap Just . (resC' inApp contra)) mbmono
+  return (JTList mbmulti' mbmono')
+         where resRec x = do
+                 (JTRec i) <- resC' inApp contra (JTRec x)
+                 return i
+
+resC' _ _ x = return x
+
+getBot (JTRec _) = return $ JTRec (-1)
+getBot (JTFunc _ ret) = do
+  ret' <- getBot ret
+  return $ JTFunc [] ret'
+getBot x@(JTVar _) = do
+  rx <- resolveType x
+  case rx of
+    (JTVar _) -> return $ BotOf rx
+    _ -> getBot rx
+getBot x@(JTList mbmulti mbmono) = do
+  mbmono' <- maybe (return Nothing) (\x -> Just <$> getBot x) mbmono
+  return $ JTList (fmap (const (negate 1)) mbmulti) mbmono --only bot of multi if multi, only bot of mono if mono!!!! TODO
+getBot x = return x
+
+simplifyCs :: [JConstr] -> JMonadClone [JConstr]
+simplifyCs cs = concat <$> mapM simplifyC cs
+
+simplifyC :: JConstr -> JMonadClone [JConstr]
+simplifyC (Sub c) = case c of
+                      JTSat i -> do
+                             b <- lift $ satInScope i
+                             if b
+                               then return [Sub c]
+                               else do
+                                   cs <- lift $ lookupConstraints i
+                                   (subs, supers) <- unzipConstrs <$> simplifyCs cs
+                                   supers' <- lift $ map Sub <$> mapM getBot supers
+                                   return $ map Sub subs ++ supers'
+                      _ -> return [Sub c]
+
+simplifyC (Super c) = case c of
+                      JTSat i -> do
+                             b <- lift $ satInScope i
+                             if b
+                               then return [Super c]
+                               else do
+                                   cs <- lift $ lookupConstraints i
+                                   (subs, supers) <- unzipConstrs <$> simplifyCs cs
+                                   subs' <- lift $ map Sub <$> mapM getBot subs
+                                   return $ map Super supers ++ subs'
+                      _ -> return [Super c]
+
+{--------------------------------------------------------------------
+  Least upper bound
+--------------------------------------------------------------------}
+
+--{} \/ {a} = {a}
+(\/) :: JType -> JType -> JMonad JType
+x \/ y = do
+  xr <- resolveType x
+  yr <- resolveType y
+  if xr == yr
+     then return xr
+     else do
+       traceTys "lub" xr yr
+       ans <- lub xr yr
+       traceTy "lub ans" ans
+       return ans
+
+lub :: JType -> JType -> JMonad JType
+
+lub x@(JTSat i) y@(JTSat i') = do
+  ns@(JTSat i'') <- newSatAtScope [i, i']
+  addConstraint i'' (Sub y)
+  addConstraint i'' (Sub x)
+  return ns
+
+--check if value satisfies constraint then proceed with constraint
+lub (JTSat i) y = do
+  cs <- lookupConstraints i
+  mapM_ go cs
+  ns@(JTSat i') <- newSatAtScope [i]
+  mapM (addConstraint i') (Sub y : cs)
+  return ns
+      where go (Sub c) = y <: c
+            go (Super c) = c <: y
+
+lub x y@(JTSat _) = y \/ x
+
+lub x@(JTVar _) y = do
+  xt <- resolveType x
+  case xt of
+    (JTVar _) ->  do
+            ns@(JTSat i'') <- newSat
+            addConstraint i'' (Sub y)
+--            addConstraint i'' (Sub x)
+            x =.= ns -- ?
+            return ns
+    _ -> xt \/ y
+
+lub x y@(JTVar _) = y \/ x
+
+lub (JTFunc args ret) (JTFunc args' ret') = do
+  args'' <- zipWithM (/\) args args'
+  ret'' <- ret \/ ret'
+  return $ JTFunc args'' ret''
+
+lub (JTRec i) (JTRec i') = do
+  xl <- getRec i
+  yl <- getRec i'
+  --find every value in x in y, and return lub of each
+  let go ((l,v):lvs) = case find ((==l) . fst) yl of
+                         Nothing -> go lvs
+                         Just (_,v') -> do
+                                    newv <- v \/ v'
+                                    ((l,newv) :) <$> go lvs
+      go _ = return []
+  xlyl <- go xl
+
+  --then add every value of x not in y and every value of y not in x
+  let xld = deleteFirstsBy ((==) `on` fst) xl yl --xs not in ys
+      yld = deleteFirstsBy ((==) `on` fst) yl xl --ys not in xs
+
+  r'@(JTRec i'') <- newRec
+  putRec i'' $ xlyl ++ xld ++ yld
+  return r'
+
+lub (JTList mbmulti mbmono) (JTList mbmulti' mbmono') = do
+  mbmulti'' <- case (mbmulti, mbmulti') of
+                 (Just multi, Just multi') -> do
+                      (JTRec i) <- (JTRec multi) \/ (JTRec multi')
+                      return $ Just i
+                 _ -> return Nothing
+  mbmono'' <- case (mbmono, mbmono') of
+                (Just mono, Just mono') -> Just <$> mono \/ mono'
+                _ -> return Nothing
+  return $ JTList mbmulti'' mbmono''
+
+lub x y
+  | x == y = return x
+  | otherwise = do
+        tyErr2 "No Least Upper Bound Exists" x y
+
+luball :: [JType] -> JMonad JType
+luball (h:xs) = do
+  foldM (\x y -> x \/ y) h xs
+luball [] = newVar
+
+
+{--------------------------------------------------------------------
+ Greatest Lower bound
+--------------------------------------------------------------------}
+
+(/\) :: JType -> JType -> JMonad JType
+x /\ y = do
+  xr <- resolveType x
+  yr <- resolveType y
+  if xr == yr
+     then return xr
+     else do
+       traceTys "glb" xr yr
+       ans <- glb xr yr
+       traceTy "glb ans" ans
+       return ans
+
+glb :: JType -> JType -> JMonad JType
+glb (JTSat i) (JTSat i') = do
+  ns <- newSatAtScope [i, i']
+  addConstraint i (Super ns)
+  addConstraint i' (Super ns)
+  return ns
+
+--glb of a free variable and anything is a subtype of the free var and the other thing
+glb x@(JTVar _) y = do
+  xt <- resolveType x
+  case xt of
+    (JTVar _) -> do
+            ns@(JTSat i) <- newSatAtScope [-1] --always right?
+--            addConstraint i (Super x)
+            addConstraint i (Super y)
+            x =.= ns -- ?
+            return ns
+    _ -> x /\ y
+
+glb x y@(JTVar _) = y /\ x
+
+glb x@(JTSat i) y = do
+  ns@(JTSat i') <- newSatAtScope [i]
+  addConstraint i' (Super y)
+  addConstraint i' (Super x)
+  return ns
+
+glb x y@(JTSat _) = y /\ x
+
+glb (JTFunc args ret) (JTFunc args' ret') = do
+  args'' <- zipWithM (\/) args args'
+  ret'' <- ret /\ ret'
+  return $ JTFunc args'' ret''
+
+glb (JTRec i) (JTRec i') = do
+  xl <- getRec i
+  yl <- getRec i'
+    --find every value in x in y, and return glb of each
+  let go ((l,v):lvs) = case find ((==l) . fst) yl of
+                         Nothing -> go lvs
+                         Just (_,v') -> do
+                                    newv <- err2may (v /\ v')
+                                    case newv of
+                                      Just nv -> ((l,nv) :) <$> go lvs
+                                      Nothing -> go lvs
+      go _ = return []
+  r'@(JTRec i'') <- newRec
+  putRec i'' =<< go xl
+  return r'
+           where err2may v = fmap Just v `orElse` return Nothing
+
+glb (JTList mbmulti mbmono) (JTList mbmulti' mbmono') = do
+  mbmulti'' <- case (mbmulti, mbmulti') of
+                 (Just multi, Just multi') -> do
+                      (JTRec i) <- (JTRec multi) /\ (JTRec multi')
+                      return $ Just i
+                 _ -> return Nothing
+  mbmono'' <- case (mbmono, mbmono') of
+                (Just mono, Just mono') -> Just <$> mono /\ mono'
+                _ -> return Nothing
+  return $ JTList mbmulti'' mbmono''
+
+
+glb x y
+  | x == y = return x
+  | otherwise = tyErr2 "No Greatest Lower Bound Exists" x y
+
+glball :: [JType] -> JMonad JType
+glball (h:xs) = do
+  foldM (\x y -> x /\ y) h xs
+glball [] = newVar
+
+{--------------------------------------------------------------------
+  Typecheck
+--------------------------------------------------------------------}
+
+class JTypeCheck a where
+    typecheck :: a -> JMonad JType
+
+instance JTypeCheck JStat where
+    typecheck (DeclStat i) = addNewVar i >> return JTStat
+    typecheck (ReturnStat e) = typecheck e
+    typecheck (BlockStat xs) = typecheck xs
+    typecheck (AssignStat x y) = do
+                            xt <- typecheckLhs x
+                            yt <- typecheck y
+                            yt <: xt
+                            return JTStat
+
+    typecheck (IfStat e s s') = do
+      (<=.= JTBool) =<< typecheck e
+      if (s' == BlockStat [])
+        then inConditional $ typecheck s
+        else inConditional $ do
+          --can we allow assignments that happen in both, or is this way too hard?
+          st <- typecheck s
+          st' <- typecheck s'
+          chkNoNull [st,st']
+          st /\ st'
+    typecheck (WhileStat e s) = do
+      (<=.= JTBool) =<< typecheck e
+      inConditional $ typecheck s
+
+    --for in statements iterate over names
+    typecheck (ForInStat False i e s) = withLocalScope' [i] $ do
+      (JTStr =.=) =<< lookupEnvErr i
+      et <- resolveType =<< typecheck e
+      case et of
+          --list case
+          JTRec _ -> return ()
+          _ -> tyErr1 "Attempt to use 'for in' construct with improper type" et
+      inConditional $ typecheck s
+
+    --for each in statements iterate over property values
+    typecheck (ForInStat True ident e s) = withLocalScope' [ident] $ do
+      et <- resolveType =<< typecheck e
+      case et of
+        --list case
+        JTRec i -> do
+                --el <- map snd . init <$> rec2list et
+                el <- map snd <$> getRec i
+                case el of
+                  [] -> return ()
+                  es -> do
+                       e' <- glball es
+                       (e' =.=) =<< lookupEnvErr ident
+        _ -> tyErr1 "Attempt to use 'for each in' construct with improper type" et
+      inConditional $ typecheck s
+    typecheck (ApplStat e args) = typecheck (ApplExpr e args) >> return JTStat
+    typecheck BreakStat = return JTStat
+    --Switch
+    --Unsat $ Anti -- anti can take signature!?
+
+typecheckLhs :: JExpr -> JMonad JType
+typecheckLhs (SelExpr e1 ident@(StrI s)) = do
+  e1t <- typecheck e1
+  case e1t of
+    JTRec i -> do
+             newt <- recLookup ident e1t
+             canextend <- tc_canextend <$> get
+             case newt of
+               Just t -> return t
+               Nothing -> if canextend
+                           then do
+                             v <- newVar
+                             rs <- getRec i
+                             putRec i $ (ident,v):rs
+                             return v
+                           else tyErr1 "Attempt to extend record in conditional code" e1t
+    JTSat i -> do
+             ns <- newSatAtScope [i]
+             nr@(JTRec i') <- newRec
+             putRec i' [(ident,ns)]
+             addConstraint i (Sub nr)
+             return ns
+    _ -> tyErr1 ("No property " ++ s ++ " in type") e1t
+
+typecheckLhs x = typecheck x
+
+
+instance JTypeCheck JExpr where
+    typecheck (ValExpr v) = typecheck v
+    typecheck (SelExpr e1 ident@(StrI s)) = do
+                            e1t <- typecheck e1
+                            newt <- recLookup ident e1t
+                            case (newt, e1t) of
+                              (Just t, _) -> return t
+                              (Nothing, JTSat i) -> do
+                                   ns <- newSatAtScope [i]
+                                   nr@(JTRec i') <- newRec
+                                   putRec i' [(ident,ns)]
+                                   addConstraint i (Sub nr)
+                                   return ns
+                              (Nothing, _) -> tyErr1 ("No property " ++ s ++ " in type") e1t
+
+    --NewExpr -- this is really a special appl
+    --Unsat & Anti
+    typecheck (InfixExpr s e1 e2)
+        | s `elem` ["-","/","*"] = setFixed JTNum
+        | s == "+" = setFixed JTNum `orElse` setFixed JTStr --TODO: Intersection types
+        | s `elem` [">","<","==","/="] = setFixed JTNum >> return JTBool
+        | s `elem` ["||","&&"] = setFixed JTBool
+        | otherwise = throwError $ "Unhandled operator: " ++ s
+      where setFixed t = do
+              (<=.=) t =<< typecheck e1
+              (<=.=) t =<< typecheck e2
+              return t
+
+    --check that e is either a selexpr or a var or an idxexpr
+    typecheck (PostExpr _ e) = case e of
+                                 (SelExpr _ _) -> go
+                                 (ValExpr (JVar _)) -> go
+                                 (IdxExpr _ _) -> go
+                                 _ -> tyErr1 "Value not compatible with postfix assignment" =<< typecheck e
+        where go = ((<=.= JTNum) =<< typecheck e) >> return JTNum
+
+    typecheck (IfExpr e e1 e2) = do
+                            (<=.= JTBool) =<< typecheck e
+                            e1t <- typecheck e1
+                            e2t <- typecheck e2
+                            e1t /\ e2t
+
+    typecheck (ApplExpr e args) = do
+                            et <- resolveType =<< typecheck e
+                            argst <- mapM (resolveType <=< typecheck) args
+                            appFun et argst
+    typecheck (IdxExpr e1 e2) = do
+                            e1t <- resolveType =<< typecheck e1
+                            e2t <- resolveType =<< typecheck e2
+                            case e1t of
+                              (JTList _ (Just t)) -> return t
+                              (JTList (Just r) _)  -> case e2 of
+                                        (ValExpr (JStr i)) -> do
+                                          newt <- recLookup (StrI i) (JTRec r)
+                                          case newt of
+                                            Just t -> return t
+                                            Nothing -> tyErr1 ("No property " ++ i ++ " in type") e1t
+                                        (ValExpr (JInt i)) -> do
+                                          newt <- recLookup (StrI $ show i) (JTRec r)
+                                          case newt of
+                                            Just t -> return t
+                                            Nothing -> tyErr1 ("No property " ++ show i ++ " in type") e1t
+                                        _ -> tyErr1 "Cannot index into hash/tuple with runtime expression" e1t
+                              (JTList _ _) -> tyErr1 "List/Hash with no inhabited types" e1t
+                              (JTSat i) -> do
+                                      ns <- newSatAtScope [i]
+                                      mbrec <- case e2 of
+                                         (ValExpr (JStr i)) -> do
+                                            nr@(JTRec i') <- newRec
+                                            putRec i' [(StrI i,ns)]
+                                            return $ Just i'
+                                         (ValExpr (JInt i)) -> do
+                                            nr@(JTRec i') <- newRec
+                                            putRec i' [(StrI $ show i,ns)]
+                                            return $ Just i'
+                                         _ -> return Nothing
+                                      addConstraint i (Sub $ JTList mbrec (Just ns))
+                                      return ns
+                              _ -> tyErr1 "Attempting to index into something of type" e1t
+
+appFun :: JType -> [JType] -> JMonad JType
+appFun(JTFunc args ret) appArgs = do
+    when (length args > length appArgs) $ tyErr2l "Mismatched argument lengths" args appArgs
+    appArgs' <- cloneMany appArgs
+    (JTFunc args' ret') <- clone (JTFunc args ret)
+    zipWithM (<:) appArgs' args'
+    (JTFunc args'' ret'') <- withLocalScope [] $ resC True $ JTFunc args' ret'
+--    zipWithM (=.=) args'' appArgs'
+    return ret''
+--    withLocalScope [] $ resC True ret''
+
+appFun (JTSat i) args' = do
+  s  <- newSatAtScope [i]
+  mapM (bumpScope i) args'
+  addConstraint i (Sub $ JTFunc args' s)
+  return s
+
+appFun x _ = tyErr1 "Attempting to apply as a function something of type"  x
+
+instance JTypeCheck JVal where
+    typecheck (JVar i) = case i of
+                           StrI "true" -> return JTBool
+                           StrI "false" -> return JTBool
+                           StrI "null"  -> newVar
+                           StrI _ -> resolveType =<< lookupEnvErr i
+    typecheck (JInt _) = return JTNum
+    typecheck (JDouble _) = return JTNum
+    typecheck (JStr _) = return JTStr
+    typecheck (JFunc args stat) =
+                           withLocalScope args ( do
+                             argst <- mapM (typecheck . JVar) args
+                             rett <- typecheck stat
+                             resC False $ JTFunc argst rett)
+    typecheck (JHash m) = do
+            let (is, es) = unzip $ M.toList m
+            ets <- mapM typecheck es
+            let initialrec
+                    | null is = []
+                    | otherwise =  zip (map StrI is) ets
+            r@(JTRec i) <- newRec
+            putRec i initialrec
+            return r
+    typecheck (JList es) = do
+            (JTRec i) <- typecheck $ JHash $ M.fromList (zip (map show [1..]) es)
+            es' <- mapM typecheck es
+            e'' <- (Just <$> glball es') `orElse` return Nothing
+            return $ JTList (Just i) e''
+    --List
+
+instance JTypeCheck [JStat] where
+    typecheck [] = return JTStat
+    typecheck stats = do
+      ts <- filter (/=JTStat) <$> (mapM resolveType =<< mapM typecheckAnnotated stats)
+      case ts of
+        [] -> return JTStat
+        _ -> chkNoNull ts >> glball ts
+
+typecheckAnnotated :: (JMacro a, JsToDoc a, JTypeCheck a) => a -> JMonad JType
+typecheckAnnotated stat = typecheck stat `catchError` \ e -> throwError $ e ++ "\nIn statement:\n" ++ renderStyle (style {mode = OneLineMode}) (renderJs stat)
diff --git a/Language/Javascript/JMacro/Util.hs b/Language/Javascript/JMacro/Util.hs
new file mode 100644
--- /dev/null
+++ b/Language/Javascript/JMacro/Util.hs
@@ -0,0 +1,63 @@
+module Language.Javascript.JMacro.Util where
+
+import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
+
+import qualified Prelude as P
+import Language.Javascript.JMacro.Base
+
+(.) :: JExpr -> String -> JExpr
+x . y = SelExpr x (StrI y)
+
+(<>) :: ToJExpr a => JExpr -> a -> JExpr
+x <> y = IdxExpr x (toJExpr y)
+
+infixl 2 =:
+(=:) :: ToJExpr a => JExpr -> a -> JStat
+x =:  y = AssignStat x (toJExpr y)
+
+($) :: (ToJExpr a, ToJExpr b) => a -> b -> JExpr
+x $  y = ApplExpr (toJExpr x) (toJExprList y)
+
+($$) :: (ToJExpr a, ToJExpr b) => a -> b -> JStat
+x $$  y = ApplStat (toJExpr x) (toJExprList y)
+
+(==), (!=), (<), (&&) :: JExpr -> JExpr -> JExpr
+x == y = InfixExpr "==" x y
+x != y = InfixExpr "!=" x y
+
+infix 4 <
+x < y = InfixExpr "<" x y
+infixr 3 &&
+x && y = InfixExpr "&&" x y
+
+null :: JExpr
+null  = jsv "null"
+
+new :: ToJExpr a => a -> JExpr
+new x = NewExpr (toJExpr x)
+
+if' :: (ToJExpr a, ToStat b) => a -> b -> JStat
+if' x y       = IfStat (toJExpr x) (toStat y) (BlockStat [])
+
+ifElse :: (ToJExpr a, ToStat b, ToStat c) => a -> b -> c -> JStat
+ifElse x y z = IfStat (toJExpr x) (toStat y) (toStat z)
+
+while :: ToJExpr a => a -> JStat -> JStat
+while x y = WhileStat (toJExpr x) y
+
+return :: ToJExpr a => a -> JStat
+return x = ReturnStat (toJExpr x)
+
+
+toJExprList :: ToJExpr a => a -> [JExpr]
+toJExprList x = case toJExpr x of
+                  (ValExpr (JList l)) -> l
+                  x' -> [x']
+
+
+jsv :: P.String -> JExpr
+jsv = ValExpr P.. JVar P.. StrI
+
+jstr :: P.String -> JExpr
+jstr = ValExpr P.. JStr
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/jmacro.cabal b/jmacro.cabal
new file mode 100644
--- /dev/null
+++ b/jmacro.cabal
@@ -0,0 +1,28 @@
+name:                jmacro
+version:             0.1
+synopsis:            QuasiQuotation library for programmatic generation of Javascript code.
+description:         Javascript syntax, functional syntax, hygeinic names, compile-time guarantees of syntactic correctness, limited typechecking.
+category:            Language
+license:             BSD3
+license-file:        LICENSE
+author:              Gershom Bazerman
+maintainer:          gershomb@gmail.com
+Tested-With:         GHC == 6.10.3
+Build-Type:          Simple
+Cabal-Version:       >= 1.6
+
+
+library
+  build-depends:     base >= 4, base < 5, containers, pretty, safe >= 0.2, parsec >= 2.1, template-haskell >= 2.3, mtl, haskell-src-meta, bytestring >= 0.9
+  exposed-modules:   Language.Javascript.JMacro
+                     Language.Javascript.JMacro.Util
+                     Language.Javascript.JMacro.Typed
+  other-modules:     Language.Javascript.JMacro.Base
+                     Language.Javascript.JMacro.QQ
+  ghc-options:       -Wall
+  if impl(ghc >= 6.8)
+    ghc-options:     -fwarn-tabs
+
+source-repository head
+  type:      darcs
+  location:  http://patch-tag.com/r/jmacro/pullrepo