@@ -89,10 +89,10 @@ withCC ct proc = returnCont :: ContType -> Value -> Evaluate Value returnCont ct value = - do debug $ "returnCont: " ++ show ct ++ " " ++ show value - cont <- popCont + do cont <- popCont if contType cont == ct - then do modifyScope $ contScope cont + then do debug $ "returnCont: " ++ show ct ++ " " ++ show value + modifyScope $ contScope cont (contRecv cont) value else returnCont ct value Context.hs @@ -4,11 +4,11 @@ Haskell内部の型 -} -module DataTypes (module DataTypes, Control.Monad.Trans.liftIO) where +module DataTypes (module DataTypes, liftIO) where import Data.Map (Map, assocs) import qualified Data.Map as Map import Data.IORef -import System.IO.Unsafe +import System.IO.Unsafe (unsafePerformIO) import Control.Monad.Trans (liftIO) import Control.Monad.State import Control.Monad.Cont hiding (Cont) @@ -36,18 +36,16 @@ type Evaluate a = ContT Value (StateT Env IO) a data Env - = Env { envFrames :: [Frame], envContStack :: [Cont], envFlags :: [Flag], envEvaluatee :: Expression } + = Env { envFrames :: [Frame], envContStack :: [Cont], envFlags :: [Flag] } instance Show Env where - show (Env { envFrames = frames, envContStack = conts, envFlags = flags, envEvaluatee = evaluatee }) = + show (Env { envFrames = frames, envContStack = conts, envFlags = flags }) = " Frames:\n" ++ (unlines $ map (" " ++) $ map show frames) ++ " Cont:\n" ++ (unlines $ map (" " ++) $ map show conts) ++ " Flags:\n " ++ - (unwords $ map show flags) ++ - " Evaluatee:\n " ++ - show evaluatee + (unwords $ map show flags) data Frame = GlobalFrame { frObject :: Value, frThis :: Value } @@ -233,9 +231,9 @@ instance Eq Number where NaN == _ = False _ == NaN = False (Integer n) == (Integer m) = n == m - (Double n) == (Double m) = n == m - (Integer n) == (Double m) = (toEnum $ fromEnum n) == m - (Double n) == (Integer m) = n == (toEnum $ fromEnum m) + (Double n) == (Double m) = n == m + (Integer n) == (Double m) = (toEnum $ fromEnum n) == m + (Double n) == (Integer m) = n == (toEnum $ fromEnum m) data PropertyPair = PropertyPair { propValue :: Value, propAttr :: [PropertyAttribute] } @@ -321,7 +319,7 @@ nullFunction = Function { nullNativeFunc :: NativeObject nullNativeFunc = NativeFunction { funcArity = 0, - funcNatCode = undefined + funcNatCode = error "nullNativeFunc: undefined funcNatCode" } nativeFunc :: String -> Int -> NativeCode -> Value @@ -431,7 +429,7 @@ getName _ = "" toDouble :: Number -> Double toDouble (Integer n) = fromIntegral n toDouble (Double n) = n -toDouble NaN = undefined +toDouble NaN = error "toDouble: NaN" instance ToValue Int where toValue n = Number $ Integer $ toEnum n @@ -566,6 +564,15 @@ instance Show Expression where else showParen True (foldl1 (\x y -> x . showString "," . y) $ map shows args)) + showsPrec p (Operator op@"?:" [x, y, z]) + = showParen (prec < p) + $ showsPrec prec x + . showString " ? " + . showsPrec prec y + . showString " : " + . showsPrec prec z + where prec = fromMaybe (length opPrecedence) (findIndex (op `elem`) opPrecedence) + showsPrec p (Operator op [x, y]) = showParen (prec < p) $ showsPrec prec x @@ -575,23 +582,44 @@ instance Show Expression where . showsPrec prec y where prec = fromMaybe (length opPrecedence) (findIndex (op `elem`) opPrecedence) + showsPrec p (Operator op [x]) + = showParen (prec < p) + $ showString op + . showString " " + . showsPrec prec x + where prec = fromMaybe (length opPrecedence) (findIndex (op `elem`) opPrecedence) + + showsPrec _ (Operator _ _) + = error "showPrec: unknown operator" + + {- showsPrec p (Operator op xs) = showParen (prec < p) $ showString op . showString " " . showList xs where prec = fromMaybe (length opPrecedence) (findIndex (op `elem`) opPrecedence) + -} showsPrec _ (Let left right) = showString $ show left ++ " = " ++ show right opPrecedence :: [[String]] -opPrecedence = [ +opPrecedence = reverse [ ["[]", "new"], ["()"], ["_++", "_--"], ["delete", "void", "typeof", "++", "--", "+", "-", "~", "!"], ["*", "/", "%"], - ["+", "-"] + ["+", "-"], + ["<<", ">>", ">>>"], + ["<", ">", "<=", ">=", "instanceof", "in"], + ["==", "!=", "===", "!=="], + ["&"], + ["^"], + ["|"], + ["&&"], + ["||"], + ["?:"] ] showObjPair (p, v) = show p ++ ": " ++ show v @@ -765,7 +793,7 @@ instance Inspect Statement where = "STThrow " ++ inspect expr inspect (STTry { tryClause = clause, tryCatchClause = catch, tryFinallyClause = finally }) - = "STTry " ++ inspect clause ++ inspect catch ++ inspect finally + = "STTry " ++ inspect clause ++ " " ++ inspect catch ++ " " ++ inspect finally inspectShallow :: Value -> String inspectShallow (Object { objName = "" }) = "<Object ...>" DataTypes.hs @@ -11,8 +11,6 @@ import List import Maybe import qualified Data.Map as Map import Control.Monad.Cont hiding (Cont) -import Control.Monad.State (put) -import System.IO.Unsafe import DataTypes import {-# SOURCE #-} Operator @@ -29,7 +27,7 @@ evalProgram program = if null program || ParseOnly `elem` envFlags env then return Void else if (Debug `elem` envFlags env) - then liftM last $ mapM (\e -> do { liftIO $ ePutStrLn $ inspect e; eval e }) program + then liftM last $ mapM (\e -> do { liftIO $ ePutStrLn $ "parsed: " ++ inspect e; eval e }) program else liftM last $ mapM eval program instance Eval Statement where @@ -192,10 +190,8 @@ evalValue x = getValue =<< eval x -- Reference (Ref baseRef, p) の形になるまで評価する instance Eval Expression where eval expr = - do env <- getEnv - unless (isLiteral expr) - (do put env { envEvaluatee = expr } - debug $ show expr) + do unless (isLiteral expr) + (debug $ "eval: " ++ show expr) eval' expr where eval' (Identifier name) = @@ -363,18 +359,19 @@ callWithThis this ref@Ref { } args = callWithThis this ref@Reference { } args = do callee <- getValue ref - evaluatee <- liftM envEvaluatee getEnv ifM (toBoolean callee) (callWithThis this callee args) - (throw "TypeError" $ show evaluatee ++ " is not a function") + (throw "TypeError" $ show callee ++ " is not a function") + +callWithThis _ value _ = + throw "TypeError" $ show value ++ " is not a function" callMethod :: Value -> String -> [Value] -> Evaluate Value callMethod object name args = do method <- readRef =<< getProp object name - evaluatee <- liftM envEvaluatee getEnv if isFunction method || isNativeFunction method then callWithThis object method args - else throw "TypeError" $ show evaluatee ++ " is not a function" + else throw "TypeError" $ show method ++ " is not a function" -- 末尾再帰用 jumpToFunc :: Value -> [Value] -> Evaluate Value Eval.hs @@ -30,7 +30,7 @@ import Repl nullEnv :: [Flag] -> IO Env nullEnv flags = do global <- liftM Ref $ newIORef $ nullObject { objClass = "Global", objPrototype = Object.prototypeObject } - return $ Env { envFrames = [GlobalFrame global global], envContStack = [], envFlags = flags, envEvaluatee = undefined } + return $ Env { envFrames = [GlobalFrame global global], envContStack = [], envFlags = flags } setupEnv :: Evaluate () setupEnv = Init.hs @@ -353,5 +353,5 @@ p `ifFail` x = option x p pushArg :: Expression -> Expression -> Expression pushArg expr (Operator op args) = Operator op (expr:args) -pushArg _ _ = undefined +pushArg _ _ = error "pushArg: non operator pushed" -- }}} ParserUtil.hs @@ -33,7 +33,7 @@ runRepl' = liftIO $ putStrLn string env <- getEnv when (Debug `elem` envFlags env) - (liftIO $ putStrLn $ inspect value)) + (liftIO $ putStrLn $ "-> " ++ inspect value)) runRepl' where evalWithMoreInput input = case parse input of Repl.hs 9ba0770fed4b34720868e9a993884eccc148b746 motemen motemen@3e12a315-d43c-0410-9d47-cb5f01d91701 http://github.com/motemen/jusk/commit/d5e0226e6a64e0b769411876cd37d7dd1bba796f d5e0226e6a64e0b769411876cd37d7dd1bba796f 2007-12-30T03:02:49-08:00 2007-12-30T03:02:49-08:00 removed envEvaluatee; added debug messages. git-svn-id: svn+ssh://192.168.0.2/svn/public/jusk/trunk@205 3e12a315-d43c-0410-9d47-cb5f01d91701 f58a8018e7cd46b07f9d6f758b50e1c7d35f151b motemen motemen@3e12a315-d43c-0410-9d47-cb5f01d91701