module RecType where {

  -- Monadic Versionのために必要
  type M a = a;

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

  bindM :: M a -> (a -> M b) -> M b;
  m `bindM` k = k m;

  {-
  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 f = f (\ a -> mfixU f `bindM` \ v -> v a);

  data Value = Num Double | Bool Bool | Str String | Char Char
             | Fun (Value -> M Value) | Pair Value Value | Unit;

  -- 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 ')');
    showsPrec p Unit     = showString "Unit" 
  };

  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++")";
  showValue Unit      = "";

  -- Exprの抽象構文
  {- type Decls = [(String, Expr)] -}
  type Decl = (String, 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;
    
}