packages feed

ecma262 (empty) → 0.0.0

raw patch · 15 files changed

+9318/−0 lines, 15 filesdep +basedep +containersdep +data-defaultsetup-changed

Dependencies added: base, containers, data-default, ecma262, lens, parsec, safe, transformers

Files

+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) 2014, Fabian Bergmark+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* 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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT HOLDER 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.
+ Main.hs view
@@ -0,0 +1,17 @@+module Main+       ( main ) where++import Control.Monad (void)++import System.Environment (getArgs)++import Language.JavaScript+import Language.JavaScript.Parser+import Language.JavaScript.Host.Console++main :: IO ()+main = do+  (file:_) <- getArgs+  source <- readFile file+  let eAST = parseJavaScript source+  void $ runHostedJavaScript source console
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ecma262.cabal view
@@ -0,0 +1,58 @@+name:              ecma262+version:           0.0.0+synopsis:          A ECMA-262 interpreter library+description:       A library for iterpreting ECMA-262 code.+homepage:          https://github.com/fabianbergmark/ECMA-262+category:          Language+author:            Fabian Bergmark+maintainer:        fabian.bergmark@gmail.com+license:           BSD2+license-file:      LICENSE+cabal-version:     >= 1.10+build-type:        Simple++extra-source-files: LICENSE++source-repository head+  type:     git+  location: https://github.com/fabianbergmark/ECMA-262.git++library+    default-language: Haskell2010++    hs-source-dirs: src/++    exposed-modules: Language.JavaScript+                     Language.JavaScript.AST+                     Language.JavaScript.Interpret+                     Language.JavaScript.Lexer+                     Language.JavaScript.Parser+                     Language.JavaScript.String+                     Language.JavaScript.Util+                     Language.JavaScript.SubType+                     Language.JavaScript.Host+                     Language.JavaScript.Host.Console++    other-modules: Language.JavaScript.Prim++    ghc-options: -fno-warn-orphans -fno-warn-unused-binds -fno-warn-unused-matches++    build-depends: base         == 4.*+                 , containers   == 0.4.* || == 0.5.*+                 , data-default == 0.5.*+                 , lens         == 4.6.*+                 , parsec       == 3.1.*+                 , safe         == 0.3.*+                 , transformers == 0.4.*++executable ecma262+    default-language: Haskell2010++    main-is: Main.hs++    ghc-options: -fno-warn-orphans -fno-warn-unused-binds -fno-warn-unused-matches++    other-modules: Main++    build-depends: base == 4.*+                 , ecma262 == 0.0.0
+ src/Language/JavaScript.hs view
@@ -0,0 +1,29 @@+module Language.JavaScript+       where++import Control.Applicative ((<$>))++import Text.Parsec (ParseError)++import Language.JavaScript.Interpret+import Language.JavaScript.Parser++runJavaScript :: (Functor m, Monad m) =>+                 String -> m (Either ParseError (Either Value Completion))+runJavaScript source = do+  let eAST = parseJavaScript source+  case eAST of+   Right ast -> do+     Right <$> runJavaScriptT initialState (interpret ast)+   Left e -> return (Left e)++runHostedJavaScript :: (Functor m, Monad m) =>+                       String ->+                       JavaScriptT m () ->+                       m (Either ParseError (Either Value Completion))+runHostedJavaScript source hostInit = do+  let eAST = parseJavaScript source+  case eAST of+   Right ast -> do+     Right <$> runJavaScriptT initialState (hostInit >> interpret ast)+   Left e -> return (Left e)
+ src/Language/JavaScript/AST.hs view
@@ -0,0 +1,470 @@+module Language.JavaScript.AST+       where++data IdentName =+  IdentName String+  deriving (Eq, Show)++data Ident =+  Ident IdentName+  deriving (Eq, Show)++data Literal+  = LiteralNull NullLit+  | LiteralBool BoolLit+  | LiteralNum NumLit+  | LiteralString StringLit+  | LiteralRegExp RegExpLit+  deriving (Eq, Show)++data NullLit+  = NullLit+  deriving (Eq, Show)++data BoolLit+  = BoolLit Bool+  deriving (Eq, Show)++data NumLit+  = NumLit Double+  deriving (Eq, Show)++data StringLit+  = StringLit String+  deriving (Eq, Show)++data RegExpLit+  = RegExpLit (String, String)+  deriving (Eq, Show)++data PrimExpr+  = PrimExprThis+  | PrimExprIdent Ident+  | PrimExprLiteral Literal+  | PrimExprArray ArrayLit+  | PrimExprObject ObjectLit+  | PrimExprParens Expr+  deriving (Eq, Show)++data ArrayLit+  = ArrayLitH (Maybe Elision)+  | ArrayLit ElementList+  | ArrayLitT ElementList (Maybe Elision)+  deriving (Eq, Show)++data ElementList+  = ElementList (Maybe Elision) AssignExpr+  | ElementListCons ElementList (Maybe Elision) AssignExpr+  deriving (Eq, Show)++data Elision+  = ElisionComma+  | ElisionCons Elision+  deriving (Eq, Show)++data ObjectLit+  = ObjectLitEmpty+  | ObjectLit PropList+  deriving (Eq, Show)++data PropList+  = PropListAssign PropAssign+  | PropListCons PropList PropAssign+  deriving (Eq, Show)++data PropAssign+  = PropAssignField PropName AssignExpr+  | PropAssignGet PropName FuncBody+  | PropAssignSet PropName PropSetParamList FuncBody+  deriving (Eq, Show)++data PropSetParamList+  = PropSetParamList Ident+  deriving (Eq, Show)++data PropName+  = PropNameId IdentName+  | PropNameStr StringLit+  | PropNameNum NumLit+  deriving (Eq, Show)++data MemberExpr+  = MemberExprPrim PrimExpr+  | MemberExprFunc FuncExpr+  | MemberExprArray MemberExpr Expr+  | MemberExprDot MemberExpr IdentName+  | MemberExprNew MemberExpr Arguments+  deriving (Eq, Show)++data NewExpr+  = NewExprMember MemberExpr+  | NewExprNew NewExpr+  deriving (Eq, Show)++data CallExpr+  = CallExprMember MemberExpr Arguments+  | CallExprCall CallExpr Arguments+  | CallExprArray CallExpr Expr+  | CallExprDot CallExpr IdentName+  deriving (Eq, Show)++data Arguments+  = ArgumentsEmpty+  | Arguments ArgumentList+  deriving (Eq, Show)++data ArgumentList+  = ArgumentList AssignExpr+  | ArgumentListCons ArgumentList AssignExpr+  deriving (Eq, Show)++data LeftExpr+  = LeftExprNewExpr NewExpr+  | LeftExprCallExpr CallExpr+  deriving (Eq, Show)++data PostFixExpr+  = PostFixExprLeftExpr LeftExpr+  | PostFixExprPostInc LeftExpr+  | PostFixExprPostDec LeftExpr+  deriving (Eq, Show)++data UExpr+  = UExprPostFix PostFixExpr+  | UExprDelete UExpr+  | UExprVoid UExpr+  | UExprTypeOf UExpr+  | UExprDoublePlus UExpr+  | UExprDoubleMinus UExpr+  | UExprUnaryPlus UExpr+  | UExprUnaryMinus UExpr+  | UExprBitNot UExpr+  | UExprNot UExpr+  deriving (Eq, Show)++data MultExpr+  = MultExpr UExpr+  | MultExprMult MultExpr UExpr+  | MultExprDiv MultExpr UExpr+  | MultExprMod MultExpr UExpr+  deriving (Eq, Show)++data AddExpr+  = AddExpr MultExpr+  | AddExprAdd AddExpr MultExpr+  | AddExprSub AddExpr MultExpr+  deriving (Eq, Show)++data ShiftExpr+  = ShiftExpr AddExpr+  | ShiftExprLeft ShiftExpr AddExpr+  | ShiftExprRight ShiftExpr AddExpr+  | ShiftExprRightZero ShiftExpr AddExpr+  deriving (Eq, Show)++data RelExpr+  = RelExpr ShiftExpr+  | RelExprLess RelExpr ShiftExpr+  | RelExprGreater RelExpr ShiftExpr+  | RelExprLessEq RelExpr ShiftExpr+  | RelExprGreaterEq RelExpr ShiftExpr+  | RelExprInstanceOf RelExpr ShiftExpr+  | RelExprIn RelExpr ShiftExpr+  deriving (Eq, Show)++data RelExprNoIn+  = RelExprNoIn ShiftExpr+  | RelExprNoInLess RelExprNoIn ShiftExpr+  | RelExprNoInGreater RelExprNoIn ShiftExpr+  | RelExprNoInLessEq RelExprNoIn ShiftExpr+  | RelExprNoInGreaterEq RelExprNoIn ShiftExpr+  | RelExprNoInInstanceOf RelExprNoIn ShiftExpr+  deriving (Eq, Show)++data EqExpr+  = EqExpr RelExpr+  | EqExprEq EqExpr RelExpr+  | EqExprNotEq EqExpr RelExpr+  | EqExprStrictEq EqExpr RelExpr+  | EqExprStrictNotEq EqExpr RelExpr+  deriving (Eq, Show)++data EqExprNoIn+  = EqExprNoIn RelExprNoIn+  | EqExprNoInEq EqExprNoIn RelExprNoIn+  | EqExprNoInNotEq EqExprNoIn RelExprNoIn+  | EqExprNoInStrictEq EqExprNoIn RelExprNoIn+  | EqExprNoInStrictNotEq EqExprNoIn RelExprNoIn+  deriving (Eq, Show)++data BitAndExpr+  = BitAndExpr EqExpr+  | BitAndExprAnd BitAndExpr EqExpr+  deriving (Eq, Show)++data BitAndExprNoIn+  = BitAndExprNoIn EqExprNoIn+  | BitAndExprNoInAnd BitAndExprNoIn EqExprNoIn+  deriving (Eq, Show)++data BitXorExpr+  = BitXorExpr BitAndExpr+  | BitXorExprXor BitXorExpr BitAndExpr+  deriving (Eq, Show)++data BitXorExprNoIn+  = BitXorExprNoIn BitAndExprNoIn+  | BitXorExprNoInXor BitXorExprNoIn BitAndExprNoIn+  deriving (Eq, Show)++data BitOrExpr+  = BitOrExpr BitXorExpr+  | BitOrExprOr BitOrExpr BitXorExpr+  deriving (Eq, Show)++data BitOrExprNoIn+  = BitOrExprNoIn BitXorExprNoIn+  | BitOrExprNoInOr BitOrExprNoIn BitXorExprNoIn+  deriving (Eq, Show)++data LogicalAndExpr+  = LogicalAndExpr BitOrExpr+  | LogicalAndExprAnd LogicalAndExpr BitOrExpr+  deriving (Eq, Show)++data LogicalAndExprNoIn+  = LogicalAndExprNoIn BitOrExprNoIn+  | LogicalAndExprNoInAnd LogicalAndExprNoIn BitOrExprNoIn+  deriving (Eq, Show)++data LogicalOrExpr+  = LogicalOrExpr LogicalAndExpr+  | LogicalOrExprOr LogicalOrExpr LogicalAndExpr+  deriving (Eq, Show)++data LogicalOrExprNoIn+  = LogicalOrExprNoIn LogicalAndExprNoIn+  | LogicalOrExprNoInOr LogicalOrExprNoIn LogicalAndExprNoIn+  deriving (Eq, Show)++data CondExpr+  = CondExpr LogicalOrExpr+  | CondExprIf LogicalOrExpr AssignExpr AssignExpr+  deriving (Eq, Show)++data CondExprNoIn+  = CondExprNoIn LogicalOrExprNoIn+  | CondExprNoInIf LogicalOrExprNoIn AssignExpr AssignExpr+  deriving (Eq, Show)++data AssignExpr+  = AssignExprCondExpr CondExpr+  | AssignExprAssign LeftExpr AssignOp AssignExpr+  deriving (Eq, Show)++data AssignExprNoIn+  = AssignExprNoInCondExpr CondExprNoIn+  | AssignExprNoInAssign LeftExpr AssignOp AssignExprNoIn+  deriving (Eq, Show)++data AssignOp+  = AssignOpNormal+  | AssignOpMult+  | AssignOpDiv+  | AssignOpMod+  | AssignOpPlus+  | AssignOpMinus+  | AssignOpShiftLeft+  | AssignOpShiftRight+  | AssignOpShiftRightZero+  | AssignOpBitAnd+  | AssignOpBitXor+  | AssignOpBitOr+  deriving (Eq, Show)++data Expr+  = Expr AssignExpr+  | ExprCons Expr AssignExpr+  deriving (Eq, Show)++data ExprNoIn+  = ExprNoIn AssignExprNoIn+  | ExprNoInCons ExprNoIn AssignExprNoIn+  deriving (Eq, Show)++data Stmt+  = StmtBlock Block+  | StmtVar VarStmt+  | StmtEmpty EmptyStmt+  | StmtExpr ExprStmt+  | StmtIf IfStmt+  | StmtIt ItStmt+  | StmtCont ContStmt+  | StmtBreak BreakStmt+  | StmtReturn ReturnStmt+  | StmtWith WithStmt+  | StmtLabelled LabelledStmt+  | StmtSwitch SwitchStmt+  | StmtThrow ThrowStmt+  | StmtTry TryStmt+  | StmtDbg DbgStmt+  deriving (Eq, Show)++data Block+  = Block (Maybe StmtList)+  deriving (Eq, Show)++data StmtList+  = StmtList Stmt+  | StmtListCons StmtList Stmt+  deriving (Eq, Show)++data VarStmt+  = VarStmt VarDeclList+  deriving (Eq, Show)++data VarDeclList+  = VarDeclList VarDecl+  | VarDeclListCons VarDeclList VarDecl+  deriving (Eq, Show)++data VarDeclListNoIn+  = VarDeclListNoIn VarDeclNoIn+  | VarDeclListNoInCons VarDeclListNoIn VarDeclNoIn+  deriving (Eq, Show)++data VarDecl+  = VarDecl Ident (Maybe Initialiser)+  deriving (Eq, Show)++data VarDeclNoIn+  = VarDeclNoIn Ident (Maybe InitialiserNoIn)+  deriving (Eq, Show)++data Initialiser+  = Initialiser AssignExpr+  deriving (Eq, Show)++data InitialiserNoIn+  = InitialiserNoIn AssignExprNoIn+  deriving (Eq, Show)++data EmptyStmt+  = EmptyStmt+  deriving (Eq, Show)++data ExprStmt+  = ExprStmt Expr+  deriving (Eq, Show)++data IfStmt+  = IfStmtIfElse Expr Stmt Stmt+  | IfStmtIf Expr Stmt+  deriving (Eq, Show)++data ItStmt+  = ItStmtDoWhile Stmt Expr+  | ItStmtWhile Expr Stmt+  | ItStmtFor (Maybe ExprNoIn) (Maybe Expr) (Maybe Expr) Stmt+  | ItStmtForVar VarDeclListNoIn (Maybe Expr) (Maybe Expr) Stmt+  | ItStmtForIn LeftExpr Expr Stmt+  | ItStmtForVarIn VarDeclNoIn Expr Stmt+  deriving (Eq, Show)++data ContStmt+  = ContStmt+  | ContStmtLabelled Ident+  deriving (Eq, Show)++data BreakStmt+  = BreakStmt+  | BreakStmtLabelled Ident+  deriving (Eq, Show)++data ReturnStmt+  = ReturnStmt+  | ReturnStmtExpr Expr+  deriving (Eq, Show)++data WithStmt+  = WithStmt Expr Stmt+  deriving (Eq, Show)++data SwitchStmt+  = SwitchStmt Expr CaseBlock+  deriving (Eq, Show)++data CaseBlock+  = CaseBlock (Maybe CaseClauses)+  | CaseBlockDefault (Maybe CaseClauses) DefaultClause (Maybe CaseClauses)+  deriving (Eq, Show)++data CaseClauses+  = CaseClauses CaseClause+  | CaseClausesCons CaseClauses CaseClause+  deriving (Eq, Show)++data CaseClause+  = CaseClause Expr (Maybe StmtList)+  deriving (Eq, Show)++data DefaultClause+  = DefaultClause (Maybe StmtList)+  deriving (Eq, Show)++data LabelledStmt+  = LabelledStmt Ident Stmt+  deriving (Eq, Show)++data ThrowStmt+  = ThrowStmt Expr+  deriving (Eq, Show)++data TryStmt+  = TryStmtBC Block Catch+  | TryStmtBF Block Finally+  | TryStmtBCF Block Catch Finally+  deriving (Eq, Show)++data Catch+  = Catch Ident Block+  deriving (Eq, Show)++data Finally+  = Finally Block+  deriving (Eq, Show)++data DbgStmt+  = DbgStmt+  deriving (Eq, Show)++data FuncDecl+  = FuncDecl Ident (Maybe FormalParamList) FuncBody+  deriving (Eq, Show)++data FuncExpr+  = FuncExpr (Maybe Ident) (Maybe FormalParamList) FuncBody+  deriving (Eq, Show)++data FormalParamList+  = FormalParamList Ident+  | FormalParamListCons FormalParamList Ident+  deriving (Eq, Show)++data FuncBody =+  FuncBody (Maybe SourceElements)+  deriving (Eq, Show)++data Program =+  Program (Maybe SourceElements)+  deriving (Eq, Show)++data SourceElements+  = SourceElements SourceElement+  | SourceElementsCons SourceElements SourceElement+  deriving (Eq, Show)++data SourceElement+  = SourceElementStmt Stmt+  | SourceElementFuncDecl FuncDecl+  deriving (Eq, Show)
+ src/Language/JavaScript/Host.hs view
@@ -0,0 +1,11 @@+module Language.JavaScript.Host where++import Control.Lens++import Language.JavaScript.Interpret++defineGlobalProperty :: (Monad m) =>+                        String -> Property -> JavaScriptT m ()+defineGlobalProperty i p = do+  global <- use globalObject+  property global i ?= p
+ src/Language/JavaScript/Host/Console.hs view
@@ -0,0 +1,100 @@+module Language.JavaScript.Host.Console where++import Control.Lens++import Control.Monad (forM)+import Control.Monad.IO.Class (MonadIO(..))++import Data.List (intersperse)++import Language.JavaScript.Host+import Language.JavaScript.Interpret+import Language.JavaScript.SubType++import qualified Data.Map as Map (empty, fromList)++console :: (Functor m, Monad m, MonadIO m) =>+           JavaScriptT m ()+console = do+  consoleLogId <- createNextInternalId+  op <- use objectPrototypeObject+  fp <- use functionPrototypeObject+  let consoleLogObj = Object consoleLogId+      consoleLogObjInt = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist fp),+        objectInternalClass             = "Function",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Just consoleLogCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++  mInternalObject consoleLogObj ?= consoleLogObjInt++  consoleId <- createNextInternalId+  let consoleObj = Object consoleId+      consoleObjInt = ObjectInternal {+        objectInternalProperties        = Map.fromList+         [ ("log", PropertyData $ DataDescriptor {+               dataDescriptorValue          = inj consoleLogObj,+               dataDescriptorWritable       = True,+               dataDescriptorEnumerable     = False,+               dataDescriptorConfigurable   = True }) ],+        objectInternalPrototype         = const $ return (JSExist op),+        objectInternalClass             = "Object",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++  mInternalObject consoleObj ?= consoleObjInt++  defineGlobalProperty+    "console"+    (PropertyData DataDescriptor {+        dataDescriptorValue          = inj consoleObj,+        dataDescriptorWritable       = True,+        dataDescriptorEnumerable     = False,+        dataDescriptorConfigurable   = True })++consoleLogCallImpl :: (Functor m, Monad m, MonadIO m) => InternalCallType m+consoleLogCallImpl f this (List args) = do+  forM (intersperse (inj " ") args) $ \v -> toString v >>= liftIO . putStr+  liftIO $ putStrLn ""+  return (inj Undefined)
+ src/Language/JavaScript/Interpret.hs view
@@ -0,0 +1,7174 @@+{-# LANGUAGE AllowAmbiguousTypes,+             FlexibleContexts,+             FlexibleInstances,+             FunctionalDependencies,+             GeneralizedNewtypeDeriving,+             MultiParamTypeClasses,+             OverlappingInstances,+             PatternSynonyms,+             RankNTypes,+             RecordWildCards,+             ScopedTypeVariables,+             TypeOperators,+             TypeSynonymInstances #-}++module Language.JavaScript.Interpret+       where++import Control.Applicative ((<$>), (<|>), (<*>))+import Control.Lens (Lens', (.=), (?=), (%=))+import qualified Control.Lens as Lens (at, lens, use)+import Control.Monad (void)+import Control.Monad (forM, liftM2, when)+import qualified Control.Monad.Trans.Except as Except+  (ExceptT, catchE, runExceptT, throwE)+import qualified Control.Monad.Trans.State.Lazy as State+  (StateT(..), evalStateT)++import Data.Default+import Data.Int+import Data.Fixed (mod')+import Data.Map (Map)+import qualified Data.Map as Map+  (empty, fromList, insert, lookup, member, toList)+import Data.Maybe (fromJust, isJust)+import Data.Word+import Data.Bits+  ((.|.), (.&.), complement, shiftL, shiftR, xor)+import Data.Foldable (foldlM)++import Prelude (Bool(..), Double, Either(..), Integer,+                Maybe(..), String,+                Eq((/=), (==)), Floating(..), Fractional(..),+                Functor(..), Monad(..), Num((+), (-), (*), abs),+                Ord((>), (<), (>=), (<=)), Real, RealFloat, RealFrac, Show(..),+                ($), (.), (^), (++),+                (&&), (||), (!!),+                const, elem, error, flip, floor, foldl,+                fromInteger, fromIntegral, id, isInfinite, isNaN, isNegativeZero,+                length, maybe, mod, not, null, show, signum, snd, succ,+                undefined)+import qualified Prelude++import Safe (tailSafe)++import Language.JavaScript.AST+import Language.JavaScript.String+import Language.JavaScript.SubType++class Interpret f m t | f -> t where+  interpret :: f -> m t++class Interpret1 f m p t | f -> p, f -> t where+  interpret1 :: f -> p -> m t++instance (Functor m, Monad m) => Interpret Literal m Value where+  interpret (LiteralNull n) = do+    n' <- interpret n+    return $ inj n'+  interpret (LiteralBool b) =  do+    b' <- interpret b+    return $ inj b'+  interpret (LiteralNum n) =  do+    n' <- interpret n+    return $ inj n'+  interpret (LiteralString s) =  do+    s' <- interpret s+    return $ inj s'+  interpret (LiteralRegExp r) = do+    r' <- interpret r+    return $ inj r'++instance (Functor m, Monad m) => Interpret NullLit m Null where+  interpret NullLit = return Null++instance (Functor m, Monad m) => Interpret BoolLit m Bool where+  interpret (BoolLit b) = return b++instance (Functor m, Monad m) => Interpret StringLit m String where+  interpret (StringLit s) = return s++instance (Functor m, Monad m) => Interpret NumLit m Number where+  interpret (NumLit n) = return $ Number n++instance (Functor m, Monad m) => Interpret RegExpLit m Undefined where+  interpret (RegExpLit _) = return $ Undefined++instance (Functor m, Monad m) =>+         Interpret PrimExpr (JavaScriptT m) CallValue where+  interpret PrimExprThis = do+    v <- Lens.use $ contextStack . currentContext . thisBinding+    return $ inj v++  interpret (PrimExprIdent (Ident (IdentName s))) = do+    env <- Lens.use $ contextStack . currentContext . lexicalEnvironment+    let strict = False+    inj <$> getIdentifierReference (Just env) s strict++  interpret (PrimExprLiteral l) = do+    v <- interpret l+    return $ inj v+  interpret (PrimExprArray a) = do+    o <- interpret a+    return $ inj o+  interpret (PrimExprObject o) = do+    v <- interpret o+    return $ inj v+  interpret (PrimExprParens e) = do+    v <- interpret e+    return $ inj v++instance (Functor m, Monad m) =>+         Interpret ArrayLit (JavaScriptT m) Object where+  interpret (ArrayLitH me) = do+    a <- newArrayObject []+    pad <- case me of+            Just e -> interpret e+            _ -> return $ Number 0+    put a "length" (inj pad) False+    return a++  interpret (ArrayLit e) = interpret e+  interpret (ArrayLitT e mel) = do+    array <- interpret e+    pad <- case mel of+            Just el -> interpret el+            _ -> return $ Number 0+    len <- get array "length" >>= toNumber+    newLen <- toUint32 (pad + len)+    put array "length" (inj $ Number $ fromIntegral newLen) False+    return array++instance (Functor m, Monad m) =>+         Interpret ObjectLit (JavaScriptT m) Object where+  interpret ObjectLitEmpty = do+    o <- newObjectObject Nothing+    return o++  interpret (ObjectLit pl) = interpret pl++instance (Functor m, Monad m) =>+         Interpret PropList (JavaScriptT m) Object where+  interpret (PropListAssign pa) = do+    obj <- newObjectObject Nothing+    PropertyIdentifier name desc <- interpret pa+    defineOwnProperty obj name desc False+    return obj++  interpret (PropListCons pl pa) = do+    obj <- interpret pl+    PropertyIdentifier name desc <- interpret pa+    mPrevious <- getOwnProperty obj name+    case mPrevious of+     JSJust previous -> return ()+     JSNothing -> return ()+    defineOwnProperty obj name desc False+    return obj++instance (Functor m, Monad m) =>+         Interpret PropAssign (JavaScriptT m) PropertyIdentifier where+  interpret (PropAssignField pn ae) = do+    propName <- interpret pn+    exprValue <- interpret ae+    propValue <- getValue exprValue+    let desc = def {+          propertyDescriptorValue        = Just propValue,+          propertyDescriptorWritable     = Just True,+          propertyDescriptorEnumerable   = Just True,+          propertyDescriptorConfigurable = Just True }+    return $ PropertyIdentifier propName desc++  interpret (PropAssignGet pn fb) = do+    propName <- interpret pn+    lex <- Lens.use $ contextStack . currentContext . lexicalEnvironment+    let strict = False+    closure <- newFunctionObject Nothing fb lex strict+    let desc = def {+          propertyDescriptorGet          = Just closure,+          propertyDescriptorEnumerable   = Just True,+          propertyDescriptorConfigurable = Just True }+    return $ PropertyIdentifier propName desc++  interpret (PropAssignSet pn (PropSetParamList i) fb) = do+    propName <- interpret pn+    lex <- Lens.use $ contextStack . currentContext . lexicalEnvironment+    let strict = False+    closure <- newFunctionObject (Just (FormalParamList i)) fb lex strict+    let desc = def {+          propertyDescriptorSet          = Just closure,+          propertyDescriptorEnumerable   = Just True,+          propertyDescriptorConfigurable = Just True }+    return $ PropertyIdentifier propName desc++instance (Functor m, Monad m) =>+         Interpret PropName (JavaScriptT m) String where+  interpret (PropNameId (IdentName s)) = return s+  interpret (PropNameStr (StringLit s)) = return s+  interpret (PropNameNum (NumLit n)) = do+    let nbr = Number n+    toString nbr++instance (Functor m, Monad m) =>+         Interpret Elision m Number where+  interpret (ElisionComma) = return $ Number 1+  interpret (ElisionCons e ) = do+    Number n <- interpret e+    return $ Number (n+1)++instance (Functor m, Monad m) =>+         Interpret ElementList (JavaScriptT m) Object where+  interpret (ElementList me ae) = do+    array <- newArrayObject []+    firstIndex <-+      case me of+       Just e -> interpret e+       _ -> return $ Number 0+    initResult <- interpret ae+    initValue <- getValue initResult+    s <- toString firstIndex+    defineOwnProperty+      array+      s+      (def {+          propertyDescriptorValue        = Just initValue,+          propertyDescriptorWritable     = Just True,+          propertyDescriptorEnumerable   = Just True,+          propertyDescriptorConfigurable = Just True })+      False+    return array++  interpret (ElementListCons el me ae) = do+    array <- interpret el+    pad <- case me of+            Just e -> interpret e+            _ -> return $ Number 0+    initResult <- interpret ae+    initValue <- getValue initResult+    len <- get array "length"+    newLen <- pad `operatorPlus` len >>=+              toUint32 >>=+              toString . Number . fromIntegral+    let desc = def {+          propertyDescriptorValue        = Just initValue,+          propertyDescriptorWritable     = Just True,+          propertyDescriptorEnumerable   = Just True,+          propertyDescriptorConfigurable = Just True }+    defineOwnProperty array newLen desc False+    return array+++instance (Functor m, Monad m) =>+         Interpret Stmt (JavaScriptT m) Completion where+  interpret (StmtBlock b) = interpret b+  interpret (StmtVar v) = interpret v+  interpret (StmtEmpty e) = interpret e+  interpret (StmtExpr e) = interpret e+  interpret (StmtIf i) = interpret i+  interpret (StmtIt i) = interpret i+  interpret (StmtCont c) = interpret c+  interpret (StmtBreak b) = interpret b+  interpret (StmtReturn r) = interpret r+  interpret (StmtWith w) = interpret w+  interpret (StmtLabelled l) = interpret l+  interpret (StmtSwitch s) = interpret s+  interpret (StmtThrow t) = interpret t+  interpret (StmtTry t) = interpret t+  interpret (StmtDbg d) = interpret d++instance (Functor m, Monad m) =>+         Interpret Block (JavaScriptT m) Completion where+  interpret (Block Nothing) =+    return $ Completion CompletionTypeNormal Nothing Nothing+  interpret (Block (Just sl)) = interpret sl++instance (Functor m, Monad m) =>+         Interpret StmtList (JavaScriptT m) Completion where+  interpret (StmtList stmt) =+    Except.catchE+    (interpret stmt)+    (\v -> return $ Completion CompletionTypeThrow (Just v) Nothing)+  interpret (StmtListCons sl stmt) = do+    slc <- interpret sl+    case slc of+     Completion CompletionTypeNormal slv _ ->+       Except.catchE+       (do+           s@(Completion sty sva sta) <- (interpret stmt :: JavaScriptT m Completion)+           if isJust sva+             then return $ Completion sty sva sta+             else return $ Completion sty slv sta)+       (\v -> return $ Completion CompletionTypeThrow (Just v) Nothing)+     _ -> return slc++instance (Functor m, Monad m) =>+         Interpret VarStmt (JavaScriptT m) Completion where+  interpret (VarStmt vdl) = do+    interpret vdl+    return $ Completion CompletionTypeNormal Nothing Nothing++instance (Functor m, Monad m) =>+         Interpret VarDeclList (JavaScriptT m) String where+  interpret (VarDeclList vd) = interpret vd+  interpret (VarDeclListCons vdl vd) = do+    interpret vdl+    interpret vd++instance (Functor m, Monad m) =>+         Interpret VarDeclListNoIn (JavaScriptT m) String where+  interpret (VarDeclListNoIn vd) = interpret vd+  interpret (VarDeclListNoInCons vdl vd) = do+    interpret vdl+    interpret vd++instance (Functor m, Monad m) =>+         Interpret VarDecl (JavaScriptT m) String where+  interpret (VarDecl (Ident (IdentName s)) Nothing) =+    return s+  interpret (VarDecl ident@(Ident (IdentName s)) (Just init)) = do+    lhs <- interpret ident+    rhs <- interpret init+    value <- getValue rhs+    putValue lhs value+    return s++instance (Functor m, Monad m) =>+         Interpret VarDeclNoIn (JavaScriptT m) String where+  interpret (VarDeclNoIn (Ident (IdentName s)) Nothing) =+    return s+  interpret (VarDeclNoIn ident@(Ident (IdentName s)) (Just init)) = do+    lhs <- interpret ident+    rhs <- interpret init+    value <- getValue rhs+    putValue lhs value+    return s++instance (Functor m, Monad m) =>+         Interpret Initialiser (JavaScriptT m) CallValue where+  interpret (Initialiser ae) = interpret ae++instance (Functor m, Monad m) =>+         Interpret InitialiserNoIn (JavaScriptT m) CallValue where+  interpret (InitialiserNoIn ae) = interpret ae++instance (Functor m, Monad m) =>+         Interpret EmptyStmt m Completion where+  interpret EmptyStmt =+    return $+    Completion CompletionTypeNormal Nothing Nothing++instance (Functor m, Monad m) =>+         Interpret ExprStmt (JavaScriptT m) Completion where+  interpret (ExprStmt e) = do+    exprRef <- interpret e+    v <- getValue exprRef+    return $ Completion CompletionTypeNormal (Just v) Nothing++instance (Functor m, Monad m) =>+         Interpret IfStmt (JavaScriptT m) Completion where+  interpret (IfStmtIfElse e s1 s2) = do+    exprRef <- interpret e+    b <- getValue exprRef >>= return . toBoolean+    if b+      then interpret s1+      else interpret s2++  interpret (IfStmtIf e s) = do+    exprRef <- interpret e+    b <- getValue exprRef >>= return . toBoolean+    if b+      then interpret s+      else return $ Completion CompletionTypeNormal Nothing Nothing++instance (Functor m, Monad m) =>+         Interpret ItStmt (JavaScriptT m) Completion where+  interpret (ItStmtDoWhile stmt expr) = doWhile Nothing+    where+      doWhile :: Maybe Value -> JavaScriptT m Completion+      doWhile v = do+        s@(Completion sty sv sta) <- interpret stmt+        let v' = sv <|> v+        ils <- inCurrentLabelSet sta+        if sty /= CompletionTypeContinue ||+           not ils+          then do+          if sty == CompletionTypeBreak &&+             ils+            then return $ Completion CompletionTypeNormal v Nothing+            else+            if sty /= CompletionTypeNormal+            then return s+            else do+              exprRef <- interpret expr+              b <- getValue exprRef >>= return . toBoolean+              if b+                then doWhile v'+                else return $ Completion CompletionTypeNormal v' Nothing+          else do+          exprRef <- interpret expr+          b <- getValue exprRef >>= return . toBoolean+          if b+            then doWhile v'+            else return $ Completion CompletionTypeNormal v' Nothing++  interpret (ItStmtWhile expr stmt) = while Nothing+    where+      while :: Maybe Value -> JavaScriptM Completion+      while v = do+        exprRef <- interpret expr+        b <- getValue exprRef >>= return . toBoolean+        if not b+          then return $ Completion CompletionTypeNormal v Nothing+          else do+          s@(Completion sty sv sta) <- interpret stmt+          let v' = sv <|> v+          ils <- inCurrentLabelSet sta+          if sty /= CompletionTypeContinue ||+             not ils+            then+            if sty == CompletionTypeBreak &&+               ils+            then return $ Completion CompletionTypeNormal v' Nothing+            else+              if sty /= CompletionTypeNormal+              then return s+              else while v'+            else while v'++  interpret (ItStmtFor me1 me2 me3 s) = do+    case me1 of+     Just e1 -> do+       exprRef <- interpret e1+       getValue exprRef+       return ()+     _ -> return ()+    for Nothing+    where+      for :: Maybe Value -> JavaScriptM Completion+      for v = do+        case me2 of+         Just e2 -> do+           testExprRef <- interpret e2+           b <- getValue testExprRef >>= return . toBoolean+           if not b+             then return $ Completion CompletionTypeNormal v Nothing+             else runLoop v+         _ -> runLoop v+      runLoop v = do+        stmt@(Completion sty sv sta) <- interpret s+        let v' = sv <|> v+        ils <- inCurrentLabelSet sta+        if sty == CompletionTypeBreak &&+           ils+          then return $ Completion CompletionTypeNormal v' Nothing+          else+          if (sty /= CompletionTypeContinue ||+              not ils) &&+             sty /= CompletionTypeNormal+          then return stmt+          else do+            case me3 of+             Just e3 -> do+               incExprRef <- interpret e3+               getValue incExprRef+               return ()+             Nothing -> return ()+            for v'++  interpret (ItStmtForVar vdl me2 me3 s) = do+    interpret vdl+    for Nothing+    where+      for :: Maybe Value -> JavaScriptM Completion+      for v = do+        case me2 of+         Just e2 -> do+           testExprRef <- interpret e2+           b <- getValue testExprRef >>= return . toBoolean+           if not b+             then return $ Completion CompletionTypeNormal v Nothing+             else runLoop v+         _ -> runLoop v+      runLoop v = do+        stmt@(Completion sty sv sta) <- interpret s+        let v' = sv <|> v+        ils <- inCurrentLabelSet sta+        if sty == CompletionTypeBreak &&+           ils+          then return $ Completion CompletionTypeNormal v' Nothing+          else+          if (sty /= CompletionTypeContinue ||+              not ils) &&+             sty /= CompletionTypeNormal+          then return stmt+          else do+            case me3 of+             Just e3 -> do+               incExprRef <- interpret e3+               getValue incExprRef+               return ()+             Nothing -> return ()+            for v'++  interpret (ItStmtForIn le e s) = do+    exprRef <- interpret e+    exprValue <- getValue exprRef+    case exprValue of+     ValueNull _ ->+       return $ Completion CompletionTypeNormal Nothing Nothing+     ValueUndefined _ ->+       return $ Completion CompletionTypeNormal Nothing Nothing+     _ -> do+       obj <- toObject exprValue+       ps <- Lens.use $ properties obj+       forIn (Map.toList ps) Nothing+     where+       forIn :: [(String, Property)] -> Maybe Value -> JavaScriptM Completion+       forIn [] v = return $ Completion CompletionTypeNormal v Nothing+       forIn ((p, pr):ps) v =  do+         let enum = case pr of+                  PropertyData (DataDescriptor {..}) ->+                    dataDescriptorEnumerable+                  PropertyAccessor (AccessorDescriptor {..}) ->+                    accessorDescriptorEnumerable+         if enum+           then do+           lhsRef <- interpret le+           putValue lhsRef p+           stmt@(Completion sty sv sta) <- interpret s+           let v' = sv <|> v+           ils <- inCurrentLabelSet sta+           if sty == CompletionTypeBreak &&+              ils+             then return $ Completion CompletionTypeNormal v Nothing+             else+             if (sty /= CompletionTypeContinue ||+                 not ils) &&+                sty /= CompletionTypeNormal+             then return stmt+             else forIn ps v'+           else forIn ps v++  interpret (ItStmtForVarIn vd e s) = do+    varName <- interpret vd+    exprRef <- interpret e+    exprValue <- getValue exprRef+    case exprValue of+     ValueNull _ ->+       return $ Completion CompletionTypeNormal Nothing Nothing+     ValueUndefined _ ->+       return $ Completion CompletionTypeNormal Nothing Nothing+     _ -> do+       obj <- toObject exprValue+       ps <- Lens.use $ properties obj+       forIn (Map.toList ps) varName Nothing+     where+       forIn :: [(String, Property)] -> String -> Maybe Value ->+                JavaScriptM Completion+       forIn [] _ v = return $ Completion CompletionTypeNormal v Nothing+       forIn ((p, pr):ps) varName v =  do+         let enum = case pr of+                  PropertyData (DataDescriptor {..}) ->+                    dataDescriptorEnumerable+                  PropertyAccessor (AccessorDescriptor {..}) ->+                    accessorDescriptorEnumerable+         if enum+           then do+           varRef <- interpret (Ident (IdentName varName))+           putValue varRef p+           stmt@(Completion sty sv sta) <- interpret s+           let v' = sv <|> v+           ils <- inCurrentLabelSet sta+           if sty == CompletionTypeBreak &&+              ils+             then return $ Completion CompletionTypeNormal v Nothing+             else+             if (sty /= CompletionTypeContinue ||+                 not ils) &&+                sty /= CompletionTypeNormal+             then return stmt+             else forIn ps varName v'+           else forIn ps varName v++instance (Functor m, Monad m) =>+         Interpret ContStmt m Completion where+  interpret (ContStmt) =+    return $+    Completion CompletionTypeContinue Nothing Nothing++  interpret (ContStmtLabelled i) =+    return $+    Completion CompletionTypeContinue Nothing (Just i)++instance (Functor m, Monad m) =>+         Interpret BreakStmt m Completion where+  interpret (BreakStmt) =+    return $+    Completion CompletionTypeBreak Nothing Nothing++  interpret (BreakStmtLabelled i) =+    return $+    Completion CompletionTypeBreak Nothing (Just i)++instance (Functor m, Monad m) =>+         Interpret ReturnStmt (JavaScriptT m) Completion where+  interpret (ReturnStmt) = do+    return $ Completion CompletionTypeReturn (inj Undefined) Nothing+  interpret (ReturnStmtExpr e) = do+    exprRef <- interpret e+    v <- getValue exprRef+    return $ Completion CompletionTypeReturn (Just v) Nothing++instance (Functor m, Monad m) =>+         Interpret WithStmt (JavaScriptT m) Completion where+  interpret (WithStmt expr stmt) = do+    val <- interpret expr+    obj <- getValue val >>= toObject+    oldEnv <- Lens.use (contextStack . currentContext . lexicalEnvironment)+    newEnv <- newObjectObjectEnvironment obj (Just oldEnv)+    contextStack . currentContext . lexicalEnvironment .= newEnv+    c <- Except.catchE+         (interpret stmt :: JavaScriptT m Completion)+         (\v -> return $ Completion CompletionTypeThrow (Just v) Nothing)+    contextStack . currentContext . lexicalEnvironment .= oldEnv+    return c++instance (Functor m, Monad m) =>+         Interpret SwitchStmt (JavaScriptT m) Completion where+  interpret (SwitchStmt expr cb) = do+    exprRef <- interpret expr+    v <- getValue exprRef+    r@(Completion rty rv rta) <- interpret1 cb v+    case rty of+     CompletionTypeBreak ->+       if False+       then return $ Completion CompletionTypeNormal rv Nothing+       else return r+     _ -> return r++instance (Functor m, Monad m) =>+         Interpret1 CaseBlock (JavaScriptT m) Value Completion where+  interpret1 (CaseBlock mccs) = \input -> do+    let v = Nothing+    case mccs of+     Nothing -> return $ Completion CompletionTypeNormal v Nothing+     Just ccs -> do+       ecv <- search input ccs v+       case ecv of+        Left c -> return c+        Right (v', mrccs) -> do+          case mrccs of+           Nothing -> return $ Completion CompletionTypeNormal v' Nothing+           Just rccs -> falltrough rccs v'+    where+      search input (CaseClauses c@(CaseClause e msl)) v = do+        clauseSelector <- interpret c+        if input == clauseSelector+          then do+          case msl of+           Just sl -> do+             r@(Completion cty cv cta) <- interpret sl+             if cty /= CompletionTypeNormal+               then return $ Left r+               else return $ Right (cv, Nothing)+           Nothing -> return $ Right (v, Nothing)+          else return $ Left $ Completion CompletionTypeNormal v Nothing+      search input (CaseClausesCons ccs c@(CaseClause e msl)) v = do+        clauseSelector <- interpret c+        if input == clauseSelector+          then do+          case msl of+           Just sl -> do+             r@(Completion cty cv cta) <- interpret sl+             if cty /= CompletionTypeNormal+               then return $ Left r+               else return $ Right (cv, Just ccs)+           Nothing -> return $ Right (v, Just ccs)+          else search input ccs v+      falltrough (CaseClauses c@(CaseClause e msl)) v = do+        case msl of+         Just sl -> do+           r@(Completion cty cv cta) <- interpret sl+           let v' = cv <|> v+           if cty /= CompletionTypeNormal+             then return $ Completion cty v' cta+             else return $ Completion CompletionTypeNormal v' Nothing+         Nothing -> return $ Completion CompletionTypeNormal v Nothing+      falltrough (CaseClausesCons ccs c@(CaseClause e msl)) v = do+        case msl of+         Just sl -> do+           r@(Completion cty cv cta) <- interpret sl+           let v' = cv <|> v+           if cty /= CompletionTypeNormal+             then return $ Completion cty v' cta+             else falltrough ccs v'+         Nothing -> return $ Completion CompletionTypeNormal v Nothing++  interpret1 (CaseBlockDefault mfccs df@(DefaultClause msl) mrccs) = \input -> do+    let v = Nothing+        found = False+    ecvf <- case mfccs of+            Nothing -> return $ Right (v, found)+            Just fccs -> searchFirst input found fccs v+    case ecvf of+     Left c -> return c+     Right (v', found') -> do+       let foundInB = False+       ecvf' <- case (found, mrccs) of+                 (False, _) -> return $ Right (v, foundInB, mrccs)+                 (_, Nothing) -> return $ Right (v, foundInB, mrccs)+                 (_, Just rccs) -> searchSecond input foundInB rccs v'+       case ecvf' of+        Left c -> return c+        Right (v'', foundInB', mrrccs) -> do+          case msl of+           Just sl -> do+             r@(Completion cty cv cta) <- interpret sl+             let v''' = cv <|> v''+             if cty /= CompletionTypeNormal+               then return $ Completion cty v''' cta+               else do+               case mrrccs of+                Just rrccs -> falltrough rrccs v'''+                Nothing -> return $ Completion CompletionTypeNormal v''' Nothing+    where+      searchFirst input found cs@(CaseClauses c@(CaseClause e msl)) v = do+        if not found+          then do+          clauseSelector <- interpret c+          if input == clauseSelector+            then searchFirst input True cs v+            else return $ Right (v, found)+          else do+          case msl of+           Just sl -> do+             r@(Completion cty cv cta) <- interpret sl+             let v' = cv <|> v+             if cty /= CompletionTypeNormal+               then return $ Left $ Completion cty v' cta+               else return $ Right (v', found)+           Nothing -> return $ Right (v, found)+      searchFirst input found cccs@(CaseClausesCons ccs c) v = do+        if not found+          then do+          clauseSelector <- interpret c+          if input == clauseSelector+            then searchFirst input True cccs v+            else return $ Right (v, found)+          else do+          case msl of+           Just sl -> do+             r@(Completion cty cv cta) <- interpret sl+             let v' = cv <|> v+             if cty /= CompletionTypeNormal+               then return $ Left $ Completion cty v' cta+               else searchFirst input found ccs v'+           Nothing -> searchFirst input found ccs v+      searchSecond input foundInB cs@(CaseClauses c@(CaseClause e msl)) v = do+        clauseSelector <- interpret c+        if input == clauseSelector+          then do+          let foundInB' = True+          case msl of+           Just sl -> do+             r@(Completion cty cv cta) <- interpret sl+             let v' = cv <|> v+             if cty /= CompletionTypeNormal+               then return $ Left $ Completion cty v' cta+               else return $ Right (v', foundInB', Nothing)+           Nothing -> return $ Right (v, foundInB', Nothing)+          else return $ Right (v, foundInB, Nothing)+      searchSecond input foundInB (CaseClausesCons ccs c@(CaseClause e msl)) v = do+        clauseSelector <- interpret c+        if input == clauseSelector+          then do+          let foundInB' = True+          case msl of+           Just sl -> do+             r@(Completion cty cv cta) <- interpret sl+             let v' = cv <|> v+             if cty /= CompletionTypeNormal+               then return $ Left $ Completion cty v' cta+               else return $ Right (v', foundInB', Just ccs)+           Nothing -> return $ Right (v, foundInB', Just ccs)+          else searchSecond input foundInB ccs v+      falltrough cs@(CaseClauses c@(CaseClause e msl)) v = do+        case msl of+         Just sl -> do+           r@(Completion cty cv cta) <- interpret sl+           let v' = cv <|> v+           if cty /= CompletionTypeNormal+             then return $ Completion cty v' cta+             else return $ Completion CompletionTypeNormal v' Nothing+         Nothing -> return $ Completion CompletionTypeNormal v Nothing+      falltrough (CaseClausesCons ccs c@(CaseClause e msl)) v = do+        case msl of+         Just sl -> do+           r@(Completion cty cv cta) <- interpret sl+           let v' = cv <|> v+           if cty /= CompletionTypeNormal+             then return $ Completion cty v' cta+             else falltrough ccs v'+         Nothing -> falltrough ccs v++instance (Functor m, Monad m) =>+         Interpret CaseClause (JavaScriptT m) Value where+  interpret (CaseClause expr _) = do+    exprRef <- interpret expr+    getValue exprRef++instance (Functor m, Monad m) =>+         Interpret LabelledStmt (JavaScriptT m) Completion where+  interpret (LabelledStmt ident stmt) = do+    contextStack . currentContext . labels %= (ident:)+    c@(Completion cty cv cta) <- interpret stmt+    contextStack . currentContext . labels %= tailSafe+    if cty == CompletionTypeBreak &&+       cta == Just ident+      then return $ Completion CompletionTypeNormal cv Nothing+      else return c++instance (Functor m, Monad m) =>+         Interpret ThrowStmt (JavaScriptT m) Completion where+  interpret (ThrowStmt expr) = do+    exprRef <- interpret expr+    v <- getValue exprRef+    return $ Completion CompletionTypeThrow (Just v) Nothing++instance (Functor m, Monad m) =>+         Interpret TryStmt (JavaScriptT m) Completion where+  interpret (TryStmtBC block catch) = do+    b@(Completion cty (Just cv) cta) <- interpret block+    if cty /= CompletionTypeThrow+      then return b+      else interpret1 catch cv+  interpret (TryStmtBF block finally) = do+    b@(Completion bcty bcv bcta) <- interpret block+    f@(Completion fcty fcv fcta) <- interpret finally+    if fcty == CompletionTypeNormal+      then return b+      else return f+  interpret (TryStmtBCF block catch finally) = do+    b@(Completion bcty (Just bcv) bcta) <- interpret block+    c <- if bcty == CompletionTypeThrow+      then interpret1 catch bcv+      else return b+    f@(Completion fcty fcv fcta) <- interpret finally+    if fcty == CompletionTypeNormal+      then return c+      else return f++instance (Functor m, Monad m) =>+         Interpret1 Catch (JavaScriptT m) Value Completion where+  interpret1 (Catch (Ident (IdentName ident)) block) = \c -> do+    oldEnv <- Lens.use (contextStack . currentContext . lexicalEnvironment)+    catchEnv <- newDeclarativeEnvironment (Just oldEnv)+    envRec <- Lens.use $ lexicalEnvironmentInternal catchEnv . environmentRecord+    createMutableBinding envRec ident Nothing+    setMutableBinding envRec ident c False+    contextStack . currentContext . lexicalEnvironment .= catchEnv+    b <- interpret block+    contextStack . currentContext . lexicalEnvironment .= oldEnv+    return b++instance (Functor m, Monad m) =>+         Interpret Finally (JavaScriptT m) Completion where+  interpret (Finally block) = interpret block++instance (Functor m, Monad m) =>+         Interpret DbgStmt (JavaScriptT m) Completion where+  interpret (DbgStmt) = return $ Completion CompletionTypeNormal Nothing Nothing++instance (Functor m, Monad m) =>+         Interpret FuncDecl (JavaScriptT m) Object where+  interpret (FuncDecl i mfpl fb) = do+    var <- Lens.use $ contextStack . currentContext . variableEnvironment+    let strict = False+    newFunctionObject mfpl fb var strict++instance (Functor m, Monad m) =>+         Interpret Program (JavaScriptT m) Completion where+  interpret program@(Program mses) = do+    case mses of+     Nothing -> return $ Completion CompletionTypeNormal Nothing Nothing+     Just ses -> do+       enterGlobalContext program+       result <- interpret ses+       popContext+       return result++instance (Functor m, Monad m) =>+         Interpret FuncExpr (JavaScriptT m) Object where+  interpret (FuncExpr Nothing mfpl fb) = do+    lex <- Lens.use $ contextStack . currentContext . lexicalEnvironment+    let strict = False+    newFunctionObject mfpl fb lex strict+  interpret (FuncExpr (Just (Ident (IdentName s))) mfpl fb) = do+    lex <- Lens.use $ contextStack . currentContext . lexicalEnvironment+    funcEnv <- newDeclarativeEnvironment (Just lex)+    envRec <- Lens.use $ lexicalEnvironmentInternal funcEnv . environmentRecord+    decEnvRec <- Lens.use $ environmentRecordInternal envRec .+                 declarativeEnvironmentRecord+    createImmutableBindingDeclarative decEnvRec s+    let strict = False+    closure <- newFunctionObject mfpl fb funcEnv strict+    initializeImmutableBindingDeclarative decEnvRec s (inj closure)+    return closure++instance (Functor m, Monad m) =>+         Interpret FuncBody (JavaScriptT m) Completion where+  interpret (FuncBody Nothing) = return $+    Completion CompletionTypeNormal (Just (inj Undefined)) Nothing+  interpret (FuncBody (Just ses)) = interpret ses++instance (Functor m, Monad m) =>+         Interpret SourceElements (JavaScriptT m) Completion where+  interpret (SourceElementsCons ses se) = do+    headResult@(Completion hcty hcv hcta) <- interpret ses+    if hcty /= CompletionTypeNormal+      then return headResult+      else do+      tailResult@(Completion tcty tcv tcta) <- interpret se+      let v = tcv <|> hcv+      return $ Completion tcty v tcta+  interpret (SourceElements se) = interpret se++instance (Functor m, Monad m) =>+         Interpret SourceElement (JavaScriptT m) Completion where+  interpret (SourceElementStmt s) = interpret s+  interpret (SourceElementFuncDecl fd) =+    return $ Completion CompletionTypeNormal Nothing Nothing++instance (Functor m, Monad m) =>+         Interpret UExpr (JavaScriptT m) CallValue where+  interpret (UExprPostFix pfe) = interpret pfe++  interpret (UExprDelete ue) = do+    (rv :: CallValue) <- interpret ue+    case rv of+     Left ref -> do+       case getBase ref of+        BaseUndefined _ -> do+          if isStrictReference ref+            then newSyntaxErrorObject Nothing >>= jsThrow+            else return $ inj True+        BaseProperty propertyBase -> do+          obj <- toObject $ inj propertyBase+          inj <$> delete obj (getReferencedName ref) (isStrictReference ref)+        BaseEnvironmentRecord environmentRecordBase -> do+           if isStrictReference ref+             then newSyntaxErrorObject Nothing >>= jsThrow+             else do+             inj <$> deleteBinding environmentRecordBase (getReferencedName ref)++  interpret (UExprVoid ue) = do+    expr <- interpret ue+    getValue expr+    return $ inj Undefined++  interpret (UExprTypeOf ue) = do+    vr <- interpret ue+    case vr of+     Left ref -> do+       if isUnresolvableReference ref+         then return $ inj "undefined"+         else do+         val <- getValue ref+         return . inj . show $ typeOf val+     Right val -> do+       return . inj . show $ typeOf val++  interpret (UExprDoublePlus ue) = do+    (expr :: CallValue) <- interpret ue+    case prj expr of+     Just ref -> do+       if isStrictReference ref+         then do+         case prj (getBase ref) of+          Just (er :: EnvironmentRecord) -> do+            let name = getReferencedName ref+            if name == "eval" ||+               name == "arguments"+              then newSyntaxErrorObject Nothing >>= jsThrow+              else return ()+          Nothing -> return ()+         else return ()+     Nothing -> return ()+    v <- getValue expr+    oldValue <- toNumber v+    let newValue = oldValue + (Number 1)+    putValue expr newValue+    return $ inj newValue++  interpret (UExprDoubleMinus ue) = do+    expr <- interpret ue+    case prj expr of+     Just ref -> do+       if isStrictReference ref+         then do+         case prj (getBase ref) of+          Just (er :: EnvironmentRecord) -> do+            let name = getReferencedName ref+            if name == "eval" ||+               name == "arguments"+              then newSyntaxErrorObject Nothing >>= jsThrow+              else return ()+          Nothing -> return ()+         else return ()+     Nothing -> return ()+    v <- getValue expr+    oldValue <- toNumber v+    let newValue = oldValue - (Number 1)+    putValue expr newValue+    return $ inj newValue++  interpret (UExprUnaryPlus ue) = do+    expr <- interpret ue+    v <- getValue expr+    inj <$> toNumber v++  interpret (UExprUnaryMinus ue) = do+    expr <- interpret ue+    v <- getValue expr+    oldValue <- toNumber v+    return $ inj (-oldValue)++  interpret (UExprBitNot ue) = do+    expr <- interpret ue+    v <- getValue expr+    oldValue <- toInt32 v+    return $ inj $ Number (fromIntegral $ complement oldValue)++  interpret (UExprNot ue) = do+    expr <- interpret ue+    v <- getValue expr+    let oldValue = toBoolean v+    return $ inj $ not oldValue++instance (Functor m, Monad m) =>+         Interpret MemberExpr (JavaScriptT m) CallValue where+  interpret (MemberExprPrim pe) = do+    v <- interpret pe+    return $ inj v++  interpret (MemberExprFunc fe) = do+    (o :: Object) <- interpret fe+    return $ inj o++  interpret (MemberExprArray me expr) = do+    baseReference <- interpret me+    baseValue <- getValue baseReference+    propertyNameReference <- interpret expr+    propertyNameValue <- getValue propertyNameReference+    baseValueCoercible <- toObjectCoercible baseValue+    propertyNameString <- toString propertyNameValue+    let strict = False+    return $ inj $ Reference (inj baseValueCoercible) propertyNameString strict++  interpret (MemberExprDot me (IdentName s)) = do+    baseReference <- interpret me+    baseValue <- getValue baseReference+    baseValueCoercible <- toObjectCoercible baseValue+    let strict = False+    return $ inj $ Reference (inj baseValueCoercible) s strict++  interpret (MemberExprNew me args) = do+    ref <- interpret me+    constructor <- getValue ref+    argList <- interpret args+    case constructor of+     ValueObject o -> do+       inj <$> construct o argList+     _ -> newTypeErrorObject Nothing >>= jsThrow++instance (Functor m, Monad m) =>+         Interpret NewExpr (JavaScriptT m) CallValue where+  interpret (NewExprMember me) = interpret me+  interpret (NewExprNew ne) = do+    ref <- interpret ne+    constructor <- getValue ref+    case constructor of+     ValueObject o -> do+       inj <$> construct o (List [])+     _ -> newTypeErrorObject Nothing >>= jsThrow+++instance (Functor m, Monad m) =>+         Interpret CallExpr (JavaScriptT m) CallValue where+  interpret (CallExprMember me args) = do+    rv <- interpret me+    func <- getValue rv+    argList <- interpret args+    case func of+     ValueObject o -> do+       thisValue <-+         case rv of+          Left ref -> do+            case toPropertyReference ref of+              Right propertyBase -> return $ inj propertyBase+              Left (Left er) -> do+                implicitThisValue er+          _ -> return $ inj Undefined+       call o thisValue argList+     _ -> newTypeErrorObject Nothing >>= jsThrow++  interpret (CallExprCall ce args) = do+    rv <- interpret ce+    func <- getValue rv+    argList <- interpret args+    case func of+     ValueObject o -> do+       thisValue <-+         case rv of+          Left ref -> do+            case toPropertyReference ref of+              Right propertyBase -> return $ inj propertyBase+              Left (Left er) -> do+                implicitThisValue er+          _ -> return $ inj Undefined+       call o thisValue argList+     _ -> newTypeErrorObject Nothing >>= jsThrow++  interpret (CallExprArray ce expr) = do+    baseReference <- interpret ce+    baseValue <- getValue baseReference+    propertyNameReference <- interpret expr+    propertyNameValue <- getValue propertyNameReference+    baseValueCoercible <- toObjectCoercible baseValue+    propertyNameString <- toString propertyNameValue+    let strict = False+    return $ inj $ Reference (inj baseValueCoercible) propertyNameString strict++  interpret (CallExprDot ce (IdentName s)) = do+    baseReference <- interpret ce+    baseValue <- getValue baseReference+    baseValueCoercible <- toObjectCoercible baseValue+    let strict = False+    return $ inj $ Reference (inj baseValueCoercible) s strict++instance (Functor m, Monad m) =>+         Interpret Arguments (JavaScriptT m) (List Value) where+  interpret (ArgumentsEmpty) = return (List [])+  interpret (Arguments al) = interpret al++instance (Functor m, Monad m) =>+         Interpret ArgumentList (JavaScriptT m) (List Value) where+  interpret (ArgumentList ae) = do+    ref <- interpret ae+    arg <- getValue ref+    return $ List [arg]++  interpret (ArgumentListCons al ae) = do+    List precedingArgs <- interpret al+    ref <- interpret ae+    arg <- getValue ref+    return $ List (precedingArgs ++ [arg])++instance (Functor m, Monad m) =>+         Interpret LeftExpr (JavaScriptT m) CallValue where+  interpret (LeftExprNewExpr ne) = do+    v <- interpret ne+    return $ inj v+  interpret (LeftExprCallExpr ce) = interpret ce++instance (Functor m, Monad m) =>+         Interpret PostFixExpr (JavaScriptT m) CallValue where+  interpret (PostFixExprLeftExpr le) = interpret le++  interpret (PostFixExprPostInc le) = do+    lhs <- interpret le+    case lhs of+     CallValueReference ref ->+       when (isStrictReference ref) $ do+         case getBase ref of+          BaseEnvironmentRecord _ -> do+            let name = getReferencedName ref+            when (name == "eval" || name == "arguments") $+              newSyntaxErrorObject Nothing >>= jsThrow+          _ -> return ()+     _ -> return ()+    oldValue <- getValue lhs >>= toNumber+    let newValue = oldValue + (Number 1)+    putValue lhs newValue+    return (inj oldValue)++  interpret (PostFixExprPostDec le) = do+    lhs <- interpret le+    case lhs of+     CallValueReference ref ->+       when (isStrictReference ref) $ do+         case getBase ref of+          BaseEnvironmentRecord _ -> do+            let name = getReferencedName ref+            when (name == "eval" || name == "arguments") $+              newSyntaxErrorObject Nothing >>= jsThrow+          _ -> return ()+     _ -> return ()+    oldValue <- getValue lhs >>= toNumber+    let newValue = oldValue - (Number 1)+    putValue lhs newValue+    return (inj oldValue)++instance (Functor m, Monad m) =>+         Interpret MultExpr (JavaScriptT m) CallValue where+  interpret (MultExpr ue) = interpret ue++  interpret (MultExprMult me ue) = do+    left <- interpret me+    right <- interpret ue+    inj <$> left `operatorMult` right++  interpret (MultExprDiv me ue) = do+    left <- interpret me+    right <- interpret ue+    inj <$> left `operatorDiv` right++  interpret (MultExprMod me ue) = do+    left <- interpret me+    right <- interpret ue+    inj <$> left `operatorMod` right++instance (Functor m, Monad m) =>+         Interpret AddExpr (JavaScriptT m) CallValue where+  interpret (AddExpr me) = interpret me++  interpret (AddExprAdd ae me) = do+    lref <- interpret ae+    rref <- interpret me+    inj <$> lref `operatorPlus` rref++  interpret (AddExprSub ae me) = do+    lref <- interpret ae+    rref <- interpret me+    inj <$> lref `operatorMinus` rref++instance (Functor m, Monad m) =>+         Interpret ShiftExpr (JavaScriptT m) CallValue where+  interpret (ShiftExpr ae) = interpret ae+  interpret (ShiftExprLeft se ae) = do+    lref <- interpret se+    rref <- interpret ae+    inj <$> lref `operatorLeftShift` rref++  interpret (ShiftExprRight se ae) = do+    lref <- interpret se+    rref <- interpret ae+    inj <$> lref `operatorSignedRightShift` rref++  interpret (ShiftExprRightZero se ae) = do+    lref <- interpret se+    rref <- interpret ae+    inj <$> lref `operatorUnsignedRightShift` rref++instance (Functor m, Monad m) =>+         Interpret RelExpr (JavaScriptT m) CallValue where+  interpret (RelExpr se) = interpret se++  interpret (RelExprLess re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess lval rval True+    case mr of+     JSNothing -> return $ inj False+     JSJust r -> return $ inj r++  interpret (RelExprGreater re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess rval lval False+    case mr of+     JSNothing -> return $ inj False+     JSJust r -> return $ inj r++  interpret (RelExprLessEq re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess rval lval False+    case mr of+     JSNothing -> return $ inj False+     JSJust _ -> return $ inj True++  interpret (RelExprGreaterEq re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess lval rval True+    case mr of+     JSNothing -> return $ inj False+     JSJust True -> return $ inj False+     JSJust False -> return $ inj True++  interpret (RelExprInstanceOf re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    case rval of+     ValueObject o -> do+       inj <$> hasInstance o lval+     _ -> newTypeErrorObject Nothing >>= jsThrow++  interpret (RelExprIn re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    case prj rval of+     Nothing -> newTypeErrorObject Nothing >>= jsThrow+     Just obj -> do+       s <- toString lval+       inj <$> hasProperty obj s++instance (Functor m, Monad m) =>+         Interpret RelExprNoIn (JavaScriptT m) CallValue where+  interpret (RelExprNoIn se) = interpret se+  interpret (RelExprNoInLess re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess lval rval True+    case mr of+     JSNothing -> return $ inj False+     JSJust r -> return $ inj r++  interpret (RelExprNoInGreater re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess rval lval False+    case mr of+     JSNothing -> return $ inj False+     JSJust r -> return $ inj r++  interpret (RelExprNoInLessEq re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess rval lval False+    case mr of+     JSNothing -> return $ inj False+     JSJust _ -> return $ inj True++  interpret (RelExprNoInGreaterEq re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    mr <- compareLess lval rval True+    case mr of+     JSNothing -> return $ inj False+     JSJust True -> return $ inj False+     JSJust False -> return $ inj True++  interpret (RelExprNoInInstanceOf re se) = do+    lref <- interpret re+    lval <- getValue lref+    rref <- interpret se+    rval <- getValue rref+    case rval of+     ValueObject obj ->+       inj <$> hasInstance obj lval+     _ -> newTypeErrorObject Nothing >>= jsThrow++instance (Functor m, Monad m) =>+         Interpret EqExpr (JavaScriptT m) CallValue where+  interpret (EqExpr re) = interpret re++  interpret (EqExprEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    inj <$> compare rval lval++  interpret (EqExprNotEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    r <- compare rval lval+    return $ inj $ not r++  interpret (EqExprStrictEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    return $ inj $ compareStrict rval lval++  interpret (EqExprStrictNotEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    return $ inj $ not $ compareStrict rval lval++instance (Functor m, Monad m) =>+         Interpret EqExprNoIn (JavaScriptT m) CallValue where+  interpret (EqExprNoIn re) = interpret re++  interpret (EqExprNoInEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    inj <$> compare rval lval++  interpret (EqExprNoInNotEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    r <- compare rval lval+    return $ inj $ not r++  interpret (EqExprNoInStrictEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    return $ inj $ compareStrict rval lval++  interpret (EqExprNoInStrictNotEq eq re) = do+    lref <- interpret eq+    lval <- getValue lref+    rref <- interpret re+    rval <- getValue rref+    return $ inj $ not $ compareStrict rval lval++instance (Functor m, Monad m) =>+         Interpret BitAndExpr (JavaScriptT m) CallValue where+  interpret (BitAndExpr eq) = interpret eq++  interpret (BitAndExprAnd bae eq) = do+    lref <- interpret bae+    rref <- interpret eq+    inj <$> lref `operatorBitwiseAnd` rref++instance (Functor m, Monad m) =>+         Interpret BitAndExprNoIn (JavaScriptT m) CallValue where+  interpret (BitAndExprNoIn eq) = interpret eq++  interpret (BitAndExprNoInAnd bae eq) = do+    lref <- interpret bae+    rref <- interpret eq+    inj <$> lref `operatorBitwiseAnd` rref++instance (Functor m, Monad m) =>+         Interpret BitXorExpr (JavaScriptT m) CallValue where+  interpret (BitXorExpr eq) = interpret eq++  interpret (BitXorExprXor bae eq) = do+    lref <- interpret bae+    rref <- interpret eq+    inj <$> lref `operatorBitwiseXor` rref++instance (Functor m, Monad m) =>+         Interpret BitXorExprNoIn (JavaScriptT m) CallValue where+  interpret (BitXorExprNoIn eq) = interpret eq++  interpret (BitXorExprNoInXor bae eq) = do+    lref <- interpret bae+    rref <- interpret eq+    inj <$> lref `operatorBitwiseXor` rref++instance (Functor m, Monad m) =>+         Interpret BitOrExpr (JavaScriptT m) CallValue where+  interpret (BitOrExpr eq) = interpret eq++  interpret (BitOrExprOr bae eq) = do+    lref <- interpret bae+    rref <- interpret eq+    inj <$> lref `operatorBitwiseOr` rref++instance (Functor m, Monad m) =>+         Interpret BitOrExprNoIn (JavaScriptT m) CallValue where+  interpret (BitOrExprNoIn eq) = interpret eq++  interpret (BitOrExprNoInOr bae eq) = do+    lref <- interpret bae+    rref <- interpret eq+    inj <$> lref `operatorBitwiseOr` rref++instance (Functor m, Monad m) =>+         Interpret LogicalAndExpr (JavaScriptT m) CallValue where+  interpret (LogicalAndExpr boe) = interpret boe++  interpret (LogicalAndExprAnd lae boe) = do+    lref <- interpret lae+    lval <- getValue lref+    if not $ toBoolean lval+      then return $ inj lval+      else do+      rref <- interpret boe+      inj <$> getValue rref++instance (Functor m, Monad m) =>+         Interpret LogicalAndExprNoIn (JavaScriptT m) CallValue where+  interpret (LogicalAndExprNoIn boe) = do+    n <- interpret boe+    return $ inj n++  interpret (LogicalAndExprNoInAnd lae boe) = do+    lref <- interpret lae+    lval <- getValue lref+    if not $ toBoolean lval+      then return $ inj lval+      else do+      rref <- interpret boe+      inj <$> getValue rref++instance (Functor m, Monad m) =>+         Interpret LogicalOrExpr (JavaScriptT m) CallValue where+  interpret (LogicalOrExpr boe) = interpret boe++  interpret (LogicalOrExprOr lae boe) = do+    lref <- interpret lae+    lval <- getValue lref+    if not $ toBoolean lval+      then return $ inj lval+      else do+      rref <- interpret boe+      inj <$> getValue rref++instance (Functor m, Monad m) =>+         Interpret LogicalOrExprNoIn (JavaScriptT m) CallValue where+  interpret (LogicalOrExprNoIn boe) = interpret boe++  interpret (LogicalOrExprNoInOr lae boe) = do+    lref <- interpret lae+    lval <- getValue lref+    if toBoolean lval+      then return $ inj lval+      else do+      rref <- interpret boe+      inj <$> getValue rref++instance (Functor m, Monad m) =>+         Interpret CondExpr (JavaScriptT m) CallValue where+  interpret (CondExpr loe) = interpret loe++  interpret (CondExprIf loe ae1 ae2) = do+    lref <- interpret loe+    lval <- getValue lref+    if toBoolean lval+      then do+      trueRef <- interpret ae1+      inj <$> getValue trueRef+      else do+      falseRef <- interpret ae2+      inj <$> getValue falseRef++instance (Functor m, Monad m) =>+         Interpret CondExprNoIn (JavaScriptT m) CallValue where+  interpret (CondExprNoIn loe) = interpret loe++  interpret (CondExprNoInIf loe ae1 ae2) = do+    lref <- interpret loe+    lval <- getValue lref+    if toBoolean lval+      then do+      trueRef <- interpret ae1+      inj <$> getValue trueRef+      else do+      falseRef <- interpret ae2+      inj <$> getValue falseRef++instance (Functor m, Monad m) =>+         Interpret AssignExpr (JavaScriptT m) CallValue where+  interpret (AssignExprCondExpr ce) = interpret ce++  interpret (AssignExprAssign le AssignOpNormal ae) = do+    lref <- interpret le+    rref <- interpret ae+    rval <- getValue rref+    case lref of+     CallValueReference ref -> do+       when (isStrictReference ref &&+             typeOf (getBase ref) == TypeEnvironmentRecord &&+             (getReferencedName ref == "eval" ||+              getReferencedName ref == "arguments")) $ do+         newSyntaxErrorObject Nothing >>= jsThrow+     _ -> return ()+    putValue lref rval+    return $ inj rval++  interpret (AssignExprAssign le aop ae) = do+    lref <- interpret le+    lval <- getValue lref+    rref <- interpret ae+    rval <- getValue rref+    r <- case aop of+          AssignOpMult -> inj <$> lval `operatorMult` rval+          AssignOpDiv -> inj <$> lval `operatorDiv` rval+          AssignOpMod -> inj <$> lval `operatorMod` rval+          AssignOpPlus -> lval `operatorPlus` rval+          AssignOpMinus -> inj <$> lval `operatorMinus` rval+          AssignOpShiftLeft -> inj <$> lval `operatorLeftShift` rval+          AssignOpShiftRight -> inj <$> lval `operatorSignedRightShift` rval+          AssignOpShiftRightZero -> inj <$> lval `operatorUnsignedRightShift` rval+          AssignOpBitAnd -> inj <$> lval `operatorBitwiseAnd` rval+          AssignOpBitXor -> inj <$> lval `operatorBitwiseXor` rval+          AssignOpBitOr -> inj <$> lval `operatorBitwiseOr` rval+    case lref of+     CallValueReference ref -> do+       when (isStrictReference ref &&+             typeOf (getBase ref) == TypeEnvironmentRecord &&+             (getReferencedName ref == "eval" ||+              getReferencedName ref == "arguments")) $ do+         newSyntaxErrorObject Nothing >>= jsThrow+     _ -> return ()+    putValue lref r+    return $ inj r++instance (Functor m, Monad m) =>+         Interpret AssignExprNoIn (JavaScriptT m) CallValue where+  interpret (AssignExprNoInCondExpr ce) = interpret ce++  interpret (AssignExprNoInAssign le AssignOpNormal ae) = do+    lref <- interpret le+    rref <- interpret ae+    rval <- getValue rref+    case prj lref of+     Just ref -> do+       when (isStrictReference ref &&+             typeOf (getBase ref) == TypeEnvironmentRecord &&+             (getReferencedName ref == "eval" ||+              getReferencedName ref == "arguments")) $ do+         newSyntaxErrorObject Nothing >>= jsThrow+     Nothing -> return ()+    putValue lref rval+    return $ inj rval++  interpret (AssignExprNoInAssign le aop ae) = do+    lref <- interpret le+    lval <- getValue lref+    rref <- interpret ae+    rval <- getValue rref+    r <- case aop of+          AssignOpMult -> inj <$> lval `operatorMult` rval+          AssignOpDiv -> inj <$> lval `operatorDiv` rval+          AssignOpMod -> inj <$> lval `operatorMod` rval+          AssignOpPlus -> lval `operatorPlus` rval+          AssignOpMinus -> inj <$> lval `operatorMinus` rval+          AssignOpShiftLeft -> inj <$> lval `operatorLeftShift` rval+          AssignOpShiftRight -> inj <$> lval `operatorSignedRightShift` rval+          AssignOpShiftRightZero -> inj <$> lval `operatorUnsignedRightShift` rval+          AssignOpBitAnd -> inj <$> lval `operatorBitwiseAnd` rval+          AssignOpBitXor -> inj <$> lval `operatorBitwiseXor` rval+          AssignOpBitOr -> inj <$> lval `operatorBitwiseOr` rval+    case prj lref of+     Just ref -> do+       when (isStrictReference ref &&+             typeOf (getBase ref) == TypeEnvironmentRecord &&+             (getReferencedName ref == "eval" ||+              getReferencedName ref == "arguments")) $ do+         newSyntaxErrorObject Nothing >>= jsThrow+     Nothing -> return ()+    putValue lref r+    return $ inj r++instance (Functor m, Monad m) =>+         Interpret Expr (JavaScriptT m) CallValue where+  interpret (Expr ae) = interpret ae++  interpret (ExprCons e ae) = do+    lref <- interpret e+    getValue lref+    rref <- interpret ae+    inj <$> getValue rref++instance (Functor m, Monad m) =>+         Interpret ExprNoIn (JavaScriptT m) CallValue where+  interpret (ExprNoIn ae) = interpret ae++  interpret (ExprNoInCons e ae) = do+    lref <- interpret e+    getValue lref+    rref <- interpret ae+    inj <$> getValue rref++instance (Functor m, Monad m) =>+         Interpret Ident (JavaScriptT m) Reference where+  interpret (Ident (IdentName s)) = do+    env <- Lens.use $ contextStack . currentContext . lexicalEnvironment+    let strict = False+    getIdentifierReference (Just env) s strict++declarationBindingInstantiation :: (Functor m, Monad m) =>+                                   Code -> JavaScriptT m ()+declarationBindingInstantiation c = do+  let strict = False+      configurableBindings =+        case c of+         CodeEval {} -> True+         _ -> False++  case c of+   CodeFunction func args -> do+     (FuncBody mses) <- code func+     (lex, env) <- step1+     dec <- Lens.use $ environmentRecordInternal env . declarativeEnvironmentRecord+     names <- step2 strict dec func args+     case mses of+      Just ses -> do+        step3 strict configurableBindings env ses+        argumentsAlreadyDeclared <- step4 env+        when (not argumentsAlreadyDeclared) $ do+          step5 strict lex dec func names args+        step6 strict configurableBindings env ses+        return ()+      Nothing -> do+        argumentsAlreadyDeclared <- step4 env+        when (not argumentsAlreadyDeclared) $ do+          step5 strict lex dec func names args+        return ()+   CodeGlobal (Program mses) -> do+     (lex, env) <- step1+     case mses of+      Just ses -> do+        step3 strict configurableBindings env ses+        step4 env+        step6 strict configurableBindings env ses+        return ()+      Nothing -> do+        step4 env+        return ()+  where+    step1 :: (Functor m, Monad m) =>+             JavaScriptT m (LexicalEnvironment, EnvironmentRecord)+    step1 = do+      var <- Lens.use $ contextStack . currentContext . variableEnvironment+      env <- Lens.use $ lexicalEnvironmentInternal var . environmentRecord+      return (var, env)++    step2 :: (Functor m, Monad m) =>+             Bool -> DeclarativeEnvironmentRecord -> Object -> List Value ->+             JavaScriptT m (List String)+    step2 strict env func args@(List as) = do+      names@(List ns) <- formalParameters func+      let argCount = length as+          n = 0+      (flip . flip foldlM) n ns $ \n argName -> do+        let n' = n+1+            v = if n' > argCount+                then inj Undefined+                else as !! (n' - 1)+        argAlreadyDeclared <- hasBindingDeclarative env argName+        when (not argAlreadyDeclared) $ do+          createMutableBindingDeclarative env argName Nothing+        setMutableBindingDeclarative env argName v strict+        return n'+      return names++    step3 :: (Functor m, Monad m) =>+             Bool -> Bool -> EnvironmentRecord -> SourceElements ->+             JavaScriptT m ()+    step3 strict configurableBindings env ses = do+      forM (extractFuncDecls ses) $+        \f@(FuncDecl (Ident (IdentName fn)) mfpl fb) -> do+          fo <- interpret f+          funcAlreadyDeclared <- hasBinding env fn+          if (not funcAlreadyDeclared)+            then createMutableBinding env fn (Just configurableBindings)+            else do+            if False+              then return ()+              else return ()+          setMutableBinding env fn (inj fo) strict+      return ()++    step4 :: (Functor m, Monad m) =>+             EnvironmentRecord -> JavaScriptT m Bool+    step4 env = do+      argumentsAlreadyDeclared <- hasBinding env "arguments"+      return argumentsAlreadyDeclared++    step5 :: (Functor m, Monad m) =>+             Bool -> LexicalEnvironment -> DeclarativeEnvironmentRecord ->+             Object -> List String -> List Value -> JavaScriptT m ()+    step5 strict lex env func names args@(List as) = do+      argsObj <- createArgumentsObject+                 func names args lex strict+      if strict+        then do+        createImmutableBindingDeclarative env "arguments"+        initializeImmutableBindingDeclarative env "arguments" (inj argsObj)+        return ()+        else do+        createMutableBindingDeclarative env "arguments" Nothing+        setMutableBindingDeclarative env "arguments" (inj argsObj) False++    step6 :: (Functor m, Monad m) =>+             Bool -> Bool -> EnvironmentRecord -> SourceElements ->+             JavaScriptT m ()+    step6 strict configurableBindings env ses = do+      forM (extractVarDeclIdents ses) $ \(Ident (IdentName dn)) -> do+        varAlreadyDeclared <- hasBinding env dn+        when (not varAlreadyDeclared) $ do+          createMutableBinding env dn (Just configurableBindings)+          setMutableBinding env dn (inj Undefined) strict+      return ()++    extractFuncDecls :: SourceElements -> [FuncDecl]+    extractFuncDecls (SourceElements (SourceElementFuncDecl fd)) = [fd]+    extractFuncDecls (SourceElements _) = []+    extractFuncDecls (SourceElementsCons ses (SourceElementFuncDecl fd)) =+      fd:(extractFuncDecls ses)+    extractFuncDecls (SourceElementsCons ses _) =+      extractFuncDecls ses++    extractVarDeclIdents :: SourceElements -> [Ident]+    extractVarDeclIdents (SourceElementsCons ses se) =+      extractVarDeclIdentsSE se ++ extractVarDeclIdents ses+    extractVarDeclIdents (SourceElements se) =+      extractVarDeclIdentsSE se+    extractVarDeclIdentsSE (SourceElementStmt s) =+      extractVarDeclIdentsS s+    extractVarDeclIdentsSE _ = []+    extractVarDeclIdentsS (StmtVar vs) =+      extractVarDeclIdentsVS vs+    extractVarDeclIdentsS _ = []+    extractVarDeclIdentsVS (VarStmt vdl) =+      extractVarDeclIdentsVDL vdl+    extractVarDeclIdentsVDL (VarDeclList vd) =+      extractVarDeclIdentsVD vd+    extractVarDeclIdentsVDL (VarDeclListCons vdl vd) =+      extractVarDeclIdentsVD vd ++ extractVarDeclIdentsVDL vdl+    extractVarDeclIdentsVD (VarDecl i _) = [i]+++type UInt16 = Word16+type UInt32 = Word32++data Context+  = Context+    { contextLexicalEnvironment  :: LexicalEnvironment+    , contextVariableEnvironment :: LexicalEnvironment+    , contextThisBinding         :: Value+    , contextLabels              :: [Ident] }+  deriving (Show)++lexicalEnvironment :: Lens' Context LexicalEnvironment+lexicalEnvironment =+  Lens.lens+  contextLexicalEnvironment+  (\c le -> c { contextLexicalEnvironment = le })++variableEnvironment :: Lens' Context LexicalEnvironment+variableEnvironment =+  Lens.lens+  contextVariableEnvironment+  (\c ve -> c { contextVariableEnvironment = ve })++thisBinding :: Lens' Context Value+thisBinding =+  Lens.lens+  contextThisBinding+  (\c t -> c { contextThisBinding = t })++labels :: Lens' Context [Ident]+labels = Lens.lens contextLabels (\c ls -> c { contextLabels = ls })++inCurrentLabelSet :: Maybe Ident -> JavaScriptM Bool+inCurrentLabelSet mi = do+  case mi of+   Just i -> do+     ls <- Lens.use $ contextStack . currentContext . labels+     return (i `elem` ls)+   _ -> return True++data ContextStack+  = ContextStack+    { contextStackCurrent :: Context+    , contextStackStack   :: [Context] }+  deriving (Show)++currentContext :: Lens' ContextStack Context+currentContext =+  Lens.lens+  contextStackCurrent+  (\cs c -> cs { contextStackCurrent = c })++type EnvironmentRecordHeap+  = Map EnvironmentRecord EnvironmentRecordInternal++type DeclarativeEnvironmentRecordHeap+  = Map DeclarativeEnvironmentRecord DeclarativeEnvironmentRecordInternal++type LexicalEnvironmentHeap+  = Map LexicalEnvironment LexicalEnvironmentInternal++type ObjectHeap m = Map Object (ObjectInternal m)++data JavaScriptState m+  = JavaScriptState+    { javaScriptStateContextStack                     :: ContextStack+    , javaScriptStateNextInternalId                   :: InternalId+    , javaScriptStateEnvironmentRecordHeap            :: EnvironmentRecordHeap+    , javaScriptStateDeclarativeEnvironmentRecordHeap :: DeclarativeEnvironmentRecordHeap+    , javaScriptStateLexicalEnvironmentHeap           :: LexicalEnvironmentHeap+    , javaScriptStateObjectHeap                       :: ObjectHeap m+    , javaScriptStateGlobalLexicalEnvironment         :: LexicalEnvironment+    , javaScriptStateGlobalObject                     :: Object+    , javaScriptStateArrayPrototypeObject             :: Object+    , javaScriptStateBooleanPrototypeObject           :: Object+    , javaScriptStateDatePrototypeObject              :: Object+    , javaScriptStateErrorPrototypeObject             :: Object+    , javaScriptStateEvalErrorPrototypeObject         :: Object+    , javaScriptStateRangeErrorPrototypeObject        :: Object+    , javaScriptStateReferenceErrorPrototypeObject    :: Object+    , javaScriptStateSyntaxErrorPrototypeObject       :: Object+    , javaScriptStateTypeErrorPrototypeObject         :: Object+    , javaScriptStateURIErrorPrototypeObject          :: Object+    , javaScriptStateFunctionPrototypeObject          :: Object+    , javaScriptStateNumberPrototypeObject            :: Object+    , javaScriptStateObjectPrototypeObject            :: Object+    , javaScriptStateRegExpPrototypeObject            :: Object+    , javaScriptStateStringPrototypeObject            :: Object+    , javaScriptStateThrowTypeErrorObject             :: Object }++initialState :: (Functor m, Monad m) => JavaScriptState m+initialState =+  let ctx = Context {+        contextLexicalEnvironment  = error "Unitialised lexical environment",+        contextVariableEnvironment = error "Unitialised variable environment",+        contextThisBinding         = error "Unitialised this binding",+        contextLabels              = [] }++      ctxs = ContextStack {+        contextStackCurrent = ctx,+        contextStackStack   = [] }++      environmentRecordHeap =+        Map.fromList+        [ (globalEnvironmentRecord, globalEnvironmentRecordInternal) ]++      declarativeEnvironmentRecordHeap =+        Map.empty++      lexicalEnvironmentHeap =+        Map.fromList+        [ (globalLexicalEnvironment, globalLexicalEnvironmentInternal) ]++      objectHeap =+        Map.fromList+        [ (globalObject, globalObjectInternal)+        , (arrayPrototypeObject, arrayPrototypeObjectInternal)+        , (booleanPrototypeObject, booleanPrototypeObjectInternal)+        , (datePrototypeObject, datePrototypeObjectInternal)+        , (errorPrototypeObject, errorPrototypeObjectInternal)+        , (errorPrototypeToString, errorPrototypeToStringInternal)+        , (evalErrorPrototypeObject, evalErrorPrototypeObjectInternal)+        , (rangeErrorPrototypeObject, rangeErrorPrototypeObjectInternal)+        , (referenceErrorPrototypeObject, referenceErrorPrototypeObjectInternal)+        , (syntaxErrorPrototypeObject, syntaxErrorPrototypeObjectInternal)+        , (typeErrorPrototypeObject, typeErrorPrototypeObjectInternal)+        , (uriErrorPrototypeObject, uriErrorPrototypeObjectInternal)+        , (functionPrototypeObject, functionPrototypeObjectInternal)+        , (numberPrototypeObject, numberPrototypeObjectInternal)+        , (objectPrototypeObject, objectPrototypeObjectInternal)+        , (regExpPrototypeObject, regExpPrototypeObjectInternal)+        , (stringPrototypeObject, stringPrototypeObjectInternal)+        , (throwTypeErrorObject, throwTypeErrorObjectInternal)+        , (objectConstructor, objectConstructorInternal)+        , (functionConstructor, functionConstructorInternal)+        , (arrayConstructor, arrayConstructorInternal)+        , (stringConstructor, stringConstructorInternal)+        , (booleanConstructor, booleanConstructorInternal)+        , (numberConstructor, numberConstructorInternal)+        , (dateConstructor, dateConstructorInternal)+        , (regExpConstructor, regExpConstructorInternal)+        , (errorConstructor, errorConstructorInternal)+        , (evalErrorConstructor, evalErrorConstructorInternal)+        , (rangeErrorConstructor, rangeErrorConstructorInternal)+        , (referenceErrorConstructor, referenceErrorConstructorInternal)+        , (syntaxErrorConstructor, syntaxErrorConstructorInternal)+        , (typeErrorConstructor, typeErrorConstructorInternal)+        , (uriErrorConstructor, uriErrorConstructorInternal)+        , (mathObject, mathObjectInternal)+        , (jsonObject, jsonObjectInternal) ]++      globalLexicalEnvironmentInternal =+        LexicalEnvironmentInternal globalEnvironmentRecord Nothing+      globalLexicalEnvironment = LexicalEnvironment 0++      globalEnvironmentRecordInternal =+        EnvironmentRecordInternalObject+        (ObjectEnvironmentRecord globalObject True)+      globalEnvironmentRecord = EnvironmentRecord 1++      globalObject = Object 2+      globalObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      globalObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("NaN", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj nan,+                 dataDescriptorWritable       = False,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = False })+           , ("Infinity", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj posInf,+                 dataDescriptorWritable       = False,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = False })+           , ("undefined", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj Undefined,+                 dataDescriptorWritable       = False,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = False })+           , ("eval", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalEval,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("parseInt", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalParseInt,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("parseFloat", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalParseFloat,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("isNaN", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalIsNaN,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("isFinite", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalIsFinite,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("decodeURI", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalDecodeURI,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("decodeURIComponent", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalDecodeURIComponent,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("encodeURI", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalEncodeURI,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("encodeURIComponent", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj globalEncodeURIComponent,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Object", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj objectConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Function", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj functionConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Array", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj arrayConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("String", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj stringConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Boolean", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj booleanConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Number", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj numberConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Date", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj dateConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("RegExp", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj regExpConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Error", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj errorConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("EvalError", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj evalErrorConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("RangeError", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj rangeErrorConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("ReferenceError", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj referenceErrorConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("SyntaxError", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj syntaxErrorConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("TypeError", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj typeErrorConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("URIError", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj uriErrorConstructor,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("Math", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj mathObject,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True })+           , ("JSON", PropertyData $ DataDescriptor {+                 dataDescriptorValue          = inj jsonObject,+                 dataDescriptorWritable       = True,+                 dataDescriptorEnumerable     = False,+                 dataDescriptorConfigurable   = True }) ],+        objectInternalPrototype         = const $ return JSNull,+        objectInternalClass             = "Object",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      globalEval = error "globalEval" :: Object+      globalParseInt = error "globalParseInt" :: Object+      globalParseFloat = error "globalParseFloat" :: Object+      globalIsNaN = error "globalIsNaN" :: Object+      globalIsFinite = error "globalIsFinite" :: Object+      globalDecodeURI = error "globalDecodeURI" :: Object+      globalDecodeURIComponent = error "globalDecodeURIComponent" :: Object+      globalEncodeURI = error "globalEncodeURI" :: Object+      globalEncodeURIComponent = error "globalEncodeURIComponent" :: Object++      arrayPrototypeObject = Object 3+      arrayPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ def {+                 dataDescriptorValue = inj $ Number 0 })+           , ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeToString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toLocaleString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeToLocaleString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("concat", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeConcat,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("join", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeJoin,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("pop", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypePop,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("push", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypePush,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("reverse", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeReverse,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("shift", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeShift,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("slice", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeSlice,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("sort", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeSort,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("splice", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeSplice,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("unshift", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeUnshift,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("indexOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeIndexOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("lastIndexOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeLastIndexOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("every", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeEvery,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("some", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeSome,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("forEach", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeForEach,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("map", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeMap,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("filter", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeFilter,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("reduce", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeReduce,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("reduceRight", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj arrayPrototypeReduceRight,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "Array",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = arrayDefineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      arrayPrototypeToString = error "arrayPrototypeToString" :: Object+      arrayPrototypeToLocaleString = error "arrayPrototypeToLocaleString" :: Object+      arrayPrototypeConcat = error "arrayPrototypeConcat" :: Object+      arrayPrototypeJoin = error "arrayPrototypeJoin" :: Object+      arrayPrototypePop = error "arrayPrototypePop" :: Object+      arrayPrototypePush = error "arrayPrototypePush" :: Object+      arrayPrototypeReverse = error "arrayPrototypeReverse" :: Object+      arrayPrototypeShift = error "arrayPrototypeShift" :: Object+      arrayPrototypeSlice = error "arrayPrototypeSlice" :: Object+      arrayPrototypeSort = error "arrayPrototypeSort" :: Object+      arrayPrototypeSplice = error "arrayPrototypeSplice" :: Object+      arrayPrototypeUnshift = error "arrayPrototypeUnshift" :: Object+      arrayPrototypeIndexOf = error "arrayPrototypeUndexOf" :: Object+      arrayPrototypeLastIndexOf = error "arrayPrototypeLastIndexOf" :: Object+      arrayPrototypeEvery = error "arrayPrototypeEvery" :: Object+      arrayPrototypeSome = error "arrayPrototypeSome" :: Object+      arrayPrototypeForEach = error "arrayPrototypeForEach" :: Object+      arrayPrototypeMap = error "arrayPrototypeMap" :: Object+      arrayPrototypeFilter = error "arrayPrototypeFilter" :: Object+      arrayPrototypeReduce = error "arrayPrototypeReduce" :: Object+      arrayPrototypeReduceRight = error "arrayPrototypeReduceRight" :: Object++      booleanPrototypeObject = Object 4+      booleanPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj booleanConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj booleanPrototypeToString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("valueOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj booleanPrototypeValueOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "Boolean",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just (const $ return (inj False)),+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      booleanPrototypeToString = error "booleanPrototypeToString" :: Object++      booleanPrototypeValueOf = error "booleanPrototypeValueOf" :: Object++      datePrototypeObject = Object 5+      datePrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "Date",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just (const $ return (inj nan)),+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      errorPrototypeObject = Object 6+      errorPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj errorConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("name", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "Error",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("message", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj errorPrototypeToString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      errorPrototypeToString = Object 7+      errorPrototypeToStringInternal :: (Functor m, Monad m) => ObjectInternal m+      errorPrototypeToStringInternal =+        propertyFunctionObject errorPrototypeToStringCallImpl 0++      evalErrorPrototypeObject = Object 8+      evalErrorPrototypeObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      evalErrorPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj evalErrorConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("name", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "EvalError",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("message", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist errorPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+      rangeErrorPrototypeObject = Object 9+      rangeErrorPrototypeObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      rangeErrorPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj rangeErrorConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("name", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "RangeError",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("message", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist errorPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+      referenceErrorPrototypeObject = Object 10+      referenceErrorPrototypeObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      referenceErrorPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj referenceErrorConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("name", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "ReferenceError",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("message", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist errorPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+      syntaxErrorPrototypeObject = Object 11+      syntaxErrorPrototypeObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      syntaxErrorPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj syntaxErrorConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("name", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "SyntaxError",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("message", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist errorPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+      typeErrorPrototypeObject = Object 12+      typeErrorPrototypeObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      typeErrorPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj typeErrorConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("name", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "TypeError",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("message", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist errorPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+      uriErrorPrototypeObject = Object 13+      uriErrorPrototypeObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      uriErrorPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj uriErrorConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("name", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "URIError",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("message", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj "",+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist errorPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      functionPrototypeObject = Object 14+      functionPrototypeObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      functionPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ def {+                 dataDescriptorValue = inj $ Number 0 })+           , ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj functionConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj functionPrototypeToString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("apply", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj functionPrototypeApply,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("call", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj functionPrototypeCall,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("bind", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj functionPrototypeBind,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })],+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "Function",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Just functionPrototypeCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      functionPrototypeToString = error "functionPrototypeToString" :: Object+      functionPrototypeApply = error "functionPrototypeApply" :: Object+      functionPrototypeCall = error "functionPrototypeCall" :: Object+      functionPrototypeBind = error "functionPrototypeBind" :: Object++      numberPrototypeObject = Object 15+      numberPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj numberConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj numberPrototypeToString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toLocaleString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj numberPrototypeToLocaleString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("valueOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj numberPrototypeValueOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toFixed", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj numberPrototypeToFixed,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toExponential", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj numberPrototypeToExponential,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toPrecision", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj numberPrototypeToPrecision,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "Number",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just (const $ return (inj (Number 0))),+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      numberPrototypeToString = error "numberPrototypeToString" :: Object+      numberPrototypeToLocaleString = error "numberPrototypeToLocaleString" :: Object+      numberPrototypeValueOf = error "numberPrototypeValueOf" :: Object+      numberPrototypeToFixed = error "numberPrototypeToFixed" :: Object+      numberPrototypeToExponential = error "numberPrototypeToExponential" :: Object+      numberPrototypeToPrecision = error "numberPrototypeToPrecision" :: Object++      objectPrototypeObject = Object 16+      objectPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toString", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectPrototypeToString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toLocaleString", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectPrototypeToLocaleString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("valueOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectPrototypeValueOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("hasOwnProperty", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectPrototypeHasOwnProperty,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("isPrototypeOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectPrototypeIsPrototypeOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("propertyIsEnumerable", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectPrototypeIsEnumerable,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return JSNull,+        objectInternalClass             = "Object",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just (const $ return (inj (Number 0))),+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      objectPrototypeToString = error "objectPrototypeToString" :: Object+      objectPrototypeToLocaleString = error "objectPrototypeToLocaleString" :: Object+      objectPrototypeValueOf = error "objectPrototypeValueOf" :: Object+      objectPrototypeHasOwnProperty = error "objectPrototypeHasOwnProperty" :: Object+      objectPrototypeIsPrototypeOf = error "objectPrototypeIsPrototypeOf" :: Object+      objectPrototypeIsEnumerable = error "objectPrototypeIsEnumerable" :: Object++      regExpPrototypeObject = Object 17+      regExpPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "RegExp",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = stringGetOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Just regExpMatchImpl,+        objectInternalParameterMap      = Nothing }++      stringPrototypeObject = Object 18+      stringPrototypeObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("constructor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj stringConstructor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toString", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeToString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("valueOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeValueOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("charAt", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeCharAt,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("charCodeAt", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeCharCodeAt,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("concat", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeConcat,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("indexOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeIndexOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("lastIndexOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeLastIndexOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("localeCompare", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeLocaleCompare,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("match", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeMatch,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("replace", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeReplace,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("search", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeSearch,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("slice", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeSlice,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("split", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeSplit,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("substring", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeSubString,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toLowerCase", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeToLowerCase,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toLocaleLowerCase", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeToLocaleLowerCase,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toUpperCase", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeToUpperCase,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("toLocaleUpperCase", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeToLocaleUpperCase,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("trim", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeTrim,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "String",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = stringGetOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just $ stringPrimitiveValueImpl (inj ""),+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      stringPrototypeToString = error "stringPrototypeToString" :: Object+      stringPrototypeValueOf = error "stringPrototypeValueOf" :: Object+      stringPrototypeCharAt = error "stringPrototypeCharAt" :: Object+      stringPrototypeCharCodeAt = error "stringPrototypeCharCodeAt" :: Object+      stringPrototypeConcat = error "stringPrototypeConcat" :: Object+      stringPrototypeIndexOf = error "stringPrototypeIndexOf" :: Object+      stringPrototypeLastIndexOf = error "stringPrototypeLastIndexOf" :: Object+      stringPrototypeLocaleCompare = error "stringPrototypeLocaleCompare" :: Object+      stringPrototypeMatch = error "stringPrototypeMatch" :: Object+      stringPrototypeReplace = error "stringPrototypeReplace" :: Object+      stringPrototypeSearch = error "stringPrototypeSearch" :: Object+      stringPrototypeSlice = error "stringPrototypeSlice" :: Object+      stringPrototypeSplit = error "stringPrototypeSplit" :: Object+      stringPrototypeSubString = error "stringPrototypeSubString" :: Object+      stringPrototypeToLowerCase = error "stringPrototypeToLowerCase" :: Object+      stringPrototypeToLocaleLowerCase = error "stringPrototypeToLocaleLowerCase" :: Object+      stringPrototypeToUpperCase = error "stringPrototypeToUpperCase" :: Object+      stringPrototypeToLocaleUpperCase = error "stringPrototypeToLocaleUpperCase" :: Object+      stringPrototypeTrim = error "stringPrototypeTrim" :: Object++      throwTypeErrorObject = Object 19+      throwTypeErrorObjectInternal = error "throwTypeErrorObject"++      objectConstructor = Object 20+      objectConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ def {+                 dataDescriptorValue = inj (Number 1) })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj objectPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("getPrototypeOf", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorGetPrototypeOf,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("getOwnPropertyDescriptor", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorGetOwnPropertyDescriptor,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("getOwnPropertyNames", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorGetOwnPropertyNames,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("create", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorCreate,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("defineProperty", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorDefineProperty,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("defineProperties", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorDefineProperties,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("seal", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorSeal,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("freeze", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorFreeze,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("preventExtensions", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorPreventExtensions,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("isSealed", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorIsSealed,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("isFrozen", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorIsFrozen,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("isExtensible", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorIsExtensible,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("keys", PropertyData $ DataDescriptor {+                 dataDescriptorValue =+                    inj objectConstructorKeys,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $+                                          return (JSExist functionPrototypeObject),+        objectInternalClass             = "Object",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just (const $ return (inj (Number 0))),+        objectInternalConstruct         = Just objectConstructorConstructImpl,+        objectInternalCall              = Just objectConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      objectConstructorGetPrototypeOf = error "objectConstructorGetPrototypeOf" :: Object+      objectConstructorGetOwnPropertyDescriptor = error "objectConstructorGetOwnPropertyDescriptor" :: Object+      objectConstructorGetOwnPropertyNames = error "objectConstructorGetOwnPropertyNames" :: Object+      objectConstructorCreate = error "objectConstructorCreate" :: Object+      objectConstructorDefineProperty = error "objectConstructorDefineProperty" :: Object+      objectConstructorDefineProperties = error "objectConstructorDefineProperties" :: Object+      objectConstructorSeal = error "objectConstructorSeal" :: Object+      objectConstructorFreeze = error "objectConstructorFreeze" :: Object+      objectConstructorPreventExtensions = error "objectConstructorPreventExtensions" :: Object+      objectConstructorIsSealed = error "objectConstructorIsSealed" :: Object+      objectConstructorIsFrozen = error "objectConstructorIsFrozen" :: Object+      objectConstructorIsExtensible = error "objectConstructorIsExtensible" :: Object+      objectConstructorKeys = error "objectConstructorKeys" :: Object++      functionConstructor = Object 21+      functionConstructorInternal :: (Functor m, Monad m) => ObjectInternal m+      functionConstructorInternal = ObjectInternal {+        objectInternalProperties =+           Map.fromList+           [ ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ functionPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }),+             ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })],+        objectInternalPrototype         = const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "Function",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just functionConstructorConstructImpl,+        objectInternalCall              = Just functionConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      arrayConstructor = Object 22+      arrayConstructorInternal :: (Functor m, Monad m) => ObjectInternal m+      arrayConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ arrayPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("isArray", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ arrayConstructorIsArray,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "Function",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just arrayConstructorConstructImpl,+        objectInternalCall              = Just arrayConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      arrayConstructorIsArray = error "arrayConstructorIsArray" :: Object++      stringConstructor = Object 23+      stringConstructorInternal :: (Functor m, Monad m) => ObjectInternal m+      stringConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("fromCharCode", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ stringConstructorFromCharCode,+                 dataDescriptorWritable = True,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "String",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just stringConstructorConstructImpl,+        objectInternalCall              = Just stringConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      stringConstructorFromCharCode = error "stringConstructorFromCharCode" :: Object++      booleanConstructor = Object 24+      booleanConstructorInternal :: (Functor m, Monad m) => ObjectInternal m+      booleanConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ booleanPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "Boolean",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just booleanConstructorConstructImpl,+        objectInternalCall              = Just booleanConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      numberConstructor = Object 25+      numberConstructorInternal :: (Functor m, Monad m) => ObjectInternal m+      numberConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ numberPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("MAX_VALUE", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("MIN_VALUE", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("NaN", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("NEGATIVE_INFINITY", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("POSITIVE_INFINITY", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "Number",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just numberConstructorConstructImpl,+        objectInternalCall              = Just numberConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      dateConstructor = Object 26+      dateConstructorInternal = error "dateConstructorInternal"++      regExpConstructor = Object 27+      regExpConstructorInternal = error "regExpConstructorInternal"++      errorConstructor = Object 28+      errorConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj errorPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just errorConstructorConstructImpl,+        objectInternalCall              = Just errorConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      evalErrorConstructor = Object 29+      evalErrorConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj evalErrorPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "EvalError",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just errorConstructorConstructImpl,+        objectInternalCall              = Just errorConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      rangeErrorConstructor = Object 30+      rangeErrorConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj rangeErrorPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "RangeError",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just errorConstructorConstructImpl,+        objectInternalCall              = Just errorConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      referenceErrorConstructor = Object 31+      referenceErrorConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj referenceErrorPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "ReferenceError",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just errorConstructorConstructImpl,+        objectInternalCall              = Just errorConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      syntaxErrorConstructor = Object 32+      syntaxErrorConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj syntaxErrorPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "SyntaxError",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just errorConstructorConstructImpl,+        objectInternalCall              = Just errorConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      typeErrorConstructor = Object 33+      typeErrorConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj typeErrorPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "TypeError",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just errorConstructorConstructImpl,+        objectInternalCall              = Just errorConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      uriErrorConstructor = Object 34+      uriErrorConstructorInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj $ Number 1,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("prototype", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj uriErrorPrototypeObject,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "URIError",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just errorConstructorConstructImpl,+        objectInternalCall              = Just errorConstructorCallImpl,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      mathObject = Object 35+      mathObjectInternal :: (Functor m, Monad m) => ObjectInternal m+      mathObjectInternal = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("E", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("LN10", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("LN2", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("LOG2E", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("LOG10E", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("PI", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("SQRT1_2", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("SQRT2", PropertyData $ DataDescriptor {+                 dataDescriptorValue = undefined,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("abs", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathAbs,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("acos", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathAcos,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("asin", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathAsin,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("atan", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathAtan,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("atan2", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathAtan2,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("ceil", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathCeil,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("cos", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathCos,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("exp", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathExp,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("floor", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathFloor,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("log", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathLog,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("max", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathMax,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("min", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathMin,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("pow", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathPow,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("random", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathRandom,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("round", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathRound,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("sin", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathSin,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("sqrt", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathSqrt,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False })+           , ("tan", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj mathTan,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         = const $ return (JSExist objectPrototypeObject),+        objectInternalClass             = "Math",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++      mathAbs = error "mathAbs" :: Object+      mathAcos = error "mathAcos" :: Object+      mathAsin = error "mathAsin" :: Object+      mathAtan = error "mathAtan" :: Object+      mathAtan2 = error "mathAtan2" :: Object+      mathCeil = error "mathCeil" :: Object+      mathCos = error "mathCos" :: Object+      mathExp = error "mathExp" :: Object+      mathFloor = error "mathFloor" :: Object+      mathLog = error "mathLog" :: Object+      mathMax = error "mathMax" :: Object+      mathMin = error "mathMin" :: Object+      mathPow = error "mathPow" :: Object+      mathRandom = error "mathRandom" :: Object+      mathRound = error "mathRound" :: Object+      mathSin = error "mathSin" :: Object+      mathSqrt = error "mathSqrt" :: Object+      mathTan = error "mathTan" :: Object++      jsonObject = Object 36+      jsonObjectInternal = error "jsonObjectInternal"++      nextInternalId = 37++      propertyFunctionObject :: (Functor m, Monad m) =>+                                InternalCallType m -> Number -> ObjectInternal m+      propertyFunctionObject c l = ObjectInternal {+        objectInternalProperties        =+           Map.fromList+           [ ("length", PropertyData $ DataDescriptor {+                 dataDescriptorValue = inj l,+                 dataDescriptorWritable = False,+                 dataDescriptorEnumerable = False,+                 dataDescriptorConfigurable = False }) ],+        objectInternalPrototype         =+          const $ return (JSExist functionPrototypeObject),+        objectInternalClass             = "Function",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = functionGetImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Just c,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  in+   JavaScriptState {+     javaScriptStateContextStack                     =+        ctxs,+     javaScriptStateNextInternalId                   =+       nextInternalId,+     javaScriptStateEnvironmentRecordHeap            =+       environmentRecordHeap,+     javaScriptStateDeclarativeEnvironmentRecordHeap =+       declarativeEnvironmentRecordHeap,+     javaScriptStateLexicalEnvironmentHeap           =+       lexicalEnvironmentHeap,+     javaScriptStateObjectHeap                       =+       objectHeap,+     javaScriptStateGlobalLexicalEnvironment         =+       globalLexicalEnvironment,+     javaScriptStateGlobalObject                     =+       globalObject,+     javaScriptStateArrayPrototypeObject             =+       arrayPrototypeObject,+     javaScriptStateBooleanPrototypeObject           =+       booleanPrototypeObject,+     javaScriptStateDatePrototypeObject              =+       datePrototypeObject,+     javaScriptStateErrorPrototypeObject             =+       errorPrototypeObject,+     javaScriptStateEvalErrorPrototypeObject         =+       evalErrorPrototypeObject,+     javaScriptStateRangeErrorPrototypeObject        =+       rangeErrorPrototypeObject,+     javaScriptStateReferenceErrorPrototypeObject    =+       referenceErrorPrototypeObject,+     javaScriptStateSyntaxErrorPrototypeObject       =+       syntaxErrorPrototypeObject,+     javaScriptStateTypeErrorPrototypeObject         =+       typeErrorPrototypeObject,+     javaScriptStateURIErrorPrototypeObject          =+       uriErrorPrototypeObject,+     javaScriptStateFunctionPrototypeObject          =+       functionPrototypeObject,+     javaScriptStateNumberPrototypeObject            =+       numberPrototypeObject,+     javaScriptStateObjectPrototypeObject            =+       objectPrototypeObject,+     javaScriptStateRegExpPrototypeObject            =+       regExpPrototypeObject,+     javaScriptStateStringPrototypeObject            =+       stringPrototypeObject,+     javaScriptStateThrowTypeErrorObject             =+       throwTypeErrorObject }++pushContext :: Context -> JavaScriptM ()+pushContext ctx = do+  contextStack %= push+  where+    push :: ContextStack -> ContextStack+    push (ContextStack c cs) = ContextStack ctx (c:cs)++popContext :: JavaScriptM ()+popContext = do+  contextStack %= pop+  where+    pop :: ContextStack -> ContextStack+    pop (ContextStack _ []) = error "Internal error: no context to pop"+    pop (ContextStack _ (c:cs)) = ContextStack c cs++contextStack :: Lens' (JavaScriptState m) ContextStack+contextStack = Lens.lens+               javaScriptStateContextStack+               (\jss cs -> jss { javaScriptStateContextStack = cs })++nextInternalId :: Lens' (JavaScriptState m) InternalId+nextInternalId = Lens.lens+             javaScriptStateNextInternalId+             (\jss noi -> jss { javaScriptStateNextInternalId = noi })++environmentRecordHeap :: Lens' (JavaScriptState m) EnvironmentRecordHeap+environmentRecordHeap =+  Lens.lens+  javaScriptStateEnvironmentRecordHeap+  (\jss erh -> jss { javaScriptStateEnvironmentRecordHeap = erh })++declarativeEnvironmentRecordHeap :: Lens' (JavaScriptState m) DeclarativeEnvironmentRecordHeap+declarativeEnvironmentRecordHeap =+  Lens.lens+  javaScriptStateDeclarativeEnvironmentRecordHeap+  (\jss derh -> jss { javaScriptStateDeclarativeEnvironmentRecordHeap = derh })++lexicalEnvironmentHeap :: Lens' (JavaScriptState m) LexicalEnvironmentHeap+lexicalEnvironmentHeap =+  Lens.lens+  javaScriptStateLexicalEnvironmentHeap+  (\jss lh -> jss { javaScriptStateLexicalEnvironmentHeap = lh })++lexicalEnvironmentInternal :: LexicalEnvironment -> Lens' (JavaScriptState m) LexicalEnvironmentInternal+lexicalEnvironmentInternal i =+  Lens.lens+  (\JavaScriptState {..} ->+    case Map.lookup i javaScriptStateLexicalEnvironmentHeap of+     Nothing -> error "Internal error: can't find lexicalEnvironment environment"+     Just o -> o)+  (\jss@(JavaScriptState {..}) oi ->+    jss { javaScriptStateLexicalEnvironmentHeap = Map.insert i oi javaScriptStateLexicalEnvironmentHeap })++mLexicalEnvironmentInternal :: LexicalEnvironment -> Lens' (JavaScriptState m) (Maybe LexicalEnvironmentInternal)+mLexicalEnvironmentInternal i = lexicalEnvironmentHeap . Lens.at i++objectHeap :: Lens' (JavaScriptState m) (ObjectHeap m)+objectHeap = Lens.lens+             javaScriptStateObjectHeap+             (\jss oh -> jss { javaScriptStateObjectHeap = oh })++internalObject :: Object -> Lens' (JavaScriptState m) (ObjectInternal m)+internalObject i =+  Lens.lens+  (\JavaScriptState {..} ->+    case Map.lookup i javaScriptStateObjectHeap of+     Nothing -> error "Internal error: can't find object"+     Just o -> o)+  (\jss@(JavaScriptState {..}) oi ->+    jss { javaScriptStateObjectHeap = Map.insert i oi javaScriptStateObjectHeap })++mInternalObject :: Object -> Lens' (JavaScriptState m) (Maybe (ObjectInternal m))+mInternalObject i = objectHeap . Lens.at i++globalLexicalEnvironment :: Lens' (JavaScriptState m) LexicalEnvironment+globalLexicalEnvironment =+  Lens.lens+  javaScriptStateGlobalLexicalEnvironment+  (\jss lid -> jss { javaScriptStateGlobalLexicalEnvironment = lid })++globalObject :: Lens' (JavaScriptState m) Object+globalObject =+  Lens.lens+  javaScriptStateGlobalObject+  (\jss oid -> jss { javaScriptStateGlobalObject = oid })++arrayPrototypeObject :: Lens' (JavaScriptState m) Object+arrayPrototypeObject =+  Lens.lens+  javaScriptStateArrayPrototypeObject+  (\jss oid -> jss { javaScriptStateArrayPrototypeObject = oid })++booleanPrototypeObject :: Lens' (JavaScriptState m) Object+booleanPrototypeObject =+  Lens.lens+  javaScriptStateBooleanPrototypeObject+  (\jss oid -> jss { javaScriptStateBooleanPrototypeObject = oid })++datePrototypeObject :: Lens' (JavaScriptState m) Object+datePrototypeObject =+  Lens.lens+  javaScriptStateDatePrototypeObject+  (\jss oid -> jss { javaScriptStateDatePrototypeObject = oid })++errorPrototypeObject :: Lens' (JavaScriptState m) Object+errorPrototypeObject =+  Lens.lens+  javaScriptStateErrorPrototypeObject+  (\jss oid -> jss { javaScriptStateErrorPrototypeObject = oid })++evalErrorPrototypeObject :: Lens' (JavaScriptState m) Object+evalErrorPrototypeObject =+  Lens.lens+  javaScriptStateEvalErrorPrototypeObject+  (\jss oid -> jss { javaScriptStateEvalErrorPrototypeObject = oid })++rangeErrorPrototypeObject :: Lens' (JavaScriptState m) Object+rangeErrorPrototypeObject =+  Lens.lens+  javaScriptStateRangeErrorPrototypeObject+  (\jss oid -> jss { javaScriptStateRangeErrorPrototypeObject = oid })++referenceErrorPrototypeObject :: Lens' (JavaScriptState m) Object+referenceErrorPrototypeObject =+  Lens.lens+  javaScriptStateReferenceErrorPrototypeObject+  (\jss oid -> jss { javaScriptStateReferenceErrorPrototypeObject = oid })++syntaxErrorPrototypeObject :: Lens' (JavaScriptState m) Object+syntaxErrorPrototypeObject =+  Lens.lens+  javaScriptStateSyntaxErrorPrototypeObject+  (\jss oid -> jss { javaScriptStateSyntaxErrorPrototypeObject = oid })++typeErrorPrototypeObject :: Lens' (JavaScriptState m) Object+typeErrorPrototypeObject =+  Lens.lens+  javaScriptStateTypeErrorPrototypeObject+  (\jss oid -> jss { javaScriptStateTypeErrorPrototypeObject = oid })++uriErrorPrototypeObject :: Lens' (JavaScriptState m) Object+uriErrorPrototypeObject =+  Lens.lens+  javaScriptStateURIErrorPrototypeObject+  (\jss oid -> jss { javaScriptStateURIErrorPrototypeObject = oid })++functionPrototypeObject :: Lens' (JavaScriptState m) Object+functionPrototypeObject =+  Lens.lens+  javaScriptStateFunctionPrototypeObject+  (\jss oid -> jss { javaScriptStateFunctionPrototypeObject = oid })++numberPrototypeObject :: Lens' (JavaScriptState m) Object+numberPrototypeObject =+  Lens.lens+  javaScriptStateNumberPrototypeObject+  (\jss oid -> jss { javaScriptStateNumberPrototypeObject = oid })++objectPrototypeObject :: Lens' (JavaScriptState m) Object+objectPrototypeObject =+  Lens.lens+  javaScriptStateObjectPrototypeObject+  (\jss oid -> jss { javaScriptStateObjectPrototypeObject = oid })++regexpPrototypeObject :: Lens' (JavaScriptState m) Object+regexpPrototypeObject =+  Lens.lens+  javaScriptStateRegExpPrototypeObject+  (\jss oid -> jss { javaScriptStateRegExpPrototypeObject = oid })++stringPrototypeObject :: Lens' (JavaScriptState m) Object+stringPrototypeObject =+  Lens.lens+  javaScriptStateStringPrototypeObject+  (\jss oid -> jss { javaScriptStateStringPrototypeObject = oid })++throwTypeErrorObject :: Lens' (JavaScriptState m) Object+throwTypeErrorObject =+  Lens.lens+  javaScriptStateThrowTypeErrorObject+  (\jss oid -> jss { javaScriptStateThrowTypeErrorObject = oid })++type JavaScriptT m = Except.ExceptT Value (State.StateT (JavaScriptState m) m)+type JavaScriptM a = forall m. (Functor m, Monad m) => JavaScriptT m a++runJavaScriptT :: (Functor m, Monad m) =>+                  JavaScriptState m ->+                  JavaScriptT m a ->+                  m (Either Value a)+runJavaScriptT s a = flip State.evalStateT s $ Except.runExceptT a++jsThrow :: (SubType v Value) => v -> JavaScriptM a+jsThrow v = Except.throwE (inj v)++type JSNullable a = a + Null++pattern JSNull = Right Null++pattern JSExist a = Left a++type JSMaybe a = a + Undefined++pattern JSNothing = Right Undefined++pattern JSJust a = Left a++jsMaybe :: b -> (a -> b) -> JSMaybe a -> b+jsMaybe b f ma =+  case ma of+   JSJust a  -> f a+   JSNothing -> b+   _ -> b++type Primitive = Null + Undefined + Number + String + Bool++pattern PrimitiveNull a      = Left a                          :: Primitive+pattern PrimitiveUndefined a = Right (Left a)                  :: Primitive+pattern PrimitiveNumber a    = Right (Right (Left a))          :: Primitive+pattern PrimitiveString a    = Right (Right (Right (Left a)))  :: Primitive+pattern PrimitiveBool a      = Right (Right (Right (Right a))) :: Primitive++type Value = Object + Primitive++pattern ValueObject a    = Left a                       :: Value+pattern ValuePrimitive a = Right a                      :: Value+pattern ValueNull a      = Right (PrimitiveNull a)      :: Value+pattern ValueUndefined a = Right (PrimitiveUndefined a) :: Value+pattern ValueNumber a    = Right (PrimitiveNumber a)    :: Value+pattern ValueString a    = Right (PrimitiveString a)    :: Value+pattern ValueBool a      = Right (PrimitiveBool a)      :: Value++type CallValue = Reference + Value++pattern CallValueReference a = Left a                   :: CallValue+pattern CallValueValue a     = Right a                  :: CallValue+pattern CallValueObject a    = Right (ValueObject a)    :: CallValue+pattern CallValuePrimitive a = Right (ValuePrimitive a) :: CallValue+pattern CallValueNull a      = Right (ValueNull a)      :: CallValue+pattern CallValueUndefined a = Right (ValueUndefined a) :: CallValue+pattern CallValueNumber a    = Right (ValueNumber a)    :: CallValue+pattern CallValueString a    = Right (ValueString a)    :: CallValue+pattern CallValueBool a      = Right (ValueBool a)      :: CallValue++type Spec a = EnvironmentRecord ++              LexicalEnvironment ++              PropertyIdentifier ++              PropertyDescriptor ++              Completion ++              List a ++              Reference++pattern SpecEnvironmentRecord a  = Left a+pattern SpecLexicalEnvironment a = Right (Left a)+pattern SpecPropertyIdentifier a = Right (Right (Left a))+pattern SpecPropertyDescriptor a = Right (Right (Right (Left a)))+pattern SpecCompletion a         = Right (Right (Right (Right (Left a))))+pattern SpecList a               = Right (Right (Right (Right (Right (Left a)))))+pattern SpecReference a          = Right (Right (Right (Right (Right (Right a)))))++type ECMA a = EnvironmentRecord ++              LexicalEnvironment ++              PropertyIdentifier ++              PropertyDescriptor ++              Completion ++              List a ++              Reference ++              Value++pattern ECMAEnvironmentRecord a  = Left a+pattern ECMALexicalEnvironment a = Right (Left a)+pattern ECMAPropertyIdentifier a = Right (Right (Left a))+pattern ECMAPropertyDescriptor a = Right (Right (Right (Left a)))+pattern ECMACompletion a         = Right (Right (Right (Right (Left a))))+pattern ECMAList a               = Right (Right (Right (Right (Right (Left a)))))+pattern ECMAReference a          = Right (Right (Right (Right (Right (Right (Left a))))))+pattern ECMAValue a              = Right (Right (Right (Right (Right (Right (Right a))))))++data Undefined =+  Undefined+  deriving (Eq, Ord, Show)++data Null+  = Null+  deriving (Eq, Ord, Show)++data Signum+  = SignumPos+  | SignumNeg+  deriving (Eq, Show)++newtype Number+  = Number Double+  deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac, Show)++nan :: Number+nan = Number (0 / 0)++posInf :: Number+posInf = Number (1 / 0)++negInf :: Number+negInf = Number ((-1) / 0)++type Base = EnvironmentRecord + Object + Undefined + Number + String + Bool++pattern BaseEnvironmentRecord a = Left a :: Base+pattern BaseObject a = Right (Left a) :: Base+pattern BaseUndefined a = Right (Right (Left a)) :: Base+pattern BaseProperty a = Right (Right (Right a)) :: Base+pattern BaseNumber a = Right (Right (Right (Left a))) :: Base+pattern BaseString a = Right (Right (Right (Right (Left a)))) :: Base+pattern BaseBool a = Right (Right (Right (Right (Right a)))) :: Base++data Reference+  = Reference Base String Bool+  deriving (Eq, Show)++getBase :: Reference -> Base+getBase (Reference base _ _) = base++getReferencedName :: Reference -> String+getReferencedName (Reference _ name _) = name++isStrictReference :: Reference -> Bool+isStrictReference (Reference _ _ strict) = strict++toPrimitiveBase :: Reference ->+                   (EnvironmentRecord + Object + Undefined)+                   ++                   (Number + String + Bool)+toPrimitiveBase (Reference (BaseEnvironmentRecord er) _ _) = Left (inj er)+toPrimitiveBase (Reference (BaseObject o) _ _) = Left (inj o)+toPrimitiveBase (Reference (BaseUndefined u) _ _) = Left (inj u)+toPrimitiveBase (Reference (BaseNumber n) _ _) = Right (inj n)+toPrimitiveBase (Reference (BaseString s) _ _) = Right (inj s)+toPrimitiveBase (Reference (BaseBool b) _ _) = Right (inj b)++isPropertyReference :: Reference -> Bool+isPropertyReference ref =+  case toPropertyReference ref of+   Left _ -> False+   _ -> True++toPropertyReference :: Reference ->+                       (EnvironmentRecord + Undefined)+                       ++                       (Object + Number + String + Bool)+toPropertyReference (Reference (BaseEnvironmentRecord er) _ _) = Left (inj er)+toPropertyReference (Reference (BaseUndefined u) _ _) = Left (inj u)+toPropertyReference (Reference (BaseObject o) _ _) = Right (inj o)+toPropertyReference (Reference (BaseNumber n) _ _) = Right (inj n)+toPropertyReference (Reference (BaseString s) _ _) = Right (inj s)+toPropertyReference (Reference (BaseBool b) _ _) = Right (inj b)++isUnresolvableReference :: Reference -> Bool+isUnresolvableReference ref =+  case toUnresolvableReference ref of+   Left _ -> True+   _ -> False++toUnresolvableReference :: Reference ->+                           Undefined+                           ++                           (EnvironmentRecord + Object + Number + String + Bool)+toUnresolvableReference (Reference (BaseUndefined u) _ _) = Left u+toUnresolvableReference (Reference (BaseEnvironmentRecord er) _ _) = Right (inj er)+toUnresolvableReference (Reference (BaseObject o) _ _) = Right (inj o)+toUnresolvableReference (Reference (BaseProperty p) _ _) = Right (inj p)+toUnresolvableReference (Reference (BaseNumber n) _ _) = Right (inj n)+toUnresolvableReference (Reference (BaseString s) _ _) = Right (inj s)+toUnresolvableReference (Reference (BaseBool b) _ _) = Right (inj b)++newtype List a+  = List [a]+  deriving (Eq, Show)++data CompletionType+  = CompletionTypeNormal+  | CompletionTypeBreak+  | CompletionTypeContinue+  | CompletionTypeReturn+  | CompletionTypeThrow+  deriving (Eq, Show)++data Completion+  = Completion CompletionType (Maybe Value) (Maybe Ident)+  deriving (Eq, Show)++data Type+  = TypeNumber+  | TypeString+  | TypeBoolean+  | TypeUndefined+  | TypeNull+  | TypeObject+  | TypeReference+  | TypeList+  | TypeCompletion+  | TypePropertyDescriptor+  | TypePropertyIdentifier+  | TypeLexicalEnvironment+  | TypeEnvironmentRecord+  deriving (Eq, Show)++typeOf :: forall v a. (SubType v (ECMA a)) => v -> Type+typeOf v =+  case (inj v :: ECMA a) of+   ECMAEnvironmentRecord _ -> TypeEnvironmentRecord+   ECMALexicalEnvironment _ -> TypeLexicalEnvironment+   ECMAPropertyIdentifier _ -> TypePropertyIdentifier+   ECMAPropertyDescriptor _ -> TypePropertyDescriptor+   ECMACompletion _ -> TypeCompletion+   ECMAList _ -> TypeList+   ECMAReference _ -> TypeReference+   ECMAValue (ValueObject _) -> TypeObject+   ECMAValue (ValueNull _) -> TypeNull+   ECMAValue (ValueUndefined _) -> TypeUndefined+   ECMAValue (ValueBool _) -> TypeBoolean+   ECMAValue (ValueString _) -> TypeString+   ECMAValue (ValueNumber _) -> TypeNumber++getValue :: (Functor m, Monad m, SubType v CallValue) =>+            v -> JavaScriptT m Value+getValue sub = do+  case (inj sub :: CallValue) of+   CallValueValue v -> return v+   CallValueReference ref -> do+     let base = getBase ref+     case toUnresolvableReference ref of+      Left _ -> newReferenceErrorObject+                (Just . inj $ getReferencedName ref) >>= jsThrow+      Right resolvableBase -> do+        case resolvableBase of+         Right propertyBase -> do+           case propertyBase of+            Left objectBase -> do+              get objectBase (getReferencedName ref)+            Right primitiveBase -> do+              let p = getReferencedName ref+              o <- toObject (inj primitiveBase)+              mDesc <- getProperty o p+              case mDesc of+               JSNothing -> return $ inj Undefined+               JSJust (PropertyDescriptor {..}) -> do+                 case toDataDescriptor mDesc of+                  JSJust (DataDescriptor {..}) -> do+                    return dataDescriptorValue+                  JSNothing ->+                   case propertyDescriptorGet of+                    Nothing -> return $ inj Undefined+                    Just getter -> do+                      callNative getter (inj primitiveBase) (List [])+         Left environmentRecordBase -> do+           getBindingValue+             environmentRecordBase+             (getReferencedName ref)+             (isStrictReference ref)++putValue :: (SubType v1 CallValue, SubType v2 Value) =>+            v1 -> v2 -> JavaScriptM ()+putValue rv w = do+  case (inj rv :: CallValue) of+   CallValueValue _ -> newReferenceErrorObject Nothing >>= jsThrow+   CallValueReference ref -> do+     let base = getBase ref+     case toUnresolvableReference ref of+      Left _ -> do+        if isStrictReference ref+          then newReferenceErrorObject+               (Just . inj $ getReferencedName ref) >>= jsThrow+          else do+          global <- Lens.use globalObject+          put global (getReferencedName ref) (inj w) False+      Right resolvableBase -> do+        case resolvableBase of+         Right propertyBase -> do+           case propertyBase of+            Left objectBase -> do+              put objectBase (getReferencedName ref) (inj w) (isStrictReference ref)+            Right primitiveBase -> do+              let p = getReferencedName ref+                  throw = isStrictReference ref+              o <- toObject (inj primitiveBase)+              c <- canPut o p+              if not c+                then do+                if throw+                  then newTypeErrorObject Nothing >>= jsThrow+                  else return ()+                else do+                ownDesc <- getOwnProperty o p+                if isDataDescriptor ownDesc+                  then+                  if throw+                  then newTypeErrorObject Nothing >>= jsThrow+                  else return ()+                  else do+                  desc <- getProperty o p+                  case toAccessorDescriptor desc of+                   JSJust (AccessorDescriptor {..}) -> do+                     let JSJust setter = accessorDescriptorSet+                     call setter (inj primitiveBase) (List [(inj w)])+                     return ()+                   JSNothing -> do+                     if throw+                       then newTypeErrorObject Nothing >>= jsThrow+                       else return ()+         Left environmentRecordBase -> do+           setMutableBinding+             environmentRecordBase+             (getReferencedName ref)+             (inj w)+             (isStrictReference ref)++data Property+  = PropertyData DataDescriptor+  | PropertyAccessor AccessorDescriptor+  deriving (Eq, Show)++data DataDescriptor+  = DataDescriptor+    { dataDescriptorValue        :: Value+    , dataDescriptorWritable     :: Bool+    , dataDescriptorEnumerable   :: Bool+    , dataDescriptorConfigurable :: Bool }+  deriving (Eq, Show)++instance Default DataDescriptor where+  def = DataDescriptor {+    dataDescriptorValue        = inj Undefined,+    dataDescriptorWritable     = False,+    dataDescriptorEnumerable   = False,+    dataDescriptorConfigurable = False }++data AccessorDescriptor+  = AccessorDescriptor+    { accessorDescriptorGet          :: JSMaybe Object+    , accessorDescriptorSet          :: JSMaybe Object+    , accessorDescriptorEnumerable   :: Bool+    , accessorDescriptorConfigurable :: Bool }+  deriving (Eq, Show)++instance Default AccessorDescriptor where+  def = AccessorDescriptor {+    accessorDescriptorGet          = JSNothing,+    accessorDescriptorSet          = JSNothing,+    accessorDescriptorEnumerable   = False,+    accessorDescriptorConfigurable = False }++data PropertyIdentifier+  = PropertyIdentifier String PropertyDescriptor++data PropertyDescriptor+  = PropertyDescriptor+    { propertyDescriptorValue        :: Maybe Value+    , propertyDescriptorGet          :: Maybe Object+    , propertyDescriptorSet          :: Maybe Object+    , propertyDescriptorWritable     :: Maybe Bool+    , propertyDescriptorEnumerable   :: Maybe Bool+    , propertyDescriptorConfigurable :: Maybe Bool }+  deriving (Eq, Show)++instance Default PropertyDescriptor where+  def = PropertyDescriptor {+    propertyDescriptorValue        = Nothing,+    propertyDescriptorGet          = Nothing,+    propertyDescriptorSet          = Nothing,+    propertyDescriptorWritable     = Nothing,+    propertyDescriptorEnumerable   = Nothing,+    propertyDescriptorConfigurable = Nothing }++isAccessorDescriptor :: JSMaybe PropertyDescriptor -> Bool+isAccessorDescriptor mp =+  case mp of+   JSJust PropertyDescriptor {..} ->+     isJust propertyDescriptorGet || isJust propertyDescriptorSet+   _ -> False++toAccessorDescriptor :: JSMaybe PropertyDescriptor -> JSMaybe AccessorDescriptor+toAccessorDescriptor mp =+  case mp of+   JSNothing -> JSNothing+   JSJust p@(PropertyDescriptor {..}) ->+     if isAccessorDescriptor mp+     then JSJust $ AccessorDescriptor {+       accessorDescriptorGet          = maybe JSNothing JSJust propertyDescriptorGet,+       accessorDescriptorSet          = maybe JSNothing JSJust propertyDescriptorSet,+       accessorDescriptorEnumerable   = maybe False id propertyDescriptorEnumerable,+       accessorDescriptorConfigurable = maybe False id propertyDescriptorConfigurable }+     else JSNothing++fromAccessorDescriptor :: AccessorDescriptor -> PropertyDescriptor+fromAccessorDescriptor AccessorDescriptor {..} =+  PropertyDescriptor {+    propertyDescriptorValue        = Nothing,+    propertyDescriptorGet          = jsMaybe Nothing Just accessorDescriptorGet,+    propertyDescriptorSet          = jsMaybe Nothing Just accessorDescriptorSet,+    propertyDescriptorWritable     = Nothing,+    propertyDescriptorEnumerable   = Just accessorDescriptorEnumerable,+    propertyDescriptorConfigurable = Just accessorDescriptorConfigurable }++isDataDescriptor :: JSMaybe PropertyDescriptor -> Bool+isDataDescriptor mp =+  case mp of+   JSJust (PropertyDescriptor {..}) ->+     isJust propertyDescriptorValue || isJust propertyDescriptorWritable+   JSNothing -> False++toDataDescriptor :: JSMaybe PropertyDescriptor -> JSMaybe DataDescriptor+toDataDescriptor mp =+  case mp of+   JSNothing -> JSNothing+   JSJust p@(PropertyDescriptor {..}) ->+     if isDataDescriptor mp+     then JSJust $ DataDescriptor {+       dataDescriptorValue        = maybe (inj Undefined) id propertyDescriptorValue,+       dataDescriptorWritable     = maybe False id propertyDescriptorWritable,+       dataDescriptorEnumerable   = maybe False id propertyDescriptorEnumerable,+       dataDescriptorConfigurable = maybe False id propertyDescriptorConfigurable }+     else JSNothing++fromDataDescriptor :: DataDescriptor -> PropertyDescriptor+fromDataDescriptor DataDescriptor {..} =+  PropertyDescriptor {+    propertyDescriptorValue        = Just dataDescriptorValue,+    propertyDescriptorGet          = Nothing,+    propertyDescriptorSet          = Nothing,+    propertyDescriptorWritable     = Just dataDescriptorWritable,+    propertyDescriptorEnumerable   = Just dataDescriptorEnumerable,+    propertyDescriptorConfigurable = Just dataDescriptorConfigurable }++isGenericDescriptor :: JSMaybe PropertyDescriptor -> Bool+isGenericDescriptor desc =+  not $ isAccessorDescriptor desc || isDataDescriptor desc++fromPropertyDescriptor :: JSMaybe PropertyDescriptor -> JavaScriptM (JSMaybe Object)+fromPropertyDescriptor mdesc = do+  o <- newObjectObject Nothing+  case mdesc of+   JSNothing -> return JSNothing+   JSJust desc@(PropertyDescriptor {..}) -> do+     if isDataDescriptor mdesc+       then do+       defineOwnProperty+         o+         "value"+         def {+           propertyDescriptorValue = propertyDescriptorValue,+           propertyDescriptorWritable = Just True,+           propertyDescriptorEnumerable = Just True,+           propertyDescriptorConfigurable = Just True }+         False+       defineOwnProperty+         o+         "writable"+         def {+           propertyDescriptorValue = inj <$> propertyDescriptorWritable,+           propertyDescriptorWritable = Just True,+           propertyDescriptorEnumerable = Just True,+           propertyDescriptorConfigurable = Just True }+         False+       else do+       defineOwnProperty+         o+         "get"+         def {+           propertyDescriptorValue = inj <$> propertyDescriptorGet,+           propertyDescriptorWritable = Just True,+           propertyDescriptorEnumerable = Just True,+           propertyDescriptorConfigurable = Just True }+         False+       defineOwnProperty+         o+         "set"+         def {+           propertyDescriptorValue = inj <$> propertyDescriptorSet,+           propertyDescriptorWritable = Just True,+           propertyDescriptorEnumerable = Just True,+           propertyDescriptorConfigurable = Just True }+         False+     return $ JSJust o++data LexicalEnvironment+  = LexicalEnvironment InternalId+  deriving (Eq, Ord, Show)++data LexicalEnvironmentInternal+  = LexicalEnvironmentInternal EnvironmentRecord (Maybe LexicalEnvironment)+  deriving (Eq, Show)++environmentRecord :: Lens' LexicalEnvironmentInternal EnvironmentRecord+environmentRecord =+  Lens.lens+  (\(LexicalEnvironmentInternal er _) -> er)+  (\(LexicalEnvironmentInternal _ mc) er -> LexicalEnvironmentInternal er mc)++getIdentifierReference :: Maybe LexicalEnvironment -> String -> Bool ->+                          JavaScriptM Reference+getIdentifierReference mLex name strict = do+  case mLex of+   Nothing ->+     return $ Reference (inj Undefined) name strict+   Just lex -> do+     LexicalEnvironmentInternal envRec outer <- Lens.use $ lexicalEnvironmentInternal lex+     exists <- hasBinding envRec name+     if exists+       then return $ Reference (inj envRec) name strict+       else getIdentifierReference outer name strict++newDeclarativeEnvironment :: Maybe LexicalEnvironment ->+                             JavaScriptM LexicalEnvironment+newDeclarativeEnvironment e = do+  ier <- createNextInternalId+  ider <- createNextInternalId+  ile <- createNextInternalId+  let decEnvRecInternal+        = DeclarativeEnvironmentRecordInternal {+          declarativeEnvironmentRecordInternalBindings = Map.empty }+      decEnvRec = DeclarativeEnvironmentRecord ider+      envrecInternal+        = EnvironmentRecordInternalDeclarative decEnvRec+      envrec = EnvironmentRecord ier+      envInternal = LexicalEnvironmentInternal envrec e+      env = LexicalEnvironment ile+  mEnvironmentRecordInternal envrec ?= envrecInternal+  mDeclarativeEnvironmentRecordInternal decEnvRec ?= decEnvRecInternal+  mLexicalEnvironmentInternal env ?= envInternal+  return env++newObjectObjectEnvironment :: Object -> Maybe LexicalEnvironment -> JavaScriptM LexicalEnvironment+newObjectObjectEnvironment o e = do+  ier <- createNextInternalId+  ile <- createNextInternalId+  let envrecInternal = EnvironmentRecordInternalObject (ObjectEnvironmentRecord o False)+      envrec = EnvironmentRecord ier+      envInternal = LexicalEnvironmentInternal envrec e+      env = LexicalEnvironment ile+  mEnvironmentRecordInternal envrec ?= envrecInternal+  mLexicalEnvironmentInternal env ?= envInternal+  return env++enterGlobalContext :: Program -> JavaScriptM ()+enterGlobalContext program = do+  global <- Lens.use globalObject+  globalEnvironment <- Lens.use globalLexicalEnvironment+  contextStack . currentContext . variableEnvironment .= globalEnvironment+  contextStack . currentContext . lexicalEnvironment .= globalEnvironment+  contextStack . currentContext . thisBinding .= (inj global)+  declarationBindingInstantiation (CodeGlobal program)++enterEvalContext :: JavaScriptM ()+enterEvalContext = error "enterEvalContext"++enterFunctionContext :: Object -> Value -> List Value -> JavaScriptM ()+enterFunctionContext f thisArg args = do+  let strict = False+  thisBinding <-+    if strict+      then return thisArg+    else+      case thisArg of+       ValueNull _ -> do+         global <- Lens.use globalObject+         return (inj global)+       ValueUndefined _ -> do+         global <- Lens.use globalObject+         return (inj global)+       _ -> do+         obj <- toObject thisArg+         return (inj obj)+  lex <- scope f+  localEnv <- newDeclarativeEnvironment (Just lex)+  let ctx = Context {+        contextLexicalEnvironment  = localEnv,+        contextVariableEnvironment = localEnv,+        contextThisBinding         = thisBinding,+        contextLabels              = [] }+  pushContext ctx+  declarationBindingInstantiation (CodeFunction f args)++data EnvironmentRecord+  = EnvironmentRecord InternalId+  deriving (Eq, Ord, Show)++data EnvironmentRecordInternal+  = EnvironmentRecordInternalDeclarative DeclarativeEnvironmentRecord+  | EnvironmentRecordInternalObject ObjectEnvironmentRecord+  deriving (Eq, Show)++environmentRecordInternal :: EnvironmentRecord ->+                             Lens' (JavaScriptState m) EnvironmentRecordInternal+environmentRecordInternal i =+  Lens.lens+  (\JavaScriptState {..} ->+    case Map.lookup i javaScriptStateEnvironmentRecordHeap of+     Nothing -> error "Internal error: can't find environmentRecord"+     Just o -> o)+  (\jss@(JavaScriptState {..}) oi ->+    jss { javaScriptStateEnvironmentRecordHeap = Map.insert i oi javaScriptStateEnvironmentRecordHeap })++mEnvironmentRecordInternal :: EnvironmentRecord -> Lens' (JavaScriptState m) (Maybe EnvironmentRecordInternal)+mEnvironmentRecordInternal i = environmentRecordHeap . Lens.at i++declarativeEnvironmentRecord :: Lens'+                                EnvironmentRecordInternal+                                DeclarativeEnvironmentRecord+declarativeEnvironmentRecord =+  Lens.lens+  (\eri -> case eri of+            EnvironmentRecordInternalDeclarative der -> der+            _ -> error "Not a declarative environment record")+  (\eri der -> case eri of+            EnvironmentRecordInternalDeclarative _ ->+              EnvironmentRecordInternalDeclarative der+            _ -> error "Not a declarative environment record")++objectEnvironmentRecord :: Lens'+                           EnvironmentRecordInternal+                           ObjectEnvironmentRecord+objectEnvironmentRecord =+  Lens.lens+  (\eri -> case eri of+            EnvironmentRecordInternalObject der -> der+            _ -> error "Not a object environment record")+  (\eri der -> case eri of+            EnvironmentRecordInternalObject _ ->+              EnvironmentRecordInternalObject der+            _ -> error "Not a object environment record")++data DeclarativeEnvironmentRecord+  = DeclarativeEnvironmentRecord InternalId+  deriving (Eq, Ord, Show)++data DeclarativeBinding+  = DeclarativeBindingMutable+    { declarativeBindingMutableValue  :: Value+    , declarativeBindingMutableDelete :: Bool }+  | DeclarativeBindingImmutable+    { declarativeBindingImmutableValue       :: Value+    , declarativeBindingImmutableInitialised :: Bool }+  deriving (Eq, Show)++data DeclarativeEnvironmentRecordInternal+  = DeclarativeEnvironmentRecordInternal+    { declarativeEnvironmentRecordInternalBindings+      :: Map String DeclarativeBinding }++internalDeclarativeEnvironmentRecordBindings+  :: Lens'+     DeclarativeEnvironmentRecordInternal+     (Map String DeclarativeBinding)+internalDeclarativeEnvironmentRecordBindings =+  Lens.lens+  declarativeEnvironmentRecordInternalBindings+  (\deri bs ->+    deri { declarativeEnvironmentRecordInternalBindings = bs })++internalDeclarativeEnvironmentRecordBinding+  :: String ->+     Lens'+     DeclarativeEnvironmentRecordInternal+     (Maybe DeclarativeBinding)+internalDeclarativeEnvironmentRecordBinding n =+  internalDeclarativeEnvironmentRecordBindings . Lens.at n++declarativeEnvironmentRecordInternal+  :: DeclarativeEnvironmentRecord ->+     Lens' (JavaScriptState m) DeclarativeEnvironmentRecordInternal+declarativeEnvironmentRecordInternal i =+  Lens.lens+  (\JavaScriptState {..} ->+    case Map.lookup i javaScriptStateDeclarativeEnvironmentRecordHeap of+     Nothing -> error "Internal error: can't find declarativeEnvironmentRecord"+     Just o -> o)+  (\jss@(JavaScriptState {..}) oi ->+    jss { javaScriptStateDeclarativeEnvironmentRecordHeap =+             Map.insert i oi javaScriptStateDeclarativeEnvironmentRecordHeap })++mDeclarativeEnvironmentRecordInternal :: DeclarativeEnvironmentRecord -> Lens' (JavaScriptState m) (Maybe DeclarativeEnvironmentRecordInternal)+mDeclarativeEnvironmentRecordInternal i =+  declarativeEnvironmentRecordHeap . Lens.at i++data ObjectEnvironmentRecord+  = ObjectEnvironmentRecord+    { objectEnvironmentRecordBindingObject :: Object+    , objectEnvironmentRecordProvideThis   :: Bool }+  deriving (Eq, Show)++hasBinding :: EnvironmentRecord -> String -> JavaScriptM Bool+hasBinding er n = do+  eri <- Lens.use $ environmentRecordInternal er+  case eri of+   EnvironmentRecordInternalDeclarative der ->+     hasBindingDeclarative der n+   EnvironmentRecordInternalObject oer ->+     hasBindingObject oer n++hasBindingDeclarative :: DeclarativeEnvironmentRecord ->+                         String -> JavaScriptM Bool+hasBindingDeclarative envRec n = do+  deri <- Lens.use $ declarativeEnvironmentRecordInternal envRec+  let bindings = declarativeEnvironmentRecordInternalBindings deri+  return $ Map.member n bindings++hasBindingObject :: ObjectEnvironmentRecord ->+                    String -> JavaScriptM Bool+hasBindingObject envRec n = do+  let bindings = objectEnvironmentRecordBindingObject envRec+  hasProperty bindings n++createMutableBinding :: EnvironmentRecord -> String -> Maybe Bool -> JavaScriptM ()+createMutableBinding er n d = do+  eri <- Lens.use $ environmentRecordInternal er+  case eri of+   EnvironmentRecordInternalDeclarative der ->+     createMutableBindingDeclarative der n d+   EnvironmentRecordInternalObject oer ->+     createMutableBindingObject oer n d++createMutableBindingDeclarative :: DeclarativeEnvironmentRecord ->+                                   String -> Maybe Bool -> JavaScriptM ()+createMutableBindingDeclarative envRec n d = do+  let markDel = maybe False id d+      binding = DeclarativeBindingMutable (inj Undefined) markDel+  declarativeEnvironmentRecordInternal envRec .+    internalDeclarativeEnvironmentRecordBinding n ?= binding++createMutableBindingObject :: ObjectEnvironmentRecord ->+                              String -> Maybe Bool -> JavaScriptM ()+createMutableBindingObject envRec n d = do+  let bindings = objectEnvironmentRecordBindingObject envRec+      configValue = if d == Just True then True else False+      desc = def {+        propertyDescriptorValue        = Just (inj Undefined),+        propertyDescriptorWritable     = Just True,+        propertyDescriptorEnumerable   = Just True,+        propertyDescriptorConfigurable = Just configValue }+  defineOwnProperty bindings n desc True+  return ()++setMutableBinding :: EnvironmentRecord -> String -> Value -> Bool -> JavaScriptM ()+setMutableBinding er n v s = do+  eri <- Lens.use $ environmentRecordInternal er+  case eri of+   EnvironmentRecordInternalDeclarative der ->+     setMutableBindingDeclarative der n v s+   EnvironmentRecordInternalObject oer ->+     setMutableBindingObject oer n v s++setMutableBindingDeclarative :: DeclarativeEnvironmentRecord ->+                                String -> Value -> Bool -> JavaScriptM ()+setMutableBindingDeclarative envRec n v s = do+  binding <- Lens.use $ declarativeEnvironmentRecordInternal envRec .+             internalDeclarativeEnvironmentRecordBinding n+  case binding of+   Nothing -> error "Internal error: setMutableBindingDeclarative assert failed"+   Just (DeclarativeBindingMutable _ d) -> do+     let binding = DeclarativeBindingMutable v d+     declarativeEnvironmentRecordInternal envRec .+       internalDeclarativeEnvironmentRecordBinding n ?= binding+   Just (DeclarativeBindingImmutable {}) ->+     if s+     then newTypeErrorObject Nothing >>= jsThrow+     else return ()++setMutableBindingObject :: ObjectEnvironmentRecord ->+                           String -> Value -> Bool -> JavaScriptM ()+setMutableBindingObject envRec n v s = do+  let bindings = objectEnvironmentRecordBindingObject envRec+  put bindings n v s++getBindingValue :: EnvironmentRecord -> String -> Bool -> JavaScriptM Value+getBindingValue er n s = do+  eri <- Lens.use $ environmentRecordInternal er+  case eri of+   EnvironmentRecordInternalDeclarative der ->+     getBindingValueDeclarative der n s+   EnvironmentRecordInternalObject oer ->+     getBindingValueObject oer n s++getBindingValueDeclarative :: DeclarativeEnvironmentRecord ->+                              String -> Bool -> JavaScriptM Value+getBindingValueDeclarative envRec n s = do+  binding <- Lens.use $ declarativeEnvironmentRecordInternal envRec .+             internalDeclarativeEnvironmentRecordBinding n+  case binding of+   Nothing -> error "Internal error: getBindingValueDeclarative assert failed"+   Just (DeclarativeBindingImmutable v False) ->+     if not s+     then return (inj Undefined)+     else newReferenceErrorObject (Just . inj $ s) >>= jsThrow+   Just (DeclarativeBindingImmutable v _) -> return v+   Just (DeclarativeBindingMutable v _) -> return v++getBindingValueObject :: ObjectEnvironmentRecord ->+                         String -> Bool -> JavaScriptM Value+getBindingValueObject envRec n s = do+  let bindings = objectEnvironmentRecordBindingObject envRec+  value <- hasProperty bindings n+  if not value+    then do+    if not s+      then return (inj Undefined)+      else newReferenceErrorObject (Just . inj $ s) >>= jsThrow+    else get bindings n++deleteBinding :: EnvironmentRecord -> String -> JavaScriptM Bool+deleteBinding er n = do+  eri <- Lens.use $ environmentRecordInternal er+  case eri of+   EnvironmentRecordInternalDeclarative der ->+     deleteBindingDeclarative der n+   EnvironmentRecordInternalObject oer ->+     deleteBindingObject oer n++deleteBindingDeclarative :: DeclarativeEnvironmentRecord ->+                            String -> JavaScriptM Bool+deleteBindingDeclarative envRec n = do+  binding <- Lens.use $ declarativeEnvironmentRecordInternal envRec .+             internalDeclarativeEnvironmentRecordBinding n+  case binding of+   Nothing -> return True+   Just (DeclarativeBindingMutable _ True) -> do+     declarativeEnvironmentRecordInternal envRec .+       internalDeclarativeEnvironmentRecordBinding n .= Nothing+     return True+   _ -> return False++deleteBindingObject :: ObjectEnvironmentRecord ->+                       String -> JavaScriptM Bool+deleteBindingObject envRec n = do+  let bindings = objectEnvironmentRecordBindingObject envRec+  delete bindings n False++implicitThisValue :: EnvironmentRecord -> JavaScriptM Value+implicitThisValue er = do+  eri <- Lens.use $ environmentRecordInternal er+  case eri of+   EnvironmentRecordInternalDeclarative der ->+     implicitThisValueDeclarative der+   EnvironmentRecordInternalObject oer ->+     implicitThisValueObject oer++implicitThisValueDeclarative :: DeclarativeEnvironmentRecord ->+                                JavaScriptM Value+implicitThisValueDeclarative _ = return (inj Undefined)++implicitThisValueObject :: ObjectEnvironmentRecord ->+                           JavaScriptM Value+implicitThisValueObject envRec = do+  if objectEnvironmentRecordProvideThis envRec+    then return $ inj $ objectEnvironmentRecordBindingObject envRec+    else return $ inj Undefined++createImmutableBindingDeclarative :: DeclarativeEnvironmentRecord ->+                                     String ->+                                     JavaScriptM ()+createImmutableBindingDeclarative  envRec n = do+  let binding = DeclarativeBindingImmutable (inj Undefined) False+  declarativeEnvironmentRecordInternal envRec .+    internalDeclarativeEnvironmentRecordBinding n ?= binding++initializeImmutableBindingDeclarative :: DeclarativeEnvironmentRecord ->+                                         String ->+                                         Value ->+                                         JavaScriptM ()+initializeImmutableBindingDeclarative envRec n v = do+  let binding = DeclarativeBindingImmutable v True+  declarativeEnvironmentRecordInternal envRec .+    internalDeclarativeEnvironmentRecordBinding n ?= binding++data MatchResult+  = MatchResult++type InternalId = Int++data Object+  = Object InternalId+  deriving (Eq, Ord, Show)++type InternalPropertiesType          = Map String Property+type InternalPrototypeType m         = Object -> JavaScriptT m (JSNullable Object)+type InternalClassType               = String+type InternalExtensibleType m        = Object -> JavaScriptT m Bool+type InternalGetType m               = Object -> String -> JavaScriptT m Value+type InternalGetOwnPropertyType m    = Object -> String -> JavaScriptT m (JSMaybe PropertyDescriptor)+type InternalGetPropertyType m       = Object -> String -> JavaScriptT m (JSMaybe PropertyDescriptor)+type InternalPutType m               = Object -> String -> Value -> Bool -> JavaScriptT m ()+type InternalCanPutType m            = Object -> String -> JavaScriptT m Bool+type InternalHasPropertyType m       = Object -> String -> JavaScriptT m Bool+type InternalDeleteType m            = Object -> String -> Bool -> JavaScriptT m Bool+type InternalDefaultValueType m      = Object -> Maybe Hint -> JavaScriptT m Primitive+type InternalDefineOwnPropertyType m = Object -> String -> PropertyDescriptor -> Bool -> JavaScriptT m Bool+type InternalPrimitiveValueType m    = Object -> JavaScriptT m Primitive+type InternalConstructType m         = Object -> List Value -> JavaScriptT m Object+type InternalCallType m              = Object -> Value -> List Value -> JavaScriptT m CallValue+type InternalCallNativeType m        = Object -> Value -> List Value -> JavaScriptT m Value+type InternalHasInstanceType m       = Object -> Value -> JavaScriptT m Bool+type InternalScopeType m             = Object -> JavaScriptT m LexicalEnvironment+type InternalFormalParametersType m  = Object -> JavaScriptT m (List String)+type InternalCodeType m              = Object -> JavaScriptT m FuncBody+type InternalTargetFunctionType m    = Object -> JavaScriptT m Object+type InternalBoundThisType m         = Object -> JavaScriptT m Value+type InternalBoundArgumentsType m    = Object -> JavaScriptT m (List Value)+type InternalMatchType m             = Object -> String -> Int -> JavaScriptT m MatchResult+type InternalParameterMapType m      = Object -> JavaScriptT m Object++data ObjectInternal m =+  ObjectInternal+  { objectInternalProperties        :: InternalPropertiesType+  , objectInternalPrototype         :: InternalPrototypeType m+  , objectInternalClass             :: InternalClassType+  , objectInternalExtensible        :: InternalExtensibleType m+  , objectInternalGet               :: InternalGetType m+  , objectInternalGetOwnProperty    :: InternalGetOwnPropertyType m+  , objectInternalGetProperty       :: InternalGetPropertyType m+  , objectInternalPut               :: InternalPutType m+  , objectInternalCanPut            :: InternalCanPutType m+  , objectInternalHasProperty       :: InternalHasPropertyType m+  , objectInternalDelete            :: InternalDeleteType m+  , objectInternalDefaultValue      :: InternalDefaultValueType m+  , objectInternalDefineOwnProperty :: InternalDefineOwnPropertyType m+  , objectInternalPrimitiveValue    :: Maybe (InternalPrimitiveValueType m)+  , objectInternalConstruct         :: Maybe (InternalConstructType m)+  , objectInternalCall              :: Maybe (InternalCallType m)+  , objectInternalHasInstance       :: Maybe (InternalHasInstanceType m)+  , objectInternalScope             :: Maybe (InternalScopeType m)+  , objectInternalFormalParameters  :: Maybe (InternalFormalParametersType m)+  , objectInternalCode              :: Maybe (InternalCodeType m)+  , objectInternalTargetFunction    :: Maybe (InternalTargetFunctionType m)+  , objectInternalBoundThis         :: Maybe (InternalBoundThisType m)+  , objectInternalBoundArguments    :: Maybe (InternalBoundArgumentsType m)+  , objectInternalMatch             :: Maybe (InternalMatchType m)+  , objectInternalParameterMap      :: Maybe (InternalParameterMapType m) }++internalProperties :: Lens' (ObjectInternal m) InternalPropertiesType+internalProperties =+  Lens.lens+  objectInternalProperties+  (\oi ps -> oi { objectInternalProperties = ps })++internalProperty :: String -> Lens' (ObjectInternal m) (Maybe Property)+internalProperty p = internalProperties . Lens.at p++properties :: Object -> Lens' (JavaScriptState m) InternalPropertiesType+properties o = internalObject o . internalProperties++property :: Object -> String -> Lens' (JavaScriptState m) (Maybe Property)+property o p = internalObject o . internalProperty p++internalPrototype :: Lens' (ObjectInternal m) (InternalPrototypeType m)+internalPrototype =+  Lens.lens+  objectInternalPrototype+  (\oi p -> oi { objectInternalPrototype = p })++prototype :: (Functor m, Monad m) => InternalPrototypeType m+prototype o = callInternalProperty o objectInternalPrototype++internalClass :: Lens' (ObjectInternal m) InternalClassType+internalClass =+  Lens.lens+  objectInternalClass+  (\oi c -> oi { objectInternalClass = c })++class' :: Object -> Lens' (JavaScriptState m) InternalClassType+class' o = internalObject o . internalClass++internalExtensible :: Lens' (ObjectInternal m) (InternalExtensibleType m)+internalExtensible =+  Lens.lens+  objectInternalExtensible+  (\oi e -> oi { objectInternalExtensible = e })++extensible :: (Functor m, Monad m) => InternalExtensibleType m+extensible o = callInternalProperty o objectInternalExtensible++internalGet :: Lens' (ObjectInternal m) (InternalGetType m)+internalGet =+  Lens.lens+  objectInternalGet+  (\oi g -> oi { objectInternalGet = g })++get :: (Functor m, Monad m) => InternalGetType m+get o = callInternalProperty1 o objectInternalGet++internalGetOwnProperty :: Lens' (ObjectInternal m) (InternalGetOwnPropertyType m)+internalGetOwnProperty =+  Lens.lens+  objectInternalGetOwnProperty+  (\oi gop -> oi { objectInternalGetOwnProperty = gop })++getOwnProperty :: (Functor m, Monad m) => InternalGetOwnPropertyType m+getOwnProperty o = callInternalProperty1 o objectInternalGetOwnProperty++internalGetProperty :: Lens' (ObjectInternal m) (InternalGetPropertyType m)+internalGetProperty =+  Lens.lens+  objectInternalGetProperty+  (\oi gp -> oi { objectInternalGetProperty = gp })++getProperty :: (Functor m, Monad m) => InternalGetPropertyType m+getProperty o = callInternalProperty1 o objectInternalGetProperty++internalPut :: Lens' (ObjectInternal m) (InternalPutType m)+internalPut =+  Lens.lens+  objectInternalPut+  (\oi p -> oi { objectInternalPut = p })++put :: (Functor m, Monad m) => InternalPutType m+put o = callInternalProperty3 o objectInternalPut++internalCanPut :: Lens' (ObjectInternal m) (InternalCanPutType m)+internalCanPut =+  Lens.lens+  objectInternalCanPut+  (\oi cp -> oi { objectInternalCanPut = cp })++canPut :: (Functor m, Monad m) => InternalCanPutType m+canPut o = callInternalProperty1 o objectInternalCanPut++internalHasProperty :: Lens' (ObjectInternal m) (InternalHasPropertyType m)+internalHasProperty =+  Lens.lens+  objectInternalHasProperty+  (\oi hp -> oi { objectInternalHasProperty = hp })++hasProperty :: (Functor m, Monad m) => InternalHasPropertyType m+hasProperty o = callInternalProperty1 o objectInternalHasProperty++internalDelete :: Lens' (ObjectInternal m) (InternalDeleteType m)+internalDelete =+  Lens.lens+  objectInternalDelete+  (\oi d -> oi { objectInternalDelete = d })++delete :: (Functor m, Monad m) => InternalDeleteType m+delete o = callInternalProperty2 o objectInternalDelete++internalDefaultValue :: Lens' (ObjectInternal m) (InternalDefaultValueType m)+internalDefaultValue =+  Lens.lens+  objectInternalDefaultValue+  (\oi dv -> oi { objectInternalDefaultValue = dv })++defaultValue :: (Functor m, Monad m) => InternalDefaultValueType m+defaultValue o = callInternalProperty1 o objectInternalDefaultValue++internalDefineOwnProperty :: Lens' (ObjectInternal m) (InternalDefineOwnPropertyType m)+internalDefineOwnProperty =+  Lens.lens+  objectInternalDefineOwnProperty+  (\oi dop -> oi { objectInternalDefineOwnProperty = dop })++defineOwnProperty :: (Functor m, Monad m) => InternalDefineOwnPropertyType m+defineOwnProperty o = callInternalProperty3 o objectInternalDefineOwnProperty++internalPrimitiveValue :: Lens' (ObjectInternal m) (Maybe (InternalPrimitiveValueType m))+internalPrimitiveValue =+  Lens.lens+  objectInternalPrimitiveValue+  (\oi mpv -> oi { objectInternalPrimitiveValue = mpv })++primitiveValue :: (Functor m, Monad m) => InternalPrimitiveValueType m+primitiveValue o = callInternalOptionalProperty o objectInternalPrimitiveValue++internalConstruct :: Lens' (ObjectInternal m) (Maybe (InternalConstructType m))+internalConstruct =+  Lens.lens+  objectInternalConstruct+  (\oi c -> oi { objectInternalConstruct = c })++construct :: (Functor m, Monad m) => InternalConstructType m+construct o = callInternalOptionalProperty1 o objectInternalConstruct++internalCall :: Lens' (ObjectInternal m) (Maybe (InternalCallType m))+internalCall =+  Lens.lens+  objectInternalCall+  (\oi c -> oi { objectInternalCall = c })++call :: (Functor m, Monad m) => InternalCallType m+call o = callInternalOptionalProperty2 o objectInternalCall++callNative :: (Functor m, Monad m) => InternalCallNativeType m+callNative o t l = do+  rv <- callInternalOptionalProperty2 o objectInternalCall t l+  case prj rv of+   Nothing -> error "Native function can't return references"+   Just v -> return v++hasInstance :: (Functor m, Monad m) => InternalHasInstanceType m+hasInstance o = callInternalOptionalProperty1 o objectInternalHasInstance++internalHasInstance :: Lens' (ObjectInternal m) (Maybe (InternalHasInstanceType m))+internalHasInstance =+  Lens.lens+  objectInternalHasInstance+  (\oi hi -> oi { objectInternalHasInstance = hi })++scope :: (Functor m, Monad m) => InternalScopeType m+scope o = callInternalOptionalProperty o objectInternalScope++internalScope :: Lens' (ObjectInternal m) (Maybe (InternalScopeType m))+internalScope =+  Lens.lens+  objectInternalScope+  (\oi s -> oi { objectInternalScope = s })++formalParameters :: (Functor m, Monad m) => InternalFormalParametersType m+formalParameters o = callInternalOptionalProperty o objectInternalFormalParameters++internalFormalParameters :: Lens' (ObjectInternal m) (Maybe (InternalFormalParametersType m))+internalFormalParameters =+  Lens.lens+  objectInternalFormalParameters+  (\oi fp -> oi { objectInternalFormalParameters = fp })++code :: (Functor m, Monad m) => InternalCodeType m+code o = callInternalOptionalProperty o objectInternalCode++internalCode :: Lens' (ObjectInternal m) (Maybe (InternalCodeType m))+internalCode =+  Lens.lens+  objectInternalCode+  (\oi c -> oi { objectInternalCode = c })++internalTargetFunction :: Lens' (ObjectInternal m) (Maybe (InternalTargetFunctionType m))+internalTargetFunction =+  Lens.lens+  objectInternalTargetFunction+  (\oi tf -> oi { objectInternalTargetFunction = tf })++internalBoundThis :: Lens' (ObjectInternal m) (Maybe (InternalBoundThisType m))+internalBoundThis =+  Lens.lens+  objectInternalBoundThis+  (\oi bt -> oi { objectInternalBoundThis = bt })++internalBoundArguments :: Lens' (ObjectInternal m) (Maybe (InternalBoundArgumentsType m))+internalBoundArguments =+  Lens.lens+  objectInternalBoundArguments+  (\oi bas -> oi { objectInternalBoundArguments = bas })++internalMatch :: Lens' (ObjectInternal m) (Maybe (InternalMatchType m))+internalMatch =+  Lens.lens+  objectInternalMatch+  (\oi m -> oi { objectInternalMatch = m })++internalParameterMap :: Lens' (ObjectInternal m) (Maybe (InternalParameterMapType m))+internalParameterMap =+  Lens.lens+  objectInternalParameterMap+  (\oi pm -> oi { objectInternalParameterMap = pm })++callInternalProperty :: (Functor m, Monad m) => Object -> (ObjectInternal m -> Object -> JavaScriptT m a) -> JavaScriptT m a+callInternalProperty o p = do+  oi <- Lens.use $ internalObject o+  p oi o++callInternalProperty1 :: (Functor m, Monad m) => Object -> (ObjectInternal m -> Object -> a -> JavaScriptT m b) -> a -> JavaScriptT m b+callInternalProperty1 o p a = do+  oi <- Lens.use $ internalObject o+  p oi o a++callInternalProperty2 :: (Functor m, Monad m) => Object -> (ObjectInternal m -> Object -> a -> b -> JavaScriptT m c) -> a -> b -> JavaScriptT m c+callInternalProperty2 o p a b = do+  oi <- Lens.use $ internalObject o+  p oi o a b++callInternalProperty3 :: (Functor m, Monad m) => Object -> (ObjectInternal m -> Object -> a -> b -> c -> JavaScriptT m d) -> a -> b -> c -> JavaScriptT m d+callInternalProperty3 o p a b c = do+  oi <- Lens.use $ internalObject o+  p oi o a b c++callInternalOptionalProperty :: (Functor m, Monad m) => Object -> (ObjectInternal m -> Maybe (Object -> JavaScriptT m a)) -> JavaScriptT m a+callInternalOptionalProperty o p = do+  oi <- Lens.use $ internalObject o+  case p oi of+   Just op -> op o+   Nothing -> newTypeErrorObject Nothing >>= jsThrow++callInternalOptionalProperty1 :: (Functor m, Monad m) =>+                                 Object ->+                                 (ObjectInternal m ->+                                  Maybe (Object -> a -> JavaScriptT m b)) ->+                                 a ->+                                 JavaScriptT m b+callInternalOptionalProperty1 o p a = do+  oi <- Lens.use $ internalObject o+  case p oi of+   Just op -> op o a+   Nothing -> newTypeErrorObject Nothing >>= jsThrow++callInternalOptionalProperty2 :: (Functor m, Monad m) =>+                                 Object ->+                                 (ObjectInternal m ->+                                  Maybe (Object -> a -> b -> JavaScriptT m c)) ->+                                 a -> b ->+                                 JavaScriptT m c+callInternalOptionalProperty2 o p a b = do+  oi <- Lens.use $ internalObject o+  case p oi of+   Just op -> op o a b+   Nothing -> newTypeErrorObject Nothing >>= jsThrow++callInternalOptionalProperty3 :: (Functor m, Monad m) =>+                                 Object ->+                                 (ObjectInternal m ->+                                  Maybe (Object -> a -> b -> c -> JavaScriptT m d)) ->+                                 a -> b -> c ->+                                 JavaScriptT m d+callInternalOptionalProperty3 o p a b c = do+  oi <- Lens.use $ internalObject o+  case p oi of+   Just op -> op o a b c+   Nothing -> newTypeErrorObject Nothing >>= jsThrow++getOwnPropertyImpl :: Object -> String -> JavaScriptM (JSMaybe PropertyDescriptor)+getOwnPropertyImpl o p = do+  oi@(ObjectInternal {..}) <- Lens.use $ internalObject o+  case Map.lookup p objectInternalProperties of+   Just x -> do+     case x of+      PropertyData (DataDescriptor {..}) -> do+        return $ JSJust+          def { propertyDescriptorValue = Just dataDescriptorValue+              , propertyDescriptorWritable = Just dataDescriptorWritable+              , propertyDescriptorEnumerable = Just dataDescriptorEnumerable+              , propertyDescriptorConfigurable = Just dataDescriptorConfigurable }+      PropertyAccessor (AccessorDescriptor {..}) -> do+        return $ JSJust+          def { propertyDescriptorGet = jsMaybe Nothing Just accessorDescriptorGet+              , propertyDescriptorSet = jsMaybe Nothing Just accessorDescriptorSet+              , propertyDescriptorEnumerable = Just accessorDescriptorEnumerable+              , propertyDescriptorConfigurable = Just accessorDescriptorConfigurable }++   Nothing -> return JSNothing++getPropertyImpl :: Object -> String -> JavaScriptM (JSMaybe PropertyDescriptor)+getPropertyImpl o p = do+  prop <- getOwnProperty o p+  case prop of+   JSJust _ -> return prop+   JSNothing -> do+     proto <- prototype o+     case proto of+      JSNull -> return JSNothing+      JSExist po -> do+        getProperty po p++getImpl :: Object -> String -> JavaScriptM Value+getImpl o p = do+  mDesc <- getProperty o p+  case mDesc of+   JSNothing -> return $ inj Undefined+   JSJust desc@(PropertyDescriptor {..}) -> do+     case toDataDescriptor mDesc of+      JSJust DataDescriptor {..} -> return dataDescriptorValue+      JSNothing -> do+        case propertyDescriptorGet of+         Nothing -> return $ inj Undefined+         Just getter -> callNative getter (inj o) (List [])++canPutImpl :: Object -> String -> JavaScriptM Bool+canPutImpl o p = do+  mDesc <- getOwnProperty o p+  case mDesc of+   JSJust desc@(PropertyDescriptor {..}) -> do+     case toAccessorDescriptor mDesc of+      JSJust AccessorDescriptor {..} -> do+       case accessorDescriptorSet of+        JSNothing -> return False+        _ -> return True+      _ -> return $ fromJust propertyDescriptorWritable+   JSNothing -> do+     nProto <- prototype o+     case nProto of+      JSNull -> extensible o+      JSExist proto -> do+        mInherited <- getProperty proto p+        case mInherited of+         JSNothing -> extensible o+         JSJust inherited@(PropertyDescriptor {..}) -> do+           if isAccessorDescriptor mInherited+             then do+             case propertyDescriptorSet of+              Nothing -> return False+              _ -> return True+             else do+             e <- extensible o+             if not e+               then return False+               else return $ fromJust propertyDescriptorWritable++putImpl :: Object -> String -> Value -> Bool -> JavaScriptM ()+putImpl o p v throw = do+  c <- canPut o p+  if not c+    then do+    if throw+      then newTypeErrorObject Nothing >>= jsThrow+      else return ()+    else do+    ownDesc <- getOwnProperty o p+    if isDataDescriptor ownDesc+      then do+      let valueDesc = def { propertyDescriptorValue = Just v }+      defineOwnProperty o p valueDesc throw+      return ()+      else do+      desc <- getProperty o p+      if isAccessorDescriptor desc+        then do+        let JSJust (PropertyDescriptor {..}) = desc+        let setter = fromJust propertyDescriptorSet+        callNative setter (inj o) (List [v])+        return ()+        else do+        let newDesc = def {+              propertyDescriptorValue = Just v,+              propertyDescriptorWritable = Just True,+              propertyDescriptorEnumerable = Just True,+              propertyDescriptorConfigurable = Just True }+        defineOwnProperty o p newDesc throw+        return ()+  return ()++hasPropertyImpl :: Object -> String -> JavaScriptM Bool+hasPropertyImpl o p = do+  desc <- getProperty o p+  case desc of+   JSNothing -> return False+   _ -> return True++deleteImpl :: Object -> String -> Bool -> JavaScriptM Bool+deleteImpl o p throw = do+  desc <- getOwnProperty o p+  case desc of+   JSNothing -> return True+   JSJust (PropertyDescriptor {..}) -> do+     if propertyDescriptorConfigurable == Just True+       then do+       return True+       else do+       if throw+         then newTypeErrorObject Nothing >>= jsThrow+         else return False++data Hint+  = HintString+  | HintNumber+  deriving (Eq, Show)++defaultValueImpl :: Object -> Maybe Hint -> JavaScriptM Primitive+defaultValueImpl o (Just HintString) = do+  f <- get o "toString"+  mc <- toCallable f+  case mc of+   Just c -> do+     str <- call c (inj o) (List [])+     case prj str of+      Just p -> return p+      Nothing -> valueOfBranch+   Nothing -> valueOfBranch+  where+    valueOfBranch = do+      valueOf <- get o "valueOf"+      mc <- toCallable valueOf+      case mc of+       Just c -> do+         val <- call c (inj o) (List [])+         case val of+          CallValuePrimitive p -> return p+          _ -> newTypeErrorObject Nothing >>= jsThrow+       Nothing -> newTypeErrorObject Nothing >>= jsThrow++defaultValueImpl o (Just HintNumber) = do+  valueOf <- get o "valueOf"+  mc <- toCallable valueOf+  case mc of+   Just c -> do+     val <- call c (inj o) (List [])+     case prj val of+      Just p -> return p+      Nothing -> toStringBranch+   Nothing -> toStringBranch+  where+    toStringBranch = do+      f <- get o "toString"+      mc <- toCallable f+      case mc of+       Just c -> do+         str <- call c (inj o) (List [])+         case str of+          CallValuePrimitive p -> return p+          _ -> newTypeErrorObject Nothing >>= jsThrow+       Nothing -> newTypeErrorObject Nothing >>= jsThrow++defaultValueImpl o Nothing = defaultValueImpl o (Just HintNumber)++functionPrototypeCallImpl :: (Monad m) => InternalCallType m+functionPrototypeCallImpl _ _ _ = return (inj Undefined)++newFunctionObject :: Maybe FormalParamList ->+                     FuncBody ->+                     LexicalEnvironment ->+                     Bool ->+                     JavaScriptM Object+newFunctionObject mfpl fb scope strict = do+  i <- createNextInternalId+  function <- Lens.use functionPrototypeObject+  let f = Object i+      names = case mfpl of+               Just fpl ->+                 foldFormalParamList (\(Ident (IdentName s)) -> (s:)) [] fpl+               Nothing -> []+      len = length names+      oi = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist function),+        objectInternalClass             = "Function",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = functionGetImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Just functionConstructImpl,+        objectInternalCall              = Just functionCallImpl,+        objectInternalHasInstance       = Just functionHasInstanceImpl,+        objectInternalScope             = Just $ const $ return scope,+        objectInternalFormalParameters  = Just $ const $ return $ List names,+        objectInternalCode              = Just $ const $ return fb,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }++  mInternalObject f ?= oi+  defineOwnProperty+    f+    "length"+    def {+      propertyDescriptorValue        = Just $ inj (Number $ fromIntegral len),+      propertyDescriptorWritable     = Just False,+      propertyDescriptorEnumerable   = Just False,+      propertyDescriptorConfigurable = Just False }+    False+  proto <- newObjectObject Nothing+  defineOwnProperty+    proto+    "constructor"+    def {+      propertyDescriptorValue        = Just $ inj f,+      propertyDescriptorWritable     = Just True,+      propertyDescriptorEnumerable   = Just False,+      propertyDescriptorConfigurable = Just True }+    False+  defineOwnProperty+    f+    "prototype"+    def {+      propertyDescriptorValue        = Just $ inj proto,+      propertyDescriptorWritable     = Just True,+      propertyDescriptorEnumerable   = Just False,+      propertyDescriptorConfigurable = Just False }+    False+  if strict+    then do+    thrower <- Lens.use throwTypeErrorObject+    defineOwnProperty+      f+      "caller"+      def {+        propertyDescriptorGet          = Just thrower,+        propertyDescriptorSet          = Just thrower,+        propertyDescriptorEnumerable   = Just False,+        propertyDescriptorConfigurable = Just False }+      False+    return f+    else return f+  where+    foldFormalParamList f a (FormalParamList i) = f i a+    foldFormalParamList f a (FormalParamListCons fpl i) =+      f i (foldFormalParamList f a fpl)++functionConstructorCallImpl :: (Functor m, Monad m) =>+                               InternalCallType m+functionConstructorCallImpl f _ args =+  inj <$>functionConstructorConstructImpl f args++functionConstructorConstructImpl :: (Functor m, Monad m) =>+                                    InternalConstructType m+functionConstructorConstructImpl f args = error "functionConstructorConstructImpl"++functionCallImpl :: (Functor m, Monad m) => InternalCallType m+functionCallImpl f this args = do+  fpl <- formalParameters f+  enterFunctionContext f this args+  mc <- Lens.use $ internalObject f . internalCode+  result <- case mc of+   Nothing ->+     return $ Completion CompletionTypeNormal (inj Undefined) Nothing+   Just c -> do+     fb <- c f+     interpret fb+  popContext+  case result of+   Completion CompletionTypeThrow (Just v) _ -> jsThrow v+   Completion CompletionTypeReturn (Just v) _ -> return (inj v)+   _ -> return (inj Undefined)++functionGetImpl :: (Functor m, Monad m) => InternalGetType m+functionGetImpl f p = do+  v <- getImpl f p+  return v++functionConstructImpl :: (Functor m, Monad m) => InternalConstructType m+functionConstructImpl f l = do+  i <- createNextInternalId+  proto <- get f "prototype"+  p <- case proto of+           ValueObject o -> return o+           _ -> Lens.use objectPrototypeObject+  let obj = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Object",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject f ?= oi+  result <- call f (inj obj) l+  case result of+   CallValueObject o -> return o+   _ -> return obj++functionHasInstanceImpl :: (Functor m, Monad m) => InternalHasInstanceType m+functionHasInstanceImpl = error "functionHasInstanceImpl"++newArrayObject :: [Value] -> JavaScriptM Object+newArrayObject as = do+  let properties =+        [ ("length", PropertyData $+                     def { dataDescriptorValue =+                              inj $ Number (fromIntegral $ length as),+                           dataDescriptorWritable = True,+                           dataDescriptorEnumerable = True,+                           dataDescriptorConfigurable = True }) ] +++        (snd $+         foldl+         (\(n, ps) a -> (n+1, (show n, PropertyData $+                                       def { dataDescriptorValue = a,+                                             dataDescriptorWritable = True,+                                             dataDescriptorEnumerable = True,+                                             dataDescriptorConfigurable = True }):ps))+         (0 :: Int, []) as)+  i <- createNextInternalId+  let a = Object i+  p <- Lens.use arrayPrototypeObject+  let oi = ObjectInternal {+    objectInternalProperties        = Map.fromList properties,+    objectInternalPrototype         = const $ return (JSExist p),+    objectInternalClass             = "Array",+    objectInternalExtensible        = const $ return True,+    objectInternalGet               = getImpl,+    objectInternalGetOwnProperty    = getOwnPropertyImpl,+    objectInternalGetProperty       = getPropertyImpl,+    objectInternalPut               = putImpl,+    objectInternalCanPut            = canPutImpl,+    objectInternalHasProperty       = hasPropertyImpl,+    objectInternalDelete            = deleteImpl,+    objectInternalDefaultValue      = defaultValueImpl,+    objectInternalDefineOwnProperty = arrayDefineOwnPropertyImpl,+    objectInternalPrimitiveValue    = Nothing,+    objectInternalConstruct         = Nothing,+    objectInternalCall              = Nothing,+    objectInternalHasInstance       = Nothing,+    objectInternalScope             = Nothing,+    objectInternalFormalParameters  = Nothing,+    objectInternalCode              = Nothing,+    objectInternalTargetFunction    = Nothing,+    objectInternalBoundThis         = Nothing,+    objectInternalBoundArguments    = Nothing,+    objectInternalMatch             = Nothing,+    objectInternalParameterMap      = Nothing }+  mInternalObject a ?= oi+  return a++arrayConstructorCallImpl :: (Functor m, Monad m) => InternalCallType m+arrayConstructorCallImpl a _ args =+  inj <$> arrayConstructorConstructImpl a args++arrayConstructorConstructImpl :: InternalConstructType m+arrayConstructorConstructImpl a args = undefined++arrayDefineOwnPropertyImpl :: (Functor m, Monad m) =>+                              InternalDefineOwnPropertyType m+arrayDefineOwnPropertyImpl a p desc throw = do+  JSJust oldLenDesc <- getOwnProperty a "length" >>= return . toDataDescriptor+  oldLen <- toNumber $ dataDescriptorValue oldLenDesc+  if p == "length"+    then do+    case propertyDescriptorValue desc of+     Nothing -> defineOwnPropertyImpl a p desc throw+     Just v -> do+       newLen <- toUint32 v+       curLen <- toNumber v+       if fromIntegral newLen /= curLen+         then newRangeErrorObject Nothing >>= jsThrow+         else do+         let newLenDesc = desc {+               propertyDescriptorValue = Just (inj $ Number $ fromIntegral newLen) }+         if fromIntegral newLen >= oldLen+           then do+           defineOwnPropertyImpl a "length" newLenDesc throw+           else do+           if not $ dataDescriptorWritable oldLenDesc+             then reject+             else do+             let (newWritable, newLenDesc') =+                   case propertyDescriptorWritable newLenDesc of+                   Just False -> (False, newLenDesc {+                                     propertyDescriptorWritable = Just True })+                   _ -> (True, newLenDesc)+             succeeded <- defineOwnPropertyImpl a "length" newLenDesc' throw+             if not succeeded+               then return False+               else do+               r <- deleteLoop newLen oldLen newLenDesc' newWritable+               if not r+                 then return r+                 else do+                 when (not newWritable) $ void $+                   defineOwnPropertyImpl a "lenght" (def { propertyDescriptorWritable = Just False }) False+                 return True+    else do+    iai <- isArrayIndex p+    if iai+      then do+      index <- toUint32 p+      if fromIntegral index >= oldLen && dataDescriptorWritable oldLenDesc == False+        then reject+        else do+        succeeded <- defineOwnPropertyImpl a p desc False+        if not succeeded+          then reject+          else do+          when (fromIntegral index >= oldLen) $ void $ do+            let oldLenDesc' = oldLenDesc {+                  dataDescriptorValue = inj $ Number $ fromIntegral (index + 1) }+            defineOwnPropertyImpl a "length" (fromDataDescriptor oldLenDesc') False+          return True+      else defineOwnPropertyImpl a p desc throw++  where+    deleteLoop :: UInt32 -> Number -> PropertyDescriptor -> Bool -> JavaScriptM Bool+    deleteLoop newLen oldLen newLenDesc newWritable = do+      if fromIntegral newLen < oldLen+        then do+        let oldLen' = oldLen - 1+        deleteSucceeded <- toString oldLen >>= \s -> delete a s False+        if (not deleteSucceeded)+          then do+          let writable =+                if not newWritable+                then Just False+                else propertyDescriptorWritable newLenDesc+              newLenDesc' = newLenDesc {+                propertyDescriptorValue = Just $ inj (oldLen' + 1),+                propertyDescriptorWritable = writable }+          defineOwnPropertyImpl a "length" newLenDesc' False+          reject+          else+          deleteLoop newLen oldLen' newLenDesc newWritable+        else return True++    reject :: JavaScriptM Bool+    reject =+      if throw+      then newTypeErrorObject Nothing >>= jsThrow+      else return False++isArrayIndex :: String -> JavaScriptM Bool+isArrayIndex p = do+  ui <- toUint32 p+  c <- toString (Number $ fromIntegral ui)+  return $ c == p && ui /= 2 ^ (32 :: Int) - 1++newBooleanObject :: Value ->+                    JavaScriptM Object+newBooleanObject v = do+  i <- createNextInternalId+  boolean <- Lens.use booleanPrototypeObject+  let b = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist boolean),+        objectInternalClass             = "Boolean",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just $ const $ return $ inj (toBoolean v),+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject b ?= oi+  return b++booleanConstructorCallImpl :: (Functor m, Monad m) =>+                              InternalCallType m+booleanConstructorCallImpl _ _ (List vs) = do+  case vs of+   (v:_) -> return . inj $ toBoolean v+   _ -> return (inj False)++booleanConstructorConstructImpl :: (Functor m, Monad m) =>+                                   InternalConstructType m+booleanConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newBooleanObject v+   _ -> newBooleanObject (inj False)++newNumberObject :: Maybe Value ->+                   JavaScriptM Object+newNumberObject mv = do+  i <- createNextInternalId+  nv <- maybe (return (Number 0)) toNumber mv+  number <- Lens.use numberPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist number),+        objectInternalClass             = "Number",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just $ const $ return $ inj nv,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++numberConstructorCallImpl :: (Functor m, Monad m) =>+                             InternalCallType m+numberConstructorCallImpl _ _ (List vs) = do+  case vs of+   (v:_) -> inj <$> toNumber v+   _ -> return . inj $ Number 0++numberConstructorConstructImpl :: (Functor m, Monad m) =>+                                  InternalConstructType m+numberConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newNumberObject (Just v)+   _ -> newNumberObject Nothing++newErrorObject :: Maybe Value ->+                  JavaScriptM Object+newErrorObject mv = do+  i <- createNextInternalId+  properties <- case mv of+                 Nothing -> return []+                 Just (ValueUndefined _) -> return []+                 Just v -> do+                   s <- toString v+                   return [ ("message", PropertyData $ DataDescriptor {+                                dataDescriptorValue          = inj s,+                                dataDescriptorWritable       = False,+                                dataDescriptorEnumerable     = False,+                                dataDescriptorConfigurable   = False }) ]+  error <- Lens.use errorPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.fromList properties,+        objectInternalPrototype         = const $ return (JSExist error),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++errorConstructorCallImpl :: (Functor m, Monad m) =>+                            InternalCallType m+errorConstructorCallImpl e _ args = do+  inj <$> errorConstructorConstructImpl e args++errorConstructorConstructImpl :: (Functor m, Monad m) =>+                                 InternalConstructType m+errorConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newErrorObject (Just v)+   _ -> newErrorObject Nothing++errorPrototypeToStringCallImpl :: (Functor m, Monad m) => InternalCallType m+errorPrototypeToStringCallImpl _ v _ = do+  case v of+   ValueObject o -> do+     name <- get o "name"+     name' <- case name of+               ValueUndefined _ -> return "Error"+               _ -> toString name+     msg <- get o "message"+     msg' <- case msg of+              ValueUndefined _ -> return ""+              _ -> toString msg+     if null name'+       then return (inj msg')+       else+       if null msg'+       then return (inj name')+       else return (inj $ name' ++ ": " ++ msg')+   _ -> newTypeErrorObject Nothing >>= jsThrow++newEvalErrorObject :: Maybe Value -> JavaScriptM Object+newEvalErrorObject mv = do+  i <- createNextInternalId+  properties <- case mv of+                 Nothing -> return []+                 Just (ValueUndefined _) -> return []+                 Just v -> do+                   s <- toString v+                   return [ ("message", PropertyData $ DataDescriptor {+                                dataDescriptorValue          = inj s,+                                dataDescriptorWritable       = False,+                                dataDescriptorEnumerable     = False,+                                dataDescriptorConfigurable   = False }) ]+  p <- Lens.use evalErrorPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.fromList properties,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++evalErrorConstructorCallImpl :: (Functor m, Monad m) =>+                                InternalCallType m+evalErrorConstructorCallImpl e _ args = do+  inj <$> evalErrorConstructorConstructImpl e args++evalErrorConstructorConstructImpl :: (Functor m, Monad m) =>+                                     InternalConstructType m+evalErrorConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newEvalErrorObject (Just v)+   _ -> newEvalErrorObject Nothing++newRangeErrorObject :: Maybe Value -> JavaScriptM Object+newRangeErrorObject mv = do+  i <- createNextInternalId+  properties <- case mv of+                 Nothing -> return []+                 Just (ValueUndefined _) -> return []+                 Just v -> do+                   s <- toString v+                   return [ ("message", PropertyData $ DataDescriptor {+                                dataDescriptorValue          = inj s,+                                dataDescriptorWritable       = False,+                                dataDescriptorEnumerable     = False,+                                dataDescriptorConfigurable   = False }) ]+  p <- Lens.use rangeErrorPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.fromList properties,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++rangeErrorConstructorCallImpl :: (Functor m, Monad m) =>+                                 InternalCallType m+rangeErrorConstructorCallImpl e _ args = do+  inj <$> rangeErrorConstructorConstructImpl e args++rangeErrorConstructorConstructImpl :: (Functor m, Monad m) =>+                                      InternalConstructType m+rangeErrorConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newRangeErrorObject (Just v)+   _ -> newRangeErrorObject Nothing++newReferenceErrorObject :: Maybe Value -> JavaScriptM Object+newReferenceErrorObject mv = do+  i <- createNextInternalId+  properties <- case mv of+                 Nothing -> return []+                 Just (ValueUndefined _) -> return []+                 Just v -> do+                   s <- toString v+                   return [ ("message", PropertyData $ DataDescriptor {+                                dataDescriptorValue          = inj s,+                                dataDescriptorWritable       = False,+                                dataDescriptorEnumerable     = False,+                                dataDescriptorConfigurable   = False }) ]+  p <- Lens.use referenceErrorPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.fromList properties,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++referenceErrorConstructorCallImpl :: (Functor m, Monad m) =>+                                     InternalCallType m+referenceErrorConstructorCallImpl e _ args = do+  inj <$> referenceErrorConstructorConstructImpl e args++referenceErrorConstructorConstructImpl :: (Functor m, Monad m) =>+                                          InternalConstructType m+referenceErrorConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newReferenceErrorObject (Just v)+   _ -> newReferenceErrorObject Nothing++newSyntaxErrorObject :: Maybe Value -> JavaScriptM Object+newSyntaxErrorObject mv = do+  i <- createNextInternalId+  properties <- case mv of+                 Nothing -> return []+                 Just (ValueUndefined _) -> return []+                 Just v -> do+                   s <- toString v+                   return [ ("message", PropertyData $ DataDescriptor {+                                dataDescriptorValue          = inj s,+                                dataDescriptorWritable       = False,+                                dataDescriptorEnumerable     = False,+                                dataDescriptorConfigurable   = False }) ]+  p <- Lens.use syntaxErrorPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.fromList properties,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++syntaxErrorConstructorCallImpl :: (Functor m, Monad m) =>+                                  InternalCallType m+syntaxErrorConstructorCallImpl e _ args = do+  inj <$> syntaxErrorConstructorConstructImpl e args++syntaxErrorConstructorConstructImpl :: (Functor m, Monad m) =>+                                       InternalConstructType m+syntaxErrorConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newSyntaxErrorObject (Just v)+   _ -> newSyntaxErrorObject Nothing++newTypeErrorObject :: Maybe Value -> JavaScriptM Object+newTypeErrorObject mv = do+  i <- createNextInternalId+  properties <- case mv of+                 Nothing -> return []+                 Just (ValueUndefined _) -> return []+                 Just v -> do+                   s <- toString v+                   return [ ("message", PropertyData $ DataDescriptor {+                                dataDescriptorValue          = inj s,+                                dataDescriptorWritable       = False,+                                dataDescriptorEnumerable     = False,+                                dataDescriptorConfigurable   = False }) ]+  p <- Lens.use typeErrorPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.fromList properties,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++typeErrorConstructorCallImpl :: (Functor m, Monad m) =>+                                InternalCallType m+typeErrorConstructorCallImpl e _ args = do+  inj <$> typeErrorConstructorConstructImpl e args++typeErrorConstructorConstructImpl :: (Functor m, Monad m) =>+                                     InternalConstructType m+typeErrorConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newTypeErrorObject (Just v)+   _ -> newTypeErrorObject Nothing++newUriErrorObject :: Maybe Value -> JavaScriptM Object+newUriErrorObject mv = do+  i <- createNextInternalId+  properties <- case mv of+                 Nothing -> return []+                 Just (ValueUndefined _) -> return []+                 Just v -> do+                   s <- toString v+                   return [ ("message", PropertyData $ DataDescriptor {+                                dataDescriptorValue          = inj s,+                                dataDescriptorWritable       = False,+                                dataDescriptorEnumerable     = False,+                                dataDescriptorConfigurable   = False }) ]+  p <- Lens.use uriErrorPrototypeObject+  let n = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.fromList properties,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Error",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject n ?= oi+  return n++uriErrorConstructorCallImpl :: (Functor m, Monad m) =>+                               InternalCallType m+uriErrorConstructorCallImpl e _ args = do+  inj <$> uriErrorConstructorConstructImpl e args++uriErrorConstructorConstructImpl :: (Functor m, Monad m) =>+                                    InternalConstructType m+uriErrorConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newUriErrorObject (Just v)+   _ -> newUriErrorObject Nothing++newStringObject :: Maybe Value ->+                   JavaScriptM Object+newStringObject mv = do+  i <- createNextInternalId+  sv <- maybe (return "") toString mv+  string <- Lens.use stringPrototypeObject+  let s = Object i+      oi = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist string),+        objectInternalClass             = "String",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = getImpl,+        objectInternalGetOwnProperty    = stringGetOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Just $ stringPrimitiveValueImpl mv,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+  mInternalObject s ?= oi+  return s++stringConstructorCallImpl :: (Functor m, Monad m) => InternalCallType m+stringConstructorCallImpl s _ (List ss) = do+  case ss of+   (s:_) -> inj <$> toString s+   _ -> return (inj "")++stringConstructorConstructImpl :: (Functor m, Monad m) =>+                                  InternalConstructType m+stringConstructorConstructImpl s (List vs) = do+  case vs of+   (v:_) -> newStringObject (Just v)+   _ -> newStringObject Nothing++stringGetOwnPropertyImpl :: (Functor m, Monad m) =>+                            InternalGetOwnPropertyType m+stringGetOwnPropertyImpl s p = do+  desc <- getOwnPropertyImpl s p+  case desc of+   JSJust d -> return $ JSJust d+   JSNothing -> do+     ns <- toInteger p >>= toString . Number . fromIntegral . abs+     if not (ns == p)+       then return (inj Undefined)+       else do+       PrimitiveString str <- primitiveValue s+       index <- toInteger p+       let len = length str+       if fromIntegral len <= index+         then return (inj Undefined)+         else do+         let resultStr = [str !! fromInteger index]+         return $ JSJust def {+           propertyDescriptorValue        = Just (inj resultStr),+           propertyDescriptorWritable     = Just False,+           propertyDescriptorEnumerable   = Just True,+           propertyDescriptorConfigurable = Just False }+++stringPrimitiveValueImpl :: (Functor m, Monad m) =>+                            Maybe Value -> InternalPrimitiveValueType m+stringPrimitiveValueImpl mv _ = do+  case mv of+   Just v -> inj <$> toString v+   Nothing -> return (inj "")++regExpMatchImpl = undefined++createArgumentsObject :: Object ->+                         List String ->+                         List Value ->+                         LexicalEnvironment ->+                         Bool ->+                         JavaScriptM Object+createArgumentsObject func (List names) (List args) env strict = do+  let len = length args+  obj <- newObjectObject Nothing+  object <- Lens.use objectPrototypeObject+  internalObject obj %= \oi -> oi { objectInternalClass = "Arguments",+                                    objectInternalPrototype = const $ return (JSExist object) }+  defineOwnProperty+    obj+    "length"+    (def {+        propertyDescriptorValue = Just (inj (Number (fromIntegral len))),+        propertyDescriptorWritable = Just True,+        propertyDescriptorEnumerable = Just False,+        propertyDescriptorConfigurable = Just True })+     False+  return obj++data Code+  = CodeGlobal Program+  | CodeEval (Maybe SourceElements)+  | CodeFunction Object (List Value)++createNextInternalId :: JavaScriptM InternalId+createNextInternalId = do+  next <- Lens.use nextInternalId+  nextInternalId .= succ next+  return next++newObjectObject :: Maybe Value -> JavaScriptM Object+newObjectObject mv =+  case mv of+   Just v ->+     case v of+      ValueObject o -> do+        return o+      _ ->+        if typeOf v == TypeString ||+           typeOf v == TypeBoolean ||+           typeOf v == TypeNumber+        then toObject v+        else createObject+   _ -> createObject+  where+    createObject = do+      i <- createNextInternalId+      let o = Object i+      p <- Lens.use objectPrototypeObject+      let oi = ObjectInternal {+        objectInternalProperties        = Map.empty,+        objectInternalPrototype         = const $ return (JSExist p),+        objectInternalClass             = "Object",+        objectInternalExtensible        = const $ return True,+        objectInternalGet               = functionGetImpl,+        objectInternalGetOwnProperty    = getOwnPropertyImpl,+        objectInternalGetProperty       = getPropertyImpl,+        objectInternalPut               = putImpl,+        objectInternalCanPut            = canPutImpl,+        objectInternalHasProperty       = hasPropertyImpl,+        objectInternalDelete            = deleteImpl,+        objectInternalDefaultValue      = defaultValueImpl,+        objectInternalDefineOwnProperty = defineOwnPropertyImpl,+        objectInternalPrimitiveValue    = Nothing,+        objectInternalConstruct         = Nothing,+        objectInternalCall              = Nothing,+        objectInternalHasInstance       = Nothing,+        objectInternalScope             = Nothing,+        objectInternalFormalParameters  = Nothing,+        objectInternalCode              = Nothing,+        objectInternalTargetFunction    = Nothing,+        objectInternalBoundThis         = Nothing,+        objectInternalBoundArguments    = Nothing,+        objectInternalMatch             = Nothing,+        objectInternalParameterMap      = Nothing }+      mInternalObject o ?= oi+      return o++objectConstructorCallImpl :: (Functor m, Monad m) =>+                             InternalCallType m+objectConstructorCallImpl o _ lvs@(List vs) =+  case vs of+   (ValueNull _:_) -> inj <$> objectConstructorConstructImpl o lvs+   (ValueUndefined _:_) -> inj <$> objectConstructorConstructImpl o lvs+   [] -> inj <$> objectConstructorConstructImpl o lvs+   (v:_) -> inj <$> toObject v++objectConstructorConstructImpl :: (Functor m, Monad m) =>+                                  InternalConstructType m+objectConstructorConstructImpl _ (List vs) = do+  case vs of+   (v:_) -> newObjectObject (Just v)+   _ -> newObjectObject Nothing+++defineOwnPropertyImpl :: (Functor m, Monad m) =>+                         InternalDefineOwnPropertyType m+defineOwnPropertyImpl o p desc throw = do+  mCurrent <- getOwnProperty o p+  e <- extensible o+  case (mCurrent, e) of+   (JSNothing, False) -> reject+   (JSNothing, True) -> do+     if isGenericDescriptor (JSJust desc) || isDataDescriptor (JSJust desc)+       then do+       let dp = PropertyData+                DataDescriptor {+                  dataDescriptorValue        =+                     maybe (inj Undefined) id (propertyDescriptorValue desc),+                  dataDescriptorWritable     =+                    maybe False id (propertyDescriptorWritable desc),+                  dataDescriptorEnumerable   =+                    maybe False id (propertyDescriptorEnumerable desc),+                  dataDescriptorConfigurable =+                    maybe False id (propertyDescriptorConfigurable desc) }+       property o p ?= dp+       else do+       let ap = PropertyAccessor+                AccessorDescriptor {+                  accessorDescriptorGet          =+                     maybe JSNothing JSJust (propertyDescriptorGet desc),+                  accessorDescriptorSet          =+                    maybe JSNothing JSJust (propertyDescriptorSet desc),+                  accessorDescriptorEnumerable   =+                    maybe False id (propertyDescriptorEnumerable desc),+                  accessorDescriptorConfigurable =+                    maybe False id (propertyDescriptorConfigurable desc) }+       property o p ?= ap+     return True+   (JSJust current, _) -> do+     if (propertyDescriptorValue desc == Nothing ||+         (sameValue <$>+          propertyDescriptorValue desc <*>+          propertyDescriptorValue current) == Just True) &&+        (propertyDescriptorGet desc == Nothing ||+         (sameValue <$>+          propertyDescriptorGet desc <*>+          propertyDescriptorGet current) == Just True) &&+        (propertyDescriptorSet desc == Nothing ||+         (sameValue <$>+          propertyDescriptorSet desc <*>+          propertyDescriptorSet current) == Just True) &&+        (propertyDescriptorWritable desc == Nothing ||+         (sameValue <$>+          propertyDescriptorWritable desc <*>+          propertyDescriptorWritable current) == Just True) &&+        (propertyDescriptorEnumerable desc == Nothing ||+         (sameValue <$>+          propertyDescriptorEnumerable desc <*>+          propertyDescriptorEnumerable current) == Just True) &&+        (propertyDescriptorConfigurable desc == Nothing ||+         (sameValue <$>+          propertyDescriptorConfigurable desc <*>+          propertyDescriptorConfigurable current) == Just True)+       then return True+       else+       if (propertyDescriptorConfigurable current == Just False)+       then+         if (propertyDescriptorConfigurable desc == Just True)+         then reject+         else+           if ((==) <$>+               (propertyDescriptorEnumerable desc) <*>+               (propertyDescriptorEnumerable current)) ==+              Just False+           then reject+           else checkDescriptor current+       else checkDescriptor current+  where+    reject =+      if throw+      then newTypeErrorObject Nothing >>= jsThrow+      else return False+    checkDescriptor current = do+      if isGenericDescriptor (JSJust desc)+        then setValue+        else do+        case (isDataDescriptor (JSJust current), isDataDescriptor (JSJust desc)) of+         (cb, db) | cb /= db -> do+                      if propertyDescriptorConfigurable current == Just False+                        then reject+                        else+                        if isDataDescriptor (JSJust current)+                        then do+                          error "Convert B"+                        else do+                          error "Convert C"+         (True, True) -> do+           if propertyDescriptorConfigurable current == Just False+             then+             if propertyDescriptorWritable current == Just False &&+                propertyDescriptorWritable desc == Just True+             then reject+             else+               if propertyDescriptorWritable current == Just False &&+                  propertyDescriptorWritable desc == Just True+               then reject+               else+                 case (propertyDescriptorWritable current,+                       propertyDescriptorValue desc,+                       propertyDescriptorValue current) of+                  (Just False, Just dv, Just cv) | not $ sameValue dv cv -> reject+                  _ -> setValue+             else setValue+         _ -> do+           if propertyDescriptorConfigurable current == Just False+             then do+             case (propertyDescriptorSet desc,+                   propertyDescriptorSet current) of+              (Just ds, Just cs) | not $ sameValue ds cs -> reject+              _ -> do+                case (propertyDescriptorSet desc,+                      propertyDescriptorGet current) of+                 (Just dg, Just cg) | not $ sameValue dg cg -> reject+                 _ -> setValue+             else setValue+    setValue = do+      property o p %=+        \(Just prop) ->+         Just $+         case prop of+          PropertyData prop ->+            PropertyData prop {+              dataDescriptorValue        =+                 maybe+                 (dataDescriptorValue prop)+                 id+                 (propertyDescriptorValue desc),+              dataDescriptorWritable     =+                maybe+                (dataDescriptorWritable prop)+                id+                (propertyDescriptorWritable desc),+              dataDescriptorEnumerable   =+                maybe+                (dataDescriptorEnumerable prop)+                id+                (propertyDescriptorEnumerable desc),+              dataDescriptorConfigurable =+                maybe+                (dataDescriptorConfigurable prop)+                id+                (propertyDescriptorConfigurable desc) }+          PropertyAccessor prop ->+            PropertyAccessor prop {+              accessorDescriptorGet          =+                 maybe+                 (accessorDescriptorGet prop)+                 JSJust+                 (propertyDescriptorGet desc),+              accessorDescriptorSet          =+                   maybe+                   (accessorDescriptorSet prop)+                   JSJust+                   (propertyDescriptorSet desc),+              accessorDescriptorEnumerable   =+                maybe+                (accessorDescriptorEnumerable prop)+                id+                (propertyDescriptorEnumerable desc),+              accessorDescriptorConfigurable =+                maybe+                (accessorDescriptorConfigurable prop)+                id+                (propertyDescriptorConfigurable desc) }+      return True++toPrimitive :: (SubType v Value) =>+               v -> Maybe Hint -> JavaScriptM Primitive+toPrimitive v mpt =+  case inj v of+   ValueObject o -> defaultValue o mpt+   ValuePrimitive p -> return p++toBoolean :: (SubType v Value) =>+             v -> Bool+toBoolean v =+  case (inj v :: Value) of+   (ValueUndefined _) -> False+   (ValueNull _) -> False+   (ValueBool b) -> b+   (ValueNumber n) ->+     if isNaN n || n == Number 0+     then False+     else True+   (ValueString s) -> not $ null s+   (ValueObject _) -> True++toNumber :: (SubType v Value) =>+            v -> JavaScriptM Number+toNumber v =+  case (inj v :: Value) of+   ValueUndefined _ -> return nan+   ValueNull _ -> return $ Number 0+   ValueBool b -> return $ if b then Number 1 else Number 0+   ValueNumber n -> return n+   ValueString s -> do+     case parseString s of+      Just d -> return $ Number d+      Nothing -> return nan+   ValueObject _ -> toPrimitive v (Just HintNumber) >>= toNumber++toInteger :: (SubType v Value) =>+             v -> JavaScriptM Integer+toInteger v = do+  number <- toNumber v+  if isNaN number+    then return 0+    else return $ floor (signum number) * floor (abs number)++toInt32 :: (SubType v Value) =>+           v -> JavaScriptM Int32+toInt32 v = do+  number <- toNumber v+  if isNaN number || isInfinite number || number == Number 0+    then return 0+    else do+    let posInt = floor (signum number) * floor (abs number)+        int32bit = posInt `mod` 2 ^ (32 :: Int)+    if int32bit >= 2 ^ (31 :: Int)+      then return $ fromInteger $ int32bit - 2 ^ (32 :: Int)+      else return $ fromInteger int32bit++toUint32 :: (SubType v Value) =>+            v -> JavaScriptM UInt32+toUint32 v = do+  number <- toNumber v+  if isNaN number || isInfinite number || number == Number 0+    then return 0+    else do+    let posInt = floor (signum number) * floor (abs number)+        int32bit = posInt `mod` 2 ^ (32 :: Int)+    return $ fromInteger int32bit++toUint16 :: (SubType v Value) =>+            v -> JavaScriptM UInt16+toUint16 v = do+  number <- toNumber v+  if isNaN number || isInfinite number || number == Number 0+    then return 0+    else do+    let posInt = floor (signum number) * floor (abs number)+        int16bit = posInt `mod` 2 ^ (16 :: Int)+    return $ fromInteger int16bit++primitiveToString :: (SubType v Primitive) =>+                     v -> String+primitiveToString p =+  case (inj p :: Primitive) of+   PrimitiveUndefined _ -> "undefined"+   PrimitiveNull _ -> "null"+   PrimitiveBool b ->  if b then "true" else "false"+   PrimitiveNumber (Number n) -> show n+   PrimitiveString s -> s++toString :: (SubType v Value) =>+            v -> JavaScriptM String+toString v =+  case (inj v :: Value) of+   ValuePrimitive p -> return $ primitiveToString p+   ValueObject _ -> toPrimitive v (Just HintString) >>= toString++toObject :: Value -> JavaScriptM Object+toObject v =+  case v of+   ValueUndefined _ -> newTypeErrorObject Nothing >>= jsThrow+   ValueNull _ -> newTypeErrorObject Nothing >>= jsThrow+   ValueBool b -> newBooleanObject (inj b)+   ValueNumber n -> newNumberObject (inj n)+   ValueString s -> newStringObject (inj s)+   ValueObject o -> return o++checkObjectCoercible :: Value -> JavaScriptM ()+checkObjectCoercible v = void $ toObjectCoercible v++toObjectCoercible :: Value -> JavaScriptM (Object + Number + String + Bool)+toObjectCoercible (ValueUndefined _) = newTypeErrorObject Nothing >>= jsThrow+toObjectCoercible (ValueNull _) = newTypeErrorObject Nothing >>= jsThrow+toObjectCoercible (ValueObject o) = return $ inj o+toObjectCoercible (ValueNumber n) = return $ inj n+toObjectCoercible (ValueString s) = return $ inj s+toObjectCoercible (ValueBool b) = return $ inj b++isCallable :: Value -> JavaScriptM Bool+isCallable v = isJust <$> toCallable v++toCallable :: Value -> JavaScriptM (Maybe Object)+toCallable (ValueObject o) = do+  ObjectInternal {..} <- Lens.use $ internalObject o+  if isJust objectInternalCall+    then return $ Just o+    else return Nothing+toCallable _ = return Nothing++sameValue :: (SubType v1 Value, SubType v2 Value) =>+             v1 -> v2 -> Bool+sameValue x y = do+  case (inj x :: Value, inj y :: Value) of+   (ValueUndefined _, ValueUndefined _) -> True+   (ValueNull _, ValueNull _) -> True+   (ValueNumber (Number nx), ValueNumber (Number ny)) ->+     if isNaN nx && isNaN ny+     then True+     else+       if nx == 0 && isNegativeZero ny ||+          isNegativeZero nx && ny == 0+       then False+       else+         if nx == ny+         then True+         else False+   (ValueString sx, ValueString sy) -> sx == sy+   (ValueBool bx, ValueBool by) -> bx == by+   (ValueObject ox, ValueObject oy) -> ox == oy+   _ -> False++compare :: (SubType v1 Value, SubType v2 Value) =>+           v1 -> v2 -> JavaScriptM Bool+compare x y = do+  case (inj x :: Value, inj y :: Value) of+   (ValueUndefined _, ValueUndefined _) -> return True+   (ValueNull _, ValueNull _) -> return True+   (ValueNumber nx, ValueNumber ny) -> return (nx == ny)+   (ValueString sx, ValueString sy) -> return (sx == sy)+   (ValueBool bx, ValueBool by) -> return (bx == by)+   (ValueObject ox, ValueObject oy) -> return (ox == oy)+   (ValueNull _, ValueUndefined _) -> return True+   (ValueUndefined _, ValueNull _) -> return True+   (ValueNumber nx, ValueString sy) -> do+     ny <- toNumber y+     compare nx ny+   (ValueString sx, ValueNumber ny) -> do+     nx <- toNumber x+     compare nx ny+   (ValueBool bx, _) -> do+     nx <- toNumber bx+     compare nx y+   (_, ValueBool by) -> do+     ny <- toNumber by+     compare x ny+   (ValueString sx, ValueObject oy) -> do+     py <- toPrimitive oy Nothing+     compare sx py+   (ValueNumber nx, ValueObject oy) -> do+     py <- toPrimitive oy Nothing+     compare nx py+   (ValueObject ox, ValueString sy) -> do+     px <- toPrimitive ox Nothing+     compare px sy+   (ValueObject ox, ValueNumber ny) -> do+     px <- toPrimitive ox Nothing+     compare px ny+   _ -> return False++compareStrict :: Value -> Value -> Bool+compareStrict x y = do+  case (x, y) of+   (ValueUndefined _, ValueUndefined _) -> True+   (ValueNull _, ValueNull _) -> True+   (ValueNumber nx, ValueNumber ny) -> (nx == ny)+   (ValueString sx, ValueString sy) -> (sx == sy)+   (ValueBool bx, ValueBool by) -> (bx == by)+   (ValueObject ox, ValueObject oy) -> (ox == oy)+   _ -> False++compareLess :: Value -> Value -> Bool -> JavaScriptM (JSMaybe Bool)+compareLess x y leftFirst = do+  (px, py) <- if leftFirst+    then do+    px <- toPrimitive x (Just HintNumber)+    py <- toPrimitive y (Just HintNumber)+    return (px, py)+    else do+    py <- toPrimitive y (Just HintNumber)+    px <- toPrimitive x (Just HintNumber)+    return (px, py)+  case (px, py) of+   (PrimitiveString sx, PrimitiveString sy) -> do+     return $ JSJust (sx < sy)+   _ -> do+    nx <- toNumber px+    ny <- toNumber py+    if isNaN nx || isNaN ny+      then return JSNothing+      else return $ JSJust (nx < ny)++operatorPlus :: (SubType v1 CallValue, SubType v2 CallValue) =>+                v1 -> v2 -> JavaScriptM Value+operatorPlus lref rref = do+  lval <- getValue lref+  rval <- getValue rref+  lprim <- toPrimitive lval Nothing+  rprim <- toPrimitive rval Nothing+  if typeOf lprim == TypeString || typeOf rprim == TypeString+    then liftM2 (\l r -> inj $ l ++ r) (toString lprim) (toString rprim)+    else liftM2 (\l r -> inj $ l + r) (toNumber lprim) (toNumber rprim)++operatorMinus :: (SubType v1 CallValue, SubType v2 CallValue) =>+                 v1 -> v2 -> JavaScriptM Number+operatorMinus lref rref = do+  lval <- getValue lref+  rval <- getValue rref+  lnum <- toNumber lval+  rnum <- toNumber rval+  return $ lnum - rnum++operatorMult :: (SubType v1 CallValue, SubType v2 CallValue) =>+                v1 -> v2 -> JavaScriptM Number+operatorMult left right = do+  leftValue <- getValue left+  rightValue <- getValue right+  leftNum <- toNumber leftValue+  rightNum <- toNumber rightValue+  return $ leftNum * rightNum++operatorDiv :: (SubType v1 CallValue, SubType v2 CallValue) =>+               v1 -> v2 -> JavaScriptM Number+operatorDiv left right = do+  leftValue <- getValue left+  rightValue <- getValue right+  leftNum <- toNumber leftValue+  rightNum <- toNumber rightValue+  return $ leftNum / rightNum++operatorMod :: (SubType v1 CallValue, SubType v2 CallValue) =>+               v1 -> v2 -> JavaScriptM Number+operatorMod left right = do+  leftValue <- getValue left+  rightValue <- getValue right+  leftNum <- toNumber leftValue+  rightNum <- toNumber rightValue+  return $ leftNum `mod'` rightNum++operatorLeftShift :: (SubType v1 CallValue, SubType v2 CallValue) =>+                     v1 -> v2 -> JavaScriptM Number+operatorLeftShift left right = do+  lval <- getValue left+  rval <- getValue right+  lnum <- toInt32 lval+  rnum <- toUint32 rval+  let shiftCount = fromInteger . Prelude.toInteger $ rnum .&. 0x1F+  return $ Number $ fromIntegral $ shiftL lnum shiftCount++operatorSignedRightShift :: (SubType v1 CallValue, SubType v2 CallValue) =>+                            v1 -> v2 -> JavaScriptM Number+operatorSignedRightShift left right = do+  lval <- getValue left+  rval <- getValue right+  lnum <- toInt32 lval+  rnum <- toUint32 rval+  let shiftCount = fromInteger . Prelude.toInteger $ rnum .&. 0x1F+  return $ Number $ fromIntegral $ shiftR lnum shiftCount++operatorUnsignedRightShift :: (SubType v1 CallValue, SubType v2 CallValue) =>+                              v1 -> v2 -> JavaScriptM Number+operatorUnsignedRightShift left right = do+  lval <- getValue left+  rval <- getValue right+  lnum <- toUint32 lval+  rnum <- toUint32 rval+  let shiftCount = fromInteger . Prelude.toInteger $ rnum .&. 0x1F+  return $ Number $ fromIntegral $ shiftR lnum shiftCount++operatorBitwiseAnd :: (SubType v1 CallValue, SubType v2 CallValue) =>+                      v1 -> v2 -> JavaScriptM Number+operatorBitwiseAnd left right = do+  lval <- getValue left+  rval <- getValue right+  lnum <- toInt32 lval+  rnum <- toInt32 rval+  return $ Number $ fromIntegral $ lnum .&. rnum++operatorBitwiseXor :: (SubType v1 CallValue, SubType v2 CallValue) =>+                      v1 -> v2 -> JavaScriptM Number+operatorBitwiseXor left right = do+  lval <- getValue left+  rval <- getValue right+  lnum <- toInt32 lval+  rnum <- toInt32 rval+  return $ Number $ fromIntegral $ lnum `xor` rnum++operatorBitwiseOr :: (SubType v1 CallValue, SubType v2 CallValue) =>+                     v1 -> v2 -> JavaScriptM Number+operatorBitwiseOr left right = do+  lval <- getValue left+  rval <- getValue right+  lnum <- toInt32 lval+  rnum <- toInt32 rval+  return $ Number $ fromIntegral $ lnum .|. rnum
+ src/Language/JavaScript/Lexer.hs view
@@ -0,0 +1,670 @@+{-# LANGUAGE FlexibleContexts,+             RankNTypes #-}++module Language.JavaScript.Lexer+       where++import Control.Applicative ((<$>), (<*))+import Control.Monad (void)++import Data.Char+import Data.Maybe (mapMaybe)++import Text.Parsec ((<|>),+                    SourcePos,+                    anyChar, choice, getPosition, many,+                    notFollowedBy, optionMaybe, runParser,+                    satisfy, skipMany1, string, try)+import Text.Parsec.Char (char, oneOf)+import Text.Parsec.Prim (ParsecT, Stream,+                         getState, modifyState)+import Text.Parsec.Token (GenLanguageDef(..), LanguageDef)+import Text.ParserCombinators.Parsec.Prim (GenParser)++import Language.JavaScript.AST++javaScript :: LanguageDef TokenState+javaScript = LanguageDef {+  commentStart = "/*",+  commentEnd = "*/",+  commentLine = "//",+  nestedComments = False,+  identStart = identifierStart,+  identLetter = identifierPart,+  opStart = oneOf "!%&( )*,-.:;<=>?[ ]^{|}~",+  opLetter = oneOf "=+-<>&|",+  reservedNames =+    [ "break", "case", "catch", "continue", "debugger", "default"+    , "delete", "do", "else", "finally", "for", "function", "if"+    , "in" , "instanceof", "new", "return", "this", "throw", "try"+    , "typeof", "var", "void", "while", "with"+    , "class", "const", "enum", "export", "extends", "import", "super"+    , "implements", "interface", "let", "package", "private", "protected"+    , "public", "static", "yield"+    , "null", "true", "false" ],+  reservedOpNames =+    [ "{", "}", "(", ")", "[", "]", ".", ";", ",", "<", ">", "<="+    , ">=", "==", "!=", "===", "!==", "+", "-", "*", "%", "++", "--"+    , "<<", ">>", ">>>", "&", "|", "^", "!", "~", "&&", "||", "?", ":"+    , "=", "+=", "-=", "*=", "%=", "<<=", ">>=", ">>>=", "&=", "|=", "^=" ],+  caseSensitive = True }++data InputElement+  = InputElementIdentName IdentName+  | InputElementLiteral Literal+  | InputElementPunctuator Punctuator+  | InputElementLineTerminator+  deriving (Eq, Show)++data InputElementDiv+  = InputElementDivWhiteSpace+  | InputElementDivLineTerminator+  | InputElementDivComment Comment+  | InputElementDivToken Token+  | InputElementDivDivPunctuator DivPunctuator+  deriving (Eq, Show)++data InputElementRegExp+  = InputElementRegExpWhiteSpace+  | InputElementRegExpLineTerminator+  | InputElementRegExpComment Comment+  | InputElementRegExpToken Token+  | InputElementRegExpRegExpLit RegExpLit+  deriving (Eq, Show)++data Comment+  = CommentMultiLine String+  | CommentSingleLine String+  deriving (Eq, Show)++data Token+  = TokenIdentName IdentName+  | TokenPunctuator Punctuator+  | TokenNumLit NumLit+  | TokenStringLit StringLit+  deriving (Eq, Show)++data Punctuator+  = Punctuator String+  deriving (Eq, Show)++data DivPunctuator+  = DivPunctuator String+  deriving (Eq, Show)++applyRest :: Stream s m t =>+             ParsecT s u m (b -> ParsecT s u m b) -> b -> ParsecT s u m b+applyRest pr a = do+  mr <- optionMaybe $ try pr+  case mr of+   Just r -> r a+   Nothing -> return a++data TokenState+  = TokenState+    { tokenStateLeadingDivAllowed :: Bool }++type TokenParser st a = GenParser Char st a+type TokenSTParser a = GenParser Char TokenState a++newTokenState :: TokenState+newTokenState = TokenState {+  tokenStateLeadingDivAllowed = False }++isLeadingDivAllowed :: TokenSTParser Bool+isLeadingDivAllowed = do+  s <- getState+  return $ tokenStateLeadingDivAllowed s++setLeadingDivAllowed :: TokenSTParser ()+setLeadingDivAllowed =+  modifyState $ \s -> s { tokenStateLeadingDivAllowed = True }++setLeadingDivDisallowed :: TokenSTParser ()+setLeadingDivDisallowed =+  modifyState $ \s -> s { tokenStateLeadingDivAllowed = False }++sourceCharacter :: TokenParser st Char+sourceCharacter = anyChar++inputElementDiv :: TokenSTParser InputElementDiv+inputElementDiv =+  do { void whiteSpace; return InputElementDivWhiteSpace } <|>+  do { void lineTerminator; return InputElementDivLineTerminator } <|>+  do { c <- comment; return $ InputElementDivComment c } <|>+  do { t <- token; return $ InputElementDivToken t } <|>+  do { p <- divPunctuator; return $ InputElementDivDivPunctuator p }++inputElementRegExp :: TokenSTParser InputElementRegExp+inputElementRegExp =+  do { void whiteSpace; return InputElementRegExpWhiteSpace } <|>+  do { void lineTerminator; return InputElementRegExpLineTerminator } <|>+  do { c <- comment; return $ InputElementRegExpComment c } <|>+  do { t <- token; return $ InputElementRegExpToken t } <|>+  do { re <- regularExpressionLiteral; return $ InputElementRegExpRegExpLit re }++whiteSpace :: Stream String m Char => ParsecT [Char] u m Char+whiteSpace =+  do { choice $ char <$>+       [ '\x0009', '\x000B'+       , '\x000C', '\x0020'+       , '\x00A0', '\xFEFF' ] } <|>+  satisfy (\c -> generalCategory c == Space)++lineTerminator :: TokenParser st Char+lineTerminator =+  choice $ char <$>+  [ '\x000A', '\x000D'+  , '\x2028', '\x2029' ]++lineTerminatorSequence :: TokenParser st ()+lineTerminatorSequence =+  skipMany1 $ choice+  [ void $ char '\x000A'+  , void $ try $ do { void $ char '\x000D'; (notFollowedBy $ char '\x000A') }+  , void $ char '\x2028', void $ char '\x2029'+  , void $ string "\x000D\x000A" ]++comment :: TokenParser st Comment+comment =+  multiLineComment <|>+  singleLineComment++multiLineComment :: TokenParser st Comment+multiLineComment =+  do { void . try $ string "/*"; ms <- optionMaybe multiLineCommentChars; void $ string "*/";+       case ms of+       Nothing -> return $ CommentMultiLine ""+       Just s -> return $ CommentMultiLine s }++multiLineCommentChars :: TokenParser st String+multiLineCommentChars =+  do { c <- multiLineNotAsteriskChar; ms <- optionMaybe multiLineCommentChars;+       case ms of+        Nothing -> return [c]+        Just s -> return $ c:s } <|>+  do { c <- try $ do { char '*' <* notFollowedBy (char '/') }; ms <- optionMaybe postAsteriskCommentChars;+       case ms of+        Nothing -> return [c]+        Just s -> return $ c:s }++postAsteriskCommentChars :: TokenParser st String+postAsteriskCommentChars =+  do { c <- multiLineNotForwardSlashOrAsteriskChar; ms <- optionMaybe multiLineCommentChars;+       case ms of+        Nothing -> return [c]+        Just s -> return $ c:s } <|>+  do { c <- char '*'; ms <- optionMaybe postAsteriskCommentChars;+       case ms of+        Nothing -> return [c]+        Just s -> return $ c:s }++multiLineNotAsteriskChar :: TokenParser st Char+multiLineNotAsteriskChar =+  do { notFollowedBy $ char '*'; sourceCharacter }++multiLineNotForwardSlashOrAsteriskChar :: TokenParser st Char+multiLineNotForwardSlashOrAsteriskChar =+  do { notFollowedBy $ char '/' <|> char '*'; sourceCharacter }++singleLineComment :: TokenParser st Comment+singleLineComment =+  do { void . try $ string "//"; ms <- optionMaybe singleLineCommentChars;+       case ms of+        Nothing -> return $ CommentSingleLine ""+        Just s -> return $ CommentSingleLine s }++singleLineCommentChars :: TokenParser st String+singleLineCommentChars =+  do { c <- singleLineCommentChar; ms <- optionMaybe singleLineCommentChars;+       case ms of+        Nothing -> return [c]+        Just s -> return $ c:s }++singleLineCommentChar :: TokenParser st Char+singleLineCommentChar =+  do { notFollowedBy lineTerminator; sourceCharacter }++token :: TokenSTParser Token+token =+  do { i <- identifierName; return $ TokenIdentName i } <|>+  do { p <- punctuator; return $ TokenPunctuator p } <|>+  do { n <- numericLiteral; setLeadingDivAllowed; return $ TokenNumLit n } <|>+  do { s <- stringLiteral; setLeadingDivAllowed; return $ TokenStringLit s }++identifier :: TokenSTParser Ident+identifier =+  do { notFollowedBy reservedWord; i <- identifierName; setLeadingDivAllowed; return $ Ident i; }++identifierName :: TokenSTParser IdentName+identifierName =+  do { c <- identifierStart; applyRest identifierNameRest $ IdentName [c];  }++identifierNameRest :: TokenSTParser (IdentName -> TokenSTParser IdentName)+identifierNameRest =+  do { c <- identifierPart; return $ \(IdentName s) -> applyRest identifierNameRest (IdentName $ s ++ [c]) }++identifierStart :: TokenSTParser Char+identifierStart =+  unicodeLetter <|>+  char '$' <|>+  char '_' <|>+  do { void $ char '\\'; unicodeEscapeSequence }++identifierPart :: TokenSTParser Char+identifierPart =+  identifierStart <|>+  unicodeCombiningMark <|>+  unicodeDigit <|>+  unicodeConnectorPunctuation <|>+  char '\x200C' <|>+  char '\x200D'++unicodeLetter :: TokenParser st Char+unicodeLetter =+  satisfy $ \c -> let cat = generalCategory c in+                   cat == UppercaseLetter ||+                   cat == LowercaseLetter ||+                   cat == TitlecaseLetter ||+                   cat == ModifierLetter ||+                   cat == OtherLetter ||+                   cat == LetterNumber++unicodeCombiningMark :: TokenParser st Char+unicodeCombiningMark =+  satisfy $ \c -> let cat = generalCategory c in+                   cat == NonSpacingMark ||+                   cat == SpacingCombiningMark++unicodeDigit :: TokenParser st Char+unicodeDigit =+  satisfy $ \c -> let cat = generalCategory c in+                   cat == DecimalNumber++unicodeConnectorPunctuation :: TokenParser st Char+unicodeConnectorPunctuation =+  satisfy $ \c -> let cat = generalCategory c+                  in cat == ConnectorPunctuation++reservedWord :: TokenParser st ()+reservedWord =+  void keyword <|>+  void futureReservedWord <|>+  void nullLiteral <|>+  void booleanLiteral++keyword :: TokenParser st String+keyword =+  choice $ try . string <$>+  [ "break", "case", "catch", "continue", "debugger", "default", "delete"+  , "do", "else", "finally", "for", "function", "if", "in"+  , "instanceof", "new", "return", "this", "throw", "try"+  , "typeof", "var", "void", "while", "with" ]++futureReservedWord :: TokenParser st String+futureReservedWord =+  choice $ try . string <$>+  [ "class", "const", "enum", "export", "extends", "import", "super"+  , "implements", "interface", "let", "package", "private", "protected"+  , "public", "static", "yield" ]++punctuator :: TokenSTParser Punctuator+punctuator = do+  p <- choice $ try . string <$>+       [ "~", "}", "||", "|=", "|", "{"+       , "^=", "^", "]", "[", "?", ">>>="+       , ">>>", ">>=", ">>", ">=", ">", "==="+       , "==", "=", "<=", "<<=", "<<", "<"+       , ";", ":", ".", "-=", "--", "-", ","+       , "+=", "++", "+", "*=", "*", ")", "("+       , "&=", "&&", "&", "%=", "%", "!==", "!=", "!" ]+  if p `elem` ["]", "--", "++", ")"]+    then setLeadingDivAllowed+    else setLeadingDivDisallowed+  return $ Punctuator p++divPunctuator :: TokenSTParser DivPunctuator+divPunctuator = do+  dp <- try (string "/=") <|> string "/"+  setLeadingDivDisallowed+  return $ DivPunctuator dp++literal :: TokenSTParser Literal+literal =+  do { n <- nullLiteral; setLeadingDivAllowed; return $ LiteralNull n } <|>+  do { b <- booleanLiteral; setLeadingDivAllowed; return $ LiteralBool b } <|>+  do { n <- numericLiteral; setLeadingDivAllowed; setLeadingDivAllowed; return $ LiteralNum n } <|>+  do { s <- stringLiteral; setLeadingDivAllowed; return $ LiteralString s } <|>+  do { r <- regularExpressionLiteral; return $ LiteralRegExp r }++nullLiteral :: TokenParser st NullLit+nullLiteral =+  do { void $ string "null"; return NullLit }++booleanLiteral :: TokenParser st BoolLit+booleanLiteral =+  do { void $ string "true"; return $ BoolLit True } <|>+  do { void $ string "false"; return $ BoolLit False }++numericLiteral :: TokenParser st NumLit+numericLiteral =+  do { mv <- hexIntegerLiteral; return $ NumLit $ fromIntegral mv } <|>+  do { mv <- decimalLiteral; return $ NumLit mv }++decimalLiteral :: TokenParser st Double+decimalLiteral =+  do { mv <- try $ do { decimalIntegerLiteral <* char '.' };+       mdv <- optionMaybe decimalDigits; mev <- optionMaybe exponentPart;+       case mdv of+        Nothing -> do+          case mev of+           Nothing -> return $ fromIntegral mv+           Just ev -> return $ (fromIntegral mv) * 10 ^^ ev+        Just (dv, n) -> do+          case mev of+           Nothing ->+             return $ (fromIntegral mv) + (fromIntegral dv) * 10 ^^ (-n)+           Just ev ->+             return $ ((fromIntegral mv) + (fromIntegral dv) * 10 ^^ (-n)) * 10 ^^ ev } <|>+  do { void $ char '.'; (mv, n) <- decimalDigits; mev <- optionMaybe exponentPart;+       case mev of+        Nothing ->+          return $ (fromIntegral mv) * 10 ^^ (-n)+        Just ev -> do+          return $ (fromIntegral mv) * 10 ^^ (ev - n) } <|>+  do { mv <- decimalIntegerLiteral; mev <- optionMaybe exponentPart;+       case mev of+        Nothing -> return $ fromIntegral mv+        Just ev -> return $ (fromIntegral mv) * 10 ^^ ev }++decimalIntegerLiteral :: TokenParser st Int+decimalIntegerLiteral =+  do { void $ char '0'; return 0 } <|>+  do { mv <- nonZeroDigit; mdv <- optionMaybe decimalDigits;+       case mdv of+        Nothing -> return mv+        Just (dv, n) -> do+          return $ mv * 10 ^ n + dv }++decimalDigits :: TokenParser st (Int, Int)+decimalDigits =+  do { dv <- decimalDigit; applyRest decimalDigitsRest (dv, 1) }++decimalDigitsRest :: TokenParser st ((Int, Int) -> TokenParser st (Int, Int))+decimalDigitsRest =+  do { dv <- decimalDigit; return $ \(mv, n) -> applyRest decimalDigitsRest (mv * 10 + dv, n + 1) }++decimalDigit :: TokenParser st Int+decimalDigit =+  do { void $ char '0'; return 0 } <|>+  do { void $ char '1'; return 1 } <|>+  do { void $ char '2'; return 2 } <|>+  do { void $ char '3'; return 3 } <|>+  do { void $ char '4'; return 4 } <|>+  do { void $ char '5'; return 5 } <|>+  do { void $ char '6'; return 6 } <|>+  do { void $ char '7'; return 7 } <|>+  do { void $ char '8'; return 8 } <|>+  do { void $ char '9'; return 9 }++nonZeroDigit :: TokenParser st Int+nonZeroDigit =+  do { void $ char '1'; return 1 } <|>+  do { void $ char '2'; return 2 } <|>+  do { void $ char '3'; return 3 } <|>+  do { void $ char '4'; return 4 } <|>+  do { void $ char '5'; return 5 } <|>+  do { void $ char '6'; return 6 } <|>+  do { void $ char '7'; return 7 } <|>+  do { void $ char '8'; return 8 } <|>+  do { void $ char '9'; return 9 }++exponentPart :: TokenParser st Int+exponentPart =+  do { void $ exponentIndicator; mv <- signedInteger; return mv }++exponentIndicator :: TokenParser st Char+exponentIndicator =+  char 'e' <|> char 'E'++signedInteger :: TokenParser st Int+signedInteger =+  do { (mv, _) <- decimalDigits; return mv } <|>+  do { void $ char '+'; (mv, _) <- decimalDigits; return mv } <|>+  do { void $ char '-'; (mv, _) <- decimalDigits; return (-mv) }++hexIntegerLiteral :: TokenParser st Int+hexIntegerLiteral =+  do { try (void $ string "0x") <|> try (void $ string "0X"); applyRest hexIntegerLiteralRest 0 }++hexIntegerLiteralRest :: TokenParser st (Int -> TokenParser st Int)+hexIntegerLiteralRest =+  do { dv <- hexDigit; return $ \mv -> applyRest hexIntegerLiteralRest (mv * 16 + dv) }++hexDigit :: TokenParser st Int+hexDigit =+  do { void $ char '0'; return 0 } <|>+  do { void $ char '1'; return 1 } <|>+  do { void $ char '2'; return 2 } <|>+  do { void $ char '3'; return 3 } <|>+  do { void $ char '4'; return 4 } <|>+  do { void $ char '5'; return 5 } <|>+  do { void $ char '6'; return 6 } <|>+  do { void $ char '7'; return 7 } <|>+  do { void $ char '8'; return 8 } <|>+  do { void $ char '9'; return 9 } <|>+  do { void $ char 'a' <|> char 'A'; return 10 } <|>+  do { void $ char 'b' <|> char 'B'; return 11 } <|>+  do { void $ char 'c' <|> char 'C'; return 12 } <|>+  do { void $ char 'd' <|> char 'D'; return 13 } <|>+  do { void $ char 'e' <|> char 'E'; return 14 } <|>+  do { void $ char 'f' <|> char 'F'; return 15 }++stringLiteral :: TokenParser st StringLit+stringLiteral =+  do { void $ char '"'; msv <- optionMaybe doubleStringCharacters; void $ char '"';+       case msv of+        Nothing -> return $ StringLit ""+        Just sv -> return $ StringLit sv } <|>+  do { void $ char '\''; msv <- optionMaybe singleStringCharacters; void $ char '\'';+       case msv of+        Nothing -> return $ StringLit ""+        Just sv -> return $ StringLit sv }++doubleStringCharacters :: TokenParser st String+doubleStringCharacters =+  do { cv <- doubleStringCharacter; msv <- optionMaybe doubleStringCharacters;+       case msv of+        Nothing -> return cv+        Just sv -> return $ cv ++ sv }++singleStringCharacters :: TokenParser st String+singleStringCharacters =+  do { cv <- singleStringCharacter; msv <- optionMaybe singleStringCharacters;+       case msv of+        Nothing -> return cv+        Just sv -> return $ cv ++ sv}++doubleStringCharacter :: TokenParser st String+doubleStringCharacter =+  do { notFollowedBy $ char '"' <|> char '\\' <|> lineTerminator; c <- sourceCharacter; return [c] } <|>+  do { void $ char '\\'; c <- escapeSequence; return [c] } <|>+  do { void $ lineContinuation; return "" }++singleStringCharacter :: TokenParser st String+singleStringCharacter =+  do { notFollowedBy $ char '\'' <|> char '\\' <|> lineTerminator; c <- sourceCharacter; return [c] } <|>+  do { void $ char '\\'; c <- escapeSequence; return [c] } <|>+  do { void $ lineContinuation; return "" }++lineContinuation :: TokenParser st String+lineContinuation =+  do { void $ char '\\'; lineTerminatorSequence; return "" }++escapeSequence :: TokenParser st Char+escapeSequence =+  characterEscapeSequence <|>+  do { void $ char '0'; notFollowedBy decimalDigit; return '\0' } <|>+  hexEscapeSequence <|>+  unicodeEscapeSequence++characterEscapeSequence :: TokenParser st Char+characterEscapeSequence =+  do { ec <- singleEscapeCharacter;+       case ec of+        'b'  -> return '\x0008'+        't'  -> return '\x0009'+        'n'  -> return '\x000A'+        'v'  -> return '\x000B'+        'f'  -> return '\x000C'+        'r'  -> return '\x000D'+        '"'  -> return '\x0022'+        '\'' -> return '\x0027'+        '\\' -> return '\x005C'+        _ -> error "panic" {- This Should never happen! -} } <|>+  nonEscapeCharacter++singleEscapeCharacter :: TokenParser st Char+singleEscapeCharacter =+  choice $ char <$>+  [ '\'', '"', '\\', 'b', 'f', 'n', 'r', 't', 'v' ]++nonEscapeCharacter :: TokenParser st Char+nonEscapeCharacter =+  do { notFollowedBy $ escapeCharacter <|> void lineTerminator; sourceCharacter }++escapeCharacter :: TokenParser st ()+escapeCharacter =+  void singleEscapeCharacter <|>+  void decimalDigit <|>+  void (char 'x') <|>+  void (char 'u')++hexEscapeSequence :: TokenParser st Char+hexEscapeSequence =+  do { void $ char 'x'; mv1 <- hexDigit; mv2 <- hexDigit;+       return $ chr $ 16 * mv1 + mv2 }++unicodeEscapeSequence :: TokenParser st Char+unicodeEscapeSequence =+  do { void $ char 'u'; mv1 <- hexDigit; mv2 <- hexDigit; mv3 <- hexDigit; mv4 <- hexDigit;+       return $ chr $ 4096 * mv1 + 256 * mv2 + 16 * mv3 + mv4 }++regularExpressionLiteral :: TokenSTParser RegExpLit+regularExpressionLiteral =+  do { void $ char '/'; pattern <- regularExpressionBody; void $ char '/'; flags <- regularExpressionFlags;+       return $ RegExpLit (pattern, flags) }++regularExpressionBody :: TokenParser st String+regularExpressionBody =+  do { c <- regularExpressionFirstChar; s <- regularExpressionChars; return $ c ++ s }++regularExpressionChars :: TokenParser st String+regularExpressionChars =+  do { c <- regularExpressionChar; s <- regularExpressionChars; return $ c ++ s } <|>+  return ""++regularExpressionFirstChar :: TokenParser st String+regularExpressionFirstChar =+  do { notFollowedBy $ char '*' <|> char '\\' <|> char '/' <|> char '['; c <- regularExpressionNonTerminator;+       return [c] } <|>+  do { c <- regularExpressionBackslashSequence; return [c] } <|>+  regularExpressionClass++regularExpressionChar :: TokenParser st String+regularExpressionChar =+  do { notFollowedBy $ char '\\' <|> char '/' <|> char '['; c <- regularExpressionNonTerminator;+       return [c] } <|>+  do { c <- regularExpressionBackslashSequence; return [c] } <|>+  regularExpressionClass++regularExpressionBackslashSequence :: TokenParser st Char+regularExpressionBackslashSequence =+  do { void $ char '\\'; regularExpressionNonTerminator }++regularExpressionNonTerminator :: TokenParser st Char+regularExpressionNonTerminator =+  do { notFollowedBy lineTerminator; sourceCharacter }++regularExpressionClass :: TokenParser st String+regularExpressionClass =+  do { void $ char '['; s <- regularExpressionClassChars; void $ char ']'; return s }++regularExpressionClassChars :: TokenParser st String+regularExpressionClassChars =+  do { c <- regularExpressionClassChar; s <- regularExpressionClassChars; return $ c:s } <|>+  return ""++regularExpressionClassChar :: TokenParser st Char+regularExpressionClassChar =+  do { notFollowedBy $ char ']' <|> char '\\';  regularExpressionNonTerminator } <|>+  regularExpressionBackslashSequence++regularExpressionFlags :: TokenSTParser String+regularExpressionFlags =+  do { c <- identifierPart; s <- regularExpressionFlags; return $ c:s } <|>+  return ""++lexer :: TokenSTParser [(SourcePos, InputElement)]+lexer = (mapMaybe toInputElement) <$>+        (many $ do+            p <- getPosition;+            da <- isLeadingDivAllowed+            edr <- if da+                   then Left <$> inputElementDiv+                   else Right <$> inputElementRegExp+            return (p, edr))+  where+    isLineTerminator c = c `elem` [ '\x000A', '\x000D', '\x2028', '\x2029' ]+    toInputElement (p, edr) = do+      case edr of+       Left ied -> toInputElementDiv (p, ied)+       Right ier -> toInputElementRegExp (p, ier)+    toInputElementDiv (p, ied) =+      case ied of+       InputElementDivWhiteSpace -> Nothing+       InputElementDivLineTerminator ->+         Just (p, InputElementLineTerminator)+       InputElementDivComment (CommentSingleLine _) ->+         Nothing+       InputElementDivComment (CommentMultiLine s)+         | any isLineTerminator s -> Just (p, InputElementLineTerminator)+         | otherwise -> Nothing+       InputElementDivToken (TokenIdentName i) ->+         Just (p, InputElementIdentName i)+       InputElementDivToken (TokenPunctuator pu) ->+         Just (p, InputElementPunctuator pu)+       InputElementDivToken (TokenNumLit n) ->+         Just (p, InputElementLiteral $ LiteralNum n)+       InputElementDivToken (TokenStringLit s) ->+         Just (p, InputElementLiteral $ LiteralString s)+       InputElementDivDivPunctuator (DivPunctuator s) ->+         Just (p, InputElementPunctuator $  Punctuator s)+    toInputElementRegExp (p, ier) =+      case ier of+       InputElementRegExpWhiteSpace -> Nothing+       InputElementRegExpLineTerminator ->+         Just (p, InputElementLineTerminator)+       InputElementRegExpComment (CommentSingleLine _) -> Nothing+       InputElementRegExpComment (CommentMultiLine s)+         | any isLineTerminator s -> Just (p, InputElementLineTerminator)+         | otherwise -> Nothing+       InputElementRegExpToken (TokenIdentName i) ->+         Just (p, InputElementIdentName i)+       InputElementRegExpToken (TokenPunctuator pu) ->+         Just (p, InputElementPunctuator pu)+       InputElementRegExpToken (TokenNumLit n) ->+         Just (p, InputElementLiteral $ LiteralNum n)+       InputElementRegExpToken (TokenStringLit s) ->+         Just (p, InputElementLiteral $ LiteralString s)+       InputElementRegExpRegExpLit re ->+         Just (p, InputElementLiteral $ LiteralRegExp re)++runLexer :: String -> [(SourcePos, InputElement)]+runLexer s =+  case runParser lexer newTokenState "" s of+   Right l -> l+   Left _  -> []++lexJavaScript :: String -> [(SourcePos, InputElement)]+lexJavaScript input = runLexer input
+ src/Language/JavaScript/Parser.hs view
@@ -0,0 +1,535 @@+module Language.JavaScript.Parser+       ( parseJavaScript ) where++import Control.Applicative ((<*), (*>))++import Text.Parsec++import Language.JavaScript.AST+import Language.JavaScript.Lexer (lexJavaScript)+import Language.JavaScript.Prim+import Language.JavaScript.Util++chainl1' :: (Stream s m t) =>+            ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m (a -> b -> a) -> ParsecT s u m a+chainl1' pa pb op = do+  a <- pa+  rest a+  where+    rest a = do { f <- op; b <- pb; rest (f a b) } <|> return a++primExpr :: JSParser PrimExpr+primExpr =+  do { identName "this" ; return PrimExprThis } <|>+  do { name <- getIdent; return $ PrimExprIdent name} <|>+  do { l <- getLiteral; return $ PrimExprLiteral l } <|>+  do { a <- arrayLit; return $ PrimExprArray a } <|>+  do { o <- objectLit; return $ PrimExprObject o } <|>+  do { punctuator "("; e <- expr; punctuator ")"; return $ PrimExprParens e }++arrayLit :: JSParser ArrayLit+arrayLit =+  try (do { punctuator "["; me <- optionMaybe elision; punctuator "]"; return $ ArrayLitH me }) <|>+  try (do { punctuator "["; el <- elementList; punctuator "]"; return $ ArrayLit el }) <|>+  do { punctuator "[";+       el <- elementList;+       punctuator ",";+       me <- optionMaybe elision;+       punctuator "]";+       return $ ArrayLitT el me }++elementList :: JSParser ElementList+elementList =+  do { me <- optionMaybe elision; ae <- assignExpr; applyRest elementListRest (ElementList me ae) }++elementListRest :: JSParser (ElementList -> JSParser ElementList)+elementListRest =+  do { punctuator ","; me <- optionMaybe elision; ae <- assignExpr; return $ \el -> applyRest elementListRest (ElementListCons el me ae) }++elision :: JSParser Elision+elision =+  do { punctuator ","; applyRest elisionRest ElisionComma }++elisionRest :: JSParser (Elision -> JSParser Elision)+elisionRest =+  do { punctuator ","; return $ \e -> applyRest elisionRest (ElisionCons e) }++objectLit :: JSParser ObjectLit+objectLit =+  try (do { punctuator "{"; punctuator "}"; return ObjectLitEmpty }) <|>+  do { punctuator "{"; pl <- propList; optional $ punctuator ","; punctuator "}"; return $ ObjectLit pl }++propList :: JSParser PropList+propList =+  do { pa <- propAssign; applyRest propListRest (PropListAssign pa) }++propListRest :: JSParser (PropList -> JSParser PropList)+propListRest =+  do { punctuator ","; pa <- propAssign; return $ \pl -> applyRest propListRest (PropListCons pl pa) }++propAssign :: JSParser PropAssign+propAssign =+  do { pn <- propName; punctuator ":"; ae <- assignExpr; return $ PropAssignField pn ae } <|>+  do { identName "get"; pn <- propName; punctuator "("; punctuator ")"; punctuator "{"; fb <- funcBody; punctuator "}"; return $ PropAssignGet pn fb } <|>+  do { identName "set"; pn <- propName; punctuator "("; pl <- propSetParamList;  punctuator ")"; punctuator "{"; fb <- funcBody; punctuator "}"; return $ PropAssignSet pn pl fb }++propName :: JSParser PropName+propName =+  do { name <- getIdentName; return $ PropNameId name } <|>+  do { sl <- getStringLit; return $ PropNameStr sl } <|>+  do { nl <- getNumLit; return $ PropNameNum nl }++propSetParamList :: JSParser PropSetParamList+propSetParamList =+  do { i <- getIdent; return $ PropSetParamList i }++memberExpr :: JSParser MemberExpr+memberExpr =+  do { identName "new"; me <- memberExpr; args <- arguments; applyRest memberExprRest (MemberExprNew me args) } <|>+  do { pe <- primExpr; applyRest memberExprRest (MemberExprPrim pe) } <|>+  do { fe <- funcExpr; applyRest memberExprRest (MemberExprFunc fe) }++memberExprRest :: JSParser (MemberExpr -> JSParser MemberExpr)+memberExprRest =+  do { punctuator "["; e <- expr; punctuator "]"; return $ \me -> applyRest memberExprRest (MemberExprArray me e) } <|>+  do { punctuator "."; name <- getIdentName; return $ \me -> applyRest memberExprRest (MemberExprDot me name) }++newExpr :: JSParser NewExpr+newExpr =+  try (do { me <- memberExpr; return $ NewExprMember me }) <|>+  do { identName "new"; ne <- newExpr; return $ NewExprNew ne }++callExpr :: JSParser CallExpr+callExpr =+  do { me <- memberExpr; args <- arguments; applyRest callExprRest (CallExprMember me args) }++callExprRest :: JSParser (CallExpr -> JSParser CallExpr)+callExprRest =+  do { args <- arguments; return $ \ce -> applyRest callExprRest (CallExprCall ce args) } <|>+  do { punctuator "["; e <- expr; punctuator "]"; return $ \ce -> applyRest callExprRest (CallExprArray ce e) } <|>+  do { punctuator "."; name <- getIdentName; return $ \ce -> applyRest callExprRest (CallExprDot ce name) }++arguments :: JSParser Arguments+arguments =+  try (do { punctuator "("; punctuator ")"; return ArgumentsEmpty }) <|>+  do { punctuator "("; al <- argumentList; punctuator ")"; return $ Arguments al }++argumentList :: JSParser ArgumentList+argumentList =+  chainl1'+  (do { ae <- assignExpr; return $ ArgumentList ae })+  assignExpr+  (do { punctuator ","; return ArgumentListCons })++leftExpr :: JSParser LeftExpr+leftExpr =+  try (do { ce <- callExpr; return $ LeftExprCallExpr ce }) <|>+  do { ne <- newExpr; return $ LeftExprNewExpr ne }++postFixExpr :: JSParser PostFixExpr+postFixExpr = do+  le <- leftExpr+  do { punctuator "++"; return $ PostFixExprPostInc le } <|>+    do { punctuator "--"; return $ PostFixExprPostDec le } <|>+    do { return $ PostFixExprLeftExpr le }++uExpr :: JSParser UExpr+uExpr =+  do { identName "delete"; u <- uExpr; return $ UExprDelete u } <|>+  do { identName "void"; u <- uExpr; return $ UExprVoid u } <|>+  do { identName "typeof"; u <- uExpr; return $ UExprTypeOf u } <|>+  do { punctuator "++"; u <- uExpr; return $ UExprDoublePlus u } <|>+  do { punctuator "--"; u <- uExpr; return $ UExprDoubleMinus u } <|>+  do { punctuator "+"; u <- uExpr; return $ UExprUnaryPlus u } <|>+  do { punctuator "-"; u <- uExpr; return $ UExprUnaryMinus u } <|>+  do { punctuator "~"; u <- uExpr; return $ UExprBitNot u } <|>+  do { punctuator "!"; u <- uExpr; return $ UExprNot u } <|>+  do { pe <- postFixExpr; return $ UExprPostFix pe }++multExpr :: JSParser MultExpr+multExpr =+  chainl1'+  (do { u <- uExpr; return $ MultExpr u })+  uExpr+  (do { punctuator "*"; return MultExprMult } <|>+   do { punctuator "/"; return MultExprDiv } <|>+   do { punctuator "%"; return MultExprMod })++addExpr :: JSParser AddExpr+addExpr =+  chainl1'+  (do { m <- multExpr; return $ AddExpr m })+  multExpr+  (do { punctuator "+"; return AddExprAdd } <|>+   do { punctuator "-"; return AddExprSub })++shiftExpr :: JSParser ShiftExpr+shiftExpr =+  chainl1'+  (do { a <- addExpr; return $ ShiftExpr a })+  addExpr+  (do { punctuator "<<"; return ShiftExprLeft } <|>+   do { punctuator ">>"; return ShiftExprRight } <|>+   do { punctuator ">>>"; return ShiftExprRightZero })++relExpr :: JSParser RelExpr+relExpr =+  chainl1'+  (do { s <- shiftExpr; return $ RelExpr s })+  shiftExpr+  (do { punctuator "<"; return RelExprLess } <|>+   do { punctuator ">"; return RelExprGreater } <|>+   do { punctuator "<="; return RelExprLessEq } <|>+   do { punctuator ">="; return RelExprGreaterEq } <|>+   do { identName "instanceof"; return RelExprInstanceOf } <|>+   do { identName "in"; return RelExprIn })++relExprNoIn :: JSParser RelExprNoIn+relExprNoIn =+  chainl1'+  (do { s <- shiftExpr; return $ RelExprNoIn s })+  shiftExpr+  (do { punctuator "<"; return RelExprNoInLess } <|>+   do { punctuator ">"; return RelExprNoInGreater } <|>+   do { punctuator "<="; return RelExprNoInLessEq } <|>+   do { punctuator ">="; return RelExprNoInGreaterEq } <|>+   do { identName "instanceof"; return RelExprNoInInstanceOf })++eqExpr :: JSParser EqExpr+eqExpr =+  chainl1'+  (do { r <- relExpr; return $ EqExpr r })+  relExpr+  (do { punctuator "=="; return EqExprEq } <|>+   do { punctuator "!="; return EqExprNotEq } <|>+   do { punctuator "==="; return EqExprStrictEq } <|>+   do { punctuator "!=="; return EqExprStrictNotEq })++eqExprNoIn :: JSParser EqExprNoIn+eqExprNoIn =+  chainl1'+  (do { r <- relExprNoIn; return $ EqExprNoIn r })+  relExprNoIn+  (do { punctuator "=="; return EqExprNoInEq } <|>+   do { punctuator "!="; return EqExprNoInNotEq } <|>+   do { punctuator "==="; return EqExprNoInStrictEq } <|>+   do { punctuator "!=="; return EqExprNoInStrictNotEq })++bitAndExpr :: JSParser BitAndExpr+bitAndExpr =+  chainl1'+  (do { e <- eqExpr; return $ BitAndExpr e })+  eqExpr+  (do { punctuator "&"; return $ BitAndExprAnd })++bitAndExprNoIn :: JSParser BitAndExprNoIn+bitAndExprNoIn =+  chainl1'+  (do { e <- eqExprNoIn; return $ BitAndExprNoIn e })+  eqExprNoIn+  (do { punctuator "&"; return $ BitAndExprNoInAnd })++bitXorExpr :: JSParser BitXorExpr+bitXorExpr =+  chainl1'+  (do { bae <- bitAndExpr; return $ BitXorExpr bae })+  bitAndExpr+  (do { punctuator "^"; return $ BitXorExprXor })++bitXorExprNoIn :: JSParser BitXorExprNoIn+bitXorExprNoIn =+  chainl1'+  (do { bae <- bitAndExprNoIn; return $ BitXorExprNoIn bae })+  bitAndExprNoIn+  (do { punctuator "^"; return $ BitXorExprNoInXor })++bitOrExpr :: JSParser BitOrExpr+bitOrExpr =+  chainl1'+  (do { bxe <- bitXorExpr; return $ BitOrExpr bxe })+  bitXorExpr+  (do { punctuator "|"; return $ BitOrExprOr })++bitOrExprNoIn :: JSParser BitOrExprNoIn+bitOrExprNoIn =+  chainl1'+  (do { bxe <- bitXorExprNoIn; return $ BitOrExprNoIn bxe })+  bitXorExprNoIn+  (do { punctuator "|"; return $ BitOrExprNoInOr })++logicalAndExpr :: JSParser LogicalAndExpr+logicalAndExpr =+  chainl1'+  (do { boe <- bitOrExpr; return $ LogicalAndExpr boe })+  bitOrExpr+  (do { punctuator "&&"; return $ LogicalAndExprAnd })++logicalAndExprNoIn :: JSParser LogicalAndExprNoIn+logicalAndExprNoIn =+  chainl1'+  (do { boe <- bitOrExprNoIn; return $ LogicalAndExprNoIn boe })+  bitOrExprNoIn+  (do { punctuator "&&"; return $ LogicalAndExprNoInAnd })++logicalOrExpr :: JSParser LogicalOrExpr+logicalOrExpr =+  chainl1'+  (do { lae <- logicalAndExpr; return $ LogicalOrExpr lae })+  logicalAndExpr+  (do { punctuator "||"; return $ LogicalOrExprOr })++logicalOrExprNoIn :: JSParser LogicalOrExprNoIn+logicalOrExprNoIn =+  chainl1'+  (do { lae <- logicalAndExprNoIn; return $ LogicalOrExprNoIn lae })+  logicalAndExprNoIn+  (do { punctuator "||"; return $ LogicalOrExprNoInOr })++condExpr :: JSParser CondExpr+condExpr = do+  loe <- logicalOrExpr+  do { try $ do { punctuator "?"; }; ae1 <- assignExpr; punctuator ":"; ae2 <- assignExpr; return $ CondExprIf loe ae1 ae2 } <|>+    do { return $ CondExpr loe }++condExprNoIn :: JSParser CondExprNoIn+condExprNoIn = do+  loe <- logicalOrExprNoIn;+  do { try $ do { punctuator "?"; }; ae1 <- assignExpr; punctuator ":"; ae2 <- assignExpr; return $ CondExprNoInIf loe ae1 ae2 } <|>+    do { return $ CondExprNoIn loe }++assignExpr :: JSParser AssignExpr+assignExpr =+  try (do { le <- leftExpr; ao <- assignOp; ae <- assignExpr; return $ AssignExprAssign le ao ae }) <|>+  do { ce <- condExpr; return $ AssignExprCondExpr ce }++assignExprNoIn :: JSParser AssignExprNoIn+assignExprNoIn =+  try (do { le <- leftExpr; ao <- assignOp; ae <- assignExprNoIn; return $ AssignExprNoInAssign le ao ae }) <|>+  do { ce <- condExprNoIn; return $ AssignExprNoInCondExpr ce }++assignOp :: JSParser AssignOp+assignOp =+  do { punctuator "="; return AssignOpNormal } <|>+  do { punctuator "*="; return AssignOpMult } <|>+  do { punctuator "/="; return AssignOpDiv } <|>+  do { punctuator "%="; return AssignOpMod } <|>+  do { punctuator "+="; return AssignOpPlus } <|>+  do { punctuator "-="; return AssignOpMinus } <|>+  do { punctuator "<<="; return AssignOpShiftLeft } <|>+  do { punctuator ">>="; return AssignOpShiftRight } <|>+  do { punctuator ">>>="; return AssignOpShiftRightZero } <|>+  do { punctuator "&="; return AssignOpBitAnd } <|>+  do { punctuator "^="; return AssignOpBitXor } <|>+  do { punctuator "|="; return AssignOpBitOr }++expr :: JSParser Expr+expr =+  chainl1'+  (do { ae <- assignExpr; return $ Expr ae })+  assignExpr+  (do { punctuator ","; return ExprCons })++exprNoIn :: JSParser ExprNoIn+exprNoIn =+  chainl1'+  (do { ae <- assignExprNoIn; return $ ExprNoIn ae })+  assignExprNoIn+  (do { punctuator ","; return ExprNoInCons })++stmt :: JSParser Stmt+stmt =+  do { b <- block; return $ StmtBlock b } <|>+  do { vs <- varStmt; return $ StmtVar vs } <|>+  do { es <- emptyStmt; return $ StmtEmpty es } <|>+  try (do { es <- exprStmt; return $ StmtExpr es }) <|>+  do { ic <- contStmt; return $ StmtCont ic } <|>+  do { is <- ifStmt; return $ StmtIf is } <|>+  do { is <- itStmt; return $ StmtIt is } <|>+  do { bs <- breakStmt; return $ StmtBreak bs } <|>+  do { rs <- returnStmt; return $ StmtReturn rs } <|>+  do { ws <- withStmt; return $ StmtWith ws } <|>+  do { ss <- switchStmt; return $ StmtSwitch ss } <|>+  do { ts <- throwStmt; return $ StmtThrow ts } <|>+  do { ts <- tryStmt; return $ StmtTry ts } <|>+  do { ds <- dbgStmt; return $ StmtDbg ds } <|>+  do { ls <- labelledStmt; return $ StmtLabelled ls }++block :: JSParser Block+block =+  do { punctuator "{"; msl <- optionMaybe stmtList; punctuator "}"; return $ Block msl }++stmtList :: JSParser StmtList+stmtList =+  chainl1'+  (do { s <- stmt; return $ StmtList s })+  stmt+  (do { return StmtListCons })++varStmt :: JSParser VarStmt+varStmt =+  do { identName "var"; vdl <- varDeclList; return $ VarStmt vdl }++varDeclList :: JSParser VarDeclList+varDeclList =+  chainl1'+  (do { vd <- varDecl; return $ VarDeclList vd})+  varDecl+  (do { punctuator ","; return $ VarDeclListCons })++varDeclListNoIn :: JSParser VarDeclListNoIn+varDeclListNoIn =+  chainl1'+  (do { vd <- varDeclNoIn; return $ VarDeclListNoIn vd})+  varDeclNoIn+  (do { punctuator ","; return $ VarDeclListNoInCons})++varDecl :: JSParser VarDecl+varDecl =+  do { i <- getIdent; mInit <- optionMaybe initialiser; return $ VarDecl i mInit }++varDeclNoIn :: JSParser VarDeclNoIn+varDeclNoIn =+  do { i <- getIdent; mInit <- optionMaybe initialiserNoIn; return $ VarDeclNoIn i mInit }++initialiser :: JSParser Initialiser+initialiser =+  do { punctuator "="; ae <- assignExpr; return $ Initialiser ae }++initialiserNoIn :: JSParser InitialiserNoIn+initialiserNoIn =+  do { punctuator "="; ae <- assignExprNoIn; return $ InitialiserNoIn ae }++emptyStmt :: JSParser EmptyStmt+emptyStmt =+  do { punctuator ";"; return EmptyStmt }++exprStmt :: JSParser ExprStmt+exprStmt =+  do { notFollowedBy (try $ punctuator "{" <|> identName "function"); e <- expr; autoSemi; return $ ExprStmt e }++ifStmt :: JSParser IfStmt+ifStmt =+  try (do { identName "if"; punctuator "("; e <- expr; punctuator ")"; s1 <- stmt; identName "else"; s2 <- stmt; return $ IfStmtIfElse e s1 s2 }) <|>+  do { identName "if"; punctuator "("; e <- expr; punctuator ")"; s <- stmt; return $ IfStmtIf e s }++itStmt :: JSParser ItStmt+itStmt =+  try (do { identName "do"; s <- stmt; identName "while"; punctuator "("; e <- expr; punctuator ")"; return $ ItStmtDoWhile s e }) <|>+  try (do { identName "while"; punctuator "("; e <- expr; punctuator ")"; s <- stmt; return $ ItStmtWhile e s }) <|>+  try (do { identName "for"; punctuator "("; me1 <- optionMaybe exprNoIn; punctuator ";"; me2 <- optionMaybe expr; punctuator ";"; me3 <- optionMaybe expr; punctuator ")"; s <- stmt; return $ ItStmtFor me1 me2 me3 s }) <|>+  try (do { identName "for"; punctuator "("; identName "var"; vdl <- varDeclListNoIn; punctuator ";"; me1 <- optionMaybe expr; punctuator ";"; me2 <- optionMaybe expr; punctuator ")"; s <- stmt; return $ ItStmtForVar vdl me1 me2 s }) <|>+  do { identName "for"; punctuator "("; le <- leftExpr; identName "in"; e <- expr; punctuator ")"; s <- stmt; return $ ItStmtForIn le e s } <|>+  do { identName "for"; punctuator "("; identName "var"; vd <- varDeclNoIn; identName "in"; e <- expr; punctuator ")"; s <- stmt; return $ ItStmtForVarIn vd e s }++contStmt :: JSParser ContStmt+contStmt =+  try (do { identName "continue"; autoSemi; return ContStmt }) <|>+  do { identName "continue"; noLineTerminatorHere; i <- getIdent; autoSemi; return $ ContStmtLabelled i }++breakStmt :: JSParser BreakStmt+breakStmt =+  try (do { identName "break"; autoSemi; return BreakStmt }) <|>+  do { identName "break"; noLineTerminatorHere; i <- getIdent; autoSemi; return $ BreakStmtLabelled i }++returnStmt :: JSParser ReturnStmt+returnStmt =+  try (do { identName "return"; autoSemi; return ReturnStmt }) <|>+  do { identName "return"; noLineTerminatorHere; e <- expr; autoSemi; return $ ReturnStmtExpr e }++withStmt :: JSParser WithStmt+withStmt =+  do { identName "with"; punctuator "("; e <- expr; punctuator ")"; s <- stmt; return $ WithStmt e s }++switchStmt :: JSParser SwitchStmt+switchStmt =+  do { identName "switch"; punctuator "("; e <- expr; punctuator ")"; cb <- caseBlock; return $ SwitchStmt e cb }++caseBlock :: JSParser CaseBlock+caseBlock =+  try (do { punctuator "{"; mcc <- optionMaybe caseClauses; punctuator "}"; return $ CaseBlock mcc }) <|>+  do { punctuator "{"; mcc1 <- optionMaybe caseClauses; dc <- defaultClause; mcc2 <- optionMaybe caseClauses; punctuator "}"; return $ CaseBlockDefault mcc1 dc mcc2 }++caseClauses :: JSParser CaseClauses+caseClauses =+  chainl1'+  (do { cc <- caseClause; return $ CaseClauses cc })+  caseClause+  (do { return $ CaseClausesCons })++caseClause :: JSParser CaseClause+caseClause =+  do { identName "case"; e <- expr; punctuator ":"; msl <- optionMaybe stmtList; return $ CaseClause e msl }++defaultClause :: JSParser DefaultClause+defaultClause =+  do { identName "default"; punctuator ":"; msl <- optionMaybe stmtList; return $ DefaultClause msl }++labelledStmt :: JSParser LabelledStmt+labelledStmt =+  do { i <- getIdent; punctuator ":"; s <- stmt; return $ LabelledStmt i s }++throwStmt :: JSParser ThrowStmt+throwStmt =+  do { identName "throw"; noLineTerminatorHere; e <- expr; autoSemi; return $ ThrowStmt e }++tryStmt :: JSParser TryStmt+tryStmt = do+  identName "try"+  b <- block+  do { f <- finally; return $ TryStmtBF b f } <|>+    do { c <- catch;+         do { f <- finally; return $ TryStmtBCF b c f } <|>+         do { return $ TryStmtBC b c }+       }++catch :: JSParser Catch+catch =+  do { identName "catch"; punctuator "("; i <- getIdent; punctuator ")"; b <- block; return $ Catch i b }++finally :: JSParser Finally+finally =+  do { identName "finally"; b <- block; return $ Finally b }++dbgStmt :: JSParser DbgStmt+dbgStmt =+  do { identName "debugger"; autoSemi; return DbgStmt }++funcDecl :: JSParser FuncDecl+funcDecl =+  do { identName "function"; i <- getIdent; punctuator "("; mfpl <- optionMaybe formalParamList; punctuator ")"; punctuator "{"; fb <- funcBody; punctuator "}"; return $ FuncDecl i mfpl fb }++funcExpr :: JSParser FuncExpr+funcExpr =+  do { identName "function"; mi <- optionMaybe getIdent; punctuator "("; mfpl <- optionMaybe formalParamList; punctuator ")"; punctuator "{"; fb <- funcBody; punctuator "}"; return $ FuncExpr mi mfpl fb }++formalParamList :: JSParser FormalParamList+formalParamList =+  chainl1'+  (do { i <- getIdent; return $ FormalParamList i })+  getIdent+  (do { punctuator ","; return $ FormalParamListCons })++funcBody :: JSParser FuncBody+funcBody =+  do { mse <- optionMaybe sourceElements; return $ FuncBody mse }++program :: JSParser Program+program =+  do { mse <- optionMaybe sourceElements; return $ Program mse }++sourceElements :: JSParser SourceElements+sourceElements =+  chainl1'+  (do { se <- sourceElement; return $ SourceElements se })+  sourceElement+  (do { return SourceElementsCons })++sourceElement :: JSParser SourceElement+sourceElement =+  do { s <- stmt; return $ SourceElementStmt s } <|>+  do { fd <- funcDecl; return $ SourceElementFuncDecl fd }++parseJavaScript :: String -> Either ParseError Program+parseJavaScript input =+  let p = many lineTerminator *> program <* many lineTerminator <* eof+  in runParser p newJSPState "" $ lexJavaScript input
+ src/Language/JavaScript/Prim.hs view
@@ -0,0 +1,107 @@+module Language.JavaScript.Prim where++import Control.Monad (guard, void)++import Text.Parsec ((<|>),+                    SourcePos,+                    eof, many)+import Text.Parsec.Prim (getState, lookAhead, modifyState)+import Text.Parsec.Token (GenLanguageDef(..))+import Text.ParserCombinators.Parsec.Prim (GenParser)+import qualified Text.ParserCombinators.Parsec.Prim as Parsec (token)++import Language.JavaScript.AST+import Language.JavaScript.Lexer hiding (token, lineTerminator, punctuator)++data JSPState+  = JSPState+    { jspStateNLFlag :: Bool }++getNLFlag :: JSParser Bool+getNLFlag = do { s <- getState; return $ jspStateNLFlag s }+setNLFlag :: JSParser ()+setNLFlag = modifyState $ \s -> s { jspStateNLFlag = True }+unsetNLFlag :: JSParser ()+unsetNLFlag = modifyState $ \s -> s { jspStateNLFlag = False }++newJSPState :: JSPState+newJSPState = JSPState {+  jspStateNLFlag = False }++type JSParser a = GenParser (SourcePos, InputElement) JSPState a++lexeme :: JSParser a -> JSParser a+lexeme p =+  do { x <- p; unsetNLFlag; void $ many lineTerminator; return x }++mytoken :: (InputElement -> Maybe a) -> JSParser a+mytoken test =+  Parsec.token showTok posFromTok testTok+  where+    showTok (pos, t)    = show t+    posFromTok (pos, t) = pos+    testTok (pos, t)    = test t++equal :: InputElement -> JSParser ()+equal test = mytoken (\tok -> if tok == test then Just () else Nothing)++lineTerminator :: JSParser ()+lineTerminator =+  do { equal InputElementLineTerminator; setNLFlag }++noLineTerminatorHere :: JSParser ()+noLineTerminatorHere =+  do { nl <- getNLFlag; guard (not nl) }++priorNL :: JSParser ()+priorNL =+  do { nl <- getNLFlag; guard nl }++autoSemi :: JSParser ()+autoSemi =+  punctuator ";" <|>+  priorNL <|>+  void (lookAhead $ punctuator "}") <|>+  eof++identName :: String -> JSParser ()+identName s = lexeme $ equal $ InputElementIdentName $ IdentName s++getIdentName :: JSParser IdentName+getIdentName = lexeme $ mytoken get+  where+    get (InputElementIdentName i) = Just i+    get _ = Nothing++getIdent :: JSParser Ident+getIdent = lexeme $ mytoken get+  where+    get (InputElementIdentName i@(IdentName n)) =+      if n `elem` reservedNames javaScript+      then Nothing+      else Just $ Ident i+    get _ = Nothing++punctuator :: String -> JSParser ()+punctuator p = lexeme $ equal $ InputElementPunctuator $ Punctuator p++getLiteral :: JSParser Literal+getLiteral = lexeme $ mytoken get+  where+    get (InputElementLiteral l) = Just l+    get (InputElementIdentName (IdentName "null")) = Just $ LiteralNull NullLit+    get (InputElementIdentName (IdentName "true")) = Just $ LiteralBool $ BoolLit True+    get (InputElementIdentName (IdentName "false")) = Just $ LiteralBool $ BoolLit False+    get _ = Nothing++getNumLit :: JSParser NumLit+getNumLit = lexeme $ mytoken get+  where+    get (InputElementLiteral (LiteralNum n)) = Just n+    get _ = Nothing++getStringLit :: JSParser StringLit+getStringLit = lexeme $ mytoken get+  where+    get (InputElementLiteral (LiteralString s)) = Just s+    get _ = Nothing
+ src/Language/JavaScript/String.hs view
@@ -0,0 +1,67 @@+module Language.JavaScript.String+       where++import Control.Applicative ((<*), (<$>))+import Control.Monad (void)++import Text.Parsec+import Text.ParserCombinators.Parsec.Char++import Language.JavaScript.Lexer++stringNumericLiteral :: CharParser st Double+stringNumericLiteral = do+  mb <- optional strWhiteSpace+  do { n <- strNumericLiteral; optional strWhiteSpace; return n } <|>+    do { return 0 }++strWhiteSpace :: CharParser st ()+strWhiteSpace =+  do { strWhiteSpaceChar; void $ optionMaybe strWhiteSpace }++strWhiteSpaceChar :: CharParser st ()+strWhiteSpaceChar = void $+  whiteSpace <|>+  lineTerminator++strNumericLiteral :: CharParser st Double+strNumericLiteral =+  (fromIntegral <$> hexIntegerLiteral) <|>+  strDecimalLiteral++strDecimalLiteral :: CharParser st Double+strDecimalLiteral =+  strUnsignedDecimalLiteral <|>+  do { void $ char '+'; strUnsignedDecimalLiteral } <|>+  do { void $ char '-'; mv <- strUnsignedDecimalLiteral;+       if mv == 0+       then return 0+       else return (-mv) }++strUnsignedDecimalLiteral :: CharParser st Double+strUnsignedDecimalLiteral =+  do { void $ string "Infinity"; return 0 } <|>+  do { (mv, _) <- try $ do { decimalDigits <* char '.' };+       mdv <- optionMaybe decimalDigits;+       mev <- optionMaybe exponentPart;+       case (mdv, mev) of+        (Nothing, Nothing) -> return (fromIntegral mv)+        (Just (dv, n), Nothing) ->+          return $ (fromIntegral mv) + (fromIntegral dv) * 10 ^^ (-n)+        (Nothing, Just ev) -> return $ (fromIntegral mv) * 10 ^^ ev+        (Just (dv, n), Just ev) ->+          return $ ((fromIntegral mv) + (fromIntegral dv) * 10 ^^ (-n)) * 10 ^^ ev} <|>+  do { void $ char '.'; (dv, n) <- decimalDigits; mev <- optionMaybe exponentPart;+       case mev of+        Nothing -> return $ (fromIntegral dv) * 10 ^^ (-n)+        Just ev -> return $ (fromIntegral dv) * 10 ^^ (ev - n) } <|>+  do { (dv, _) <- decimalDigits; mev <- optionMaybe exponentPart;+       case mev of+        Nothing -> return (fromIntegral dv)+        Just ev -> return $ (fromIntegral dv) * 10 ^^ ev }++parseString :: String -> Maybe Double+parseString s =+  case runParser stringNumericLiteral () "" s of+   Right l -> Just l+   Left _  -> Nothing
+ src/Language/JavaScript/SubType.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverlappingInstances,+             FlexibleInstances,+             IncoherentInstances,+             MultiParamTypeClasses,+             TypeOperators,+             TypeSynonymInstances #-}++module Language.JavaScript.SubType+       where++import Control.Monad (join)++type a + b = Either a b+infixr 6 +++class SubType sub sup where+  inj :: sub -> sup+  prj :: sup -> Maybe sub++instance SubType a a where+  inj = id+  prj = Just++instance SubType a (a + b) where+  inj = Left+  prj (Left x) = Just x+  prj _ = Nothing++instance (SubType a c) => SubType a (b + c) where+  inj = Right . inj+  prj (Right c) = prj c+  prj _ = Nothing++instance (SubType b d) => SubType (a + b) (a + c + d) where+  inj (Left a) = Left a+  inj (Right b) = Right . Right $ inj b+  prj (Left a) = Just (Left a)+  prj (Right (Left _)) = Nothing+  prj (Right (Right d)) = Right `fmap` prj d++instance SubType a b => SubType a (Maybe b) where+  inj = Just . inj+  prj a = join $ fmap prj a
+ src/Language/JavaScript/Util.hs view
@@ -0,0 +1,12 @@+module Language.JavaScript.Util+       where++import Text.Parsec++applyRest :: Stream s m t =>+             ParsecT s u m (b -> ParsecT s u m b) -> b -> ParsecT s u m b+applyRest pr a = do+  mr <- optionMaybe $ try pr+  case mr of+   Just r -> r a+   Nothing -> return a