{-# 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