module ErrType where {

data Err a = Success a | Failure String
             deriving Show;

showErr :: Err Value -> String;
showErr (Success a)   = showValue a;
showErr (Failure str) = "Error: "++str;

unitErr :: a -> Err a;
unitErr a = Success a ;

bindErr :: Err a -> (a -> Err b) -> Err b;
(Success a)   `bindErr` k = k a;
(Failure str) `bindErr` _ = Failure str;

type M a = Err a;

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

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

failM :: String -> M a;
failM message = Failure message;

--     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;

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;

}