module OOPType where {

type Dict = [((String, String), Value)];
data Value = Num Double | Bool Bool | Str String | Char Char 
           | Fun (Value -> M Value) | Pair Value Value 
           | MethodV String | ObjectV String [Value];

-- Value値を表示するために必要
instance Show Value where {
  showsPrec p (Num d)  = showParen (p>8) (showString "Num " . shows d);
  showsPrec p (Bool b) = showParen (p>8) (showString "Bool " . shows b);
  showsPrec p (Str d)  = showParen (p>8)
                         (showString "Str " . showChar '"' . showString d. showChar '"');
  showsPrec p (Char c) = showParen (p>8) (showChar '\'' . showChar c . showChar '\'');
  showsPrec p (Fun f)  = showParen (p>8) (showString "Fun <function>");
  showsPrec p (Pair v1 v2) = showParen (p>8) (showChar '(' . showsPrec 0 v1 .
                                              showString ", " . showsPrec 0 v2 .
                                              showChar ')');
};

showValue (Num d)   = show d;
showValue (Bool b)  = show b;
showValue (Str str) = str;
showValue (Char c)  = [c];
showValue (Fun _)   = "<function>";
showValue (Pair v1 v2) = "("++show v1++", "++show v2++")";

-- Exprの抽象構文

type CPat = (String, [String]);

data Pat = SimplePat String | AsPat String CPat | ConsPat CPat deriving Show; 

type Lhs = (String, [String]);

type Decl = (Lhs, Expr);

data Expr = Const Value | Let Decl Expr | Var String  
          | Lambda String Expr | App Expr Expr | If Expr Expr Expr 
          | Letrec Decl Expr
            deriving Show;

type MethodLhs = (String, [Pat]);

type MethodDecl = (MethodLhs, Expr);
    
type ClassDecl   = Decl;

data Global = LetG Decl Global | LetrecG Decl Global
            | ClassG [ClassDecl] Global | MethodG [MethodDecl] Global
            | ExprG Expr deriving Show;

type Id a = a;

unitId :: a -> Id a;
unitId a = a;

bindId :: Id a -> (a -> Id b) -> Id b;
m `bindId` k = k m;

type M a = Dict -> a;

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

bindM :: M a -> (a -> M b) -> M b;
m `bindM` k = \ d -> let { a = m d } in k a d;

failM :: String -> M Value;
failM str = unitM (Str str);

--     by Daniel P. Friedman and Amr Sabry
mfixU :: ((a -> M b) -> M (a -> M b)) -> M (a -> M b);
mfixU e = unitM (\ a -> mfixU e `bindM` \ v -> v a) `bindM` \ v ->
          e v;
}