{----------------------------------------------------------------------

インタプリタその0

* 基本形

 Expr -> Expr * Expr
       | Expr + Expr 
       | Const
       | ( Expr )

 ----------------------------------------------------------------------}
module Util0 where {

import Text.ParserCombinators.Parsec;
import Text.ParserCombinators.Parsec.Expr;
import Token;

data Value = Num Double deriving (Eq, Show);

showValue (Num d) = show d;

-- Expr
data Expr = Mult Expr Expr | Add Expr Expr | Const Value deriving (Eq, Show);

----------------------------------------------------------------------
-- パーサー

parseExpr :: GenParser Char a Expr;
parseExpr = buildExpressionParser table parseFactor <?> "expression";

table :: [[Operator Char a Expr]];
table = [
	 [ Infix (do { symbol "*"; return Mult }) AssocLeft],
	 [ Infix (do { symbol "+"; return Add }) AssocLeft]
	];

parseFactor :: GenParser Char a Expr;
parseFactor = parens parseExpr
	      <|> 
              (do { t <- naturalOrFloat;
		    return (case t of { Left i  -> Const (Num (fromInteger i));
					Right d -> Const (Num d) }) })
	      <?> "simple expression"
;


{----------------------------------------------------------------------

 インタプリタ

 ----------------------------------------------------------------------}

interp :: Expr -> Value;
interp (Const c)  = c;
interp (Add m n)  = let { 
                      Num c = interp m;
                      Num d = interp n 
                    } in 
                    Num (c+d);
interp (Mult m n) = let { 
                      Num c = interp m;
                      Num d = interp n 
                    } in 
                    Num (c*d);

myParse :: String -> Expr;
myParse str = case
	        (parse (do {whiteSpace; s<- parseExpr; eof; return s }) "" str)
	      of {
                Left err -> Const (Num (1/0));
	        Right x  -> x
	      }
;

run :: String -> String;
run str = showValue (interp (myParse str));

main :: IO ();
main = interact run;

load :: String -> IO ();
load path = readFile path >>= \ prog ->
   	    putStrLn (run prog)
}