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

インタプリタその1

* Util0 + 
* 変数宣言

 Expr -> Expr * Expr 
       | Expr + Expr 
       | Const
       | ( Expr )
       | Ident
       | let Ident = Expr in Expr

       
 ----------------------------------------------------------------------}
module Var where {
import Text.ParserCombinators.Parsec;
import Text.ParserCombinators.Parsec.Expr;
import Token;

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

showValue (Num d) = show d;

type Decl = (String, Expr);
data Expr = Mult Expr Expr | Add Expr Expr | Const Value
          | Let Decl Expr {- Let [Decl] Expr -} | Var String  
            deriving (Eq, Show);

parseExpr = buildExpressionParser table parseFactor <?> "expression";

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

parseFactor = parens parseExpr
              <|>
              (do { t <- naturalOrFloat;
		    return (case t of { Left i -> Const (Num (fromInteger i));
					Right d -> Const (Num d) }) })
	      <|>
              (do { t <- identifier; return (Var t) })
	      <|>
	      (do { reserved "let";
--		    decls <- parseDecls; 
		    decl <- parseDecl;
		    reserved "in";
		    expr  <- parseExpr;
--		    return (Let decls expr)
		    return (Let decl expr)
		  })
;

parseDecls = sepBy1 parseDecl semi;
parseDecl = do {
		i <- identifier;
		symbol "=";
		e <- parseExpr;
		return (i, e)
	       }
;

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

 インタプリタ

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

type M a = a;

unitM :: a -> M a;
unitM a = a;

bindM :: M a -> (a -> M b) -> M b;
m `bindM` k = k m;
{-
 -- Monadic Version
interp :: Expr -> Env -> M Value;
interp (Const c) e  = unitM c;
interp (Add m n) e  = interp m e `bindM` \ (Num c) ->
                      interp n e `bindM` \ (Num d) ->
                      unitM (Num (c+d));
interp (Mult m n) e = interp m e `bindM` \ (Num c) ->
                      interp n e `bindM` \ (Num d) ->
                      unitM (Num (c*d));
interp (Var x) e    =  unitM (lookupEnv e x);
interp (Let (x, m) n) e = interp m e `bindM` \ v  -> 
                          interp n ((x,v):e);
-}

type Env = [(String, Value)];

lookup' :: Eq a =>  a -> [(a, b)] -> b;
lookup' x ((n,v):rest) = if n==x then v else lookup' x rest;

 -- Non-Monadic Version 
interp :: Expr -> Env -> Value;
interp (Const c) e  = c;
interp (Add m n) e  = let { 
                        Num c = interp m e;
                        Num d = interp n e 
                      } in 
                      Num (c+d);
interp (Mult m n) e = let { 
                        Num c = interp m e;
                        Num d = interp n e 
                      } in 
                      Num (c*d);
interp (Var x) e    = lookup' x e;
interp (Let (x, m) n) e = let { v = interp m e } in
                          interp n ((x,v):e);


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)

-- for example
-- run "let x=2*2 in let y=x*x in y*y"
}