module ErrSTType 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;
  m `bindErr` k = case m of {
                    Success a -> k a;
                    Failure str   -> Failure str
                  }; 

  type MyState = (Value, Value);

  type M a = MyState -> Err (a, MyState);

  unitM :: a -> M a;
  unitM a = \ s -> unitErr (a, s);

  bindM :: M a -> (a -> M b) -> M b ;
  m `bindM` k = \ s0 -> case m s0 of {
                          Success (a, s1) -> k a s1;
                          Failure err     -> Failure err
                        };

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

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

  setX :: Value -> M Value;
  {- setXの定義を考えてください  -}

  setY :: Value -> M Value;
  {- setYの定義を考えてください  -}

  getX :: M Value;  
  {- getXの定義を考えてください  -}

  getY :: M Value;
  {- getYの定義を考えてください  -}

  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 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
            | Fail Expr 
            | GetX | SetX Expr | GetY | SetY Expr 
            | While Expr Expr | Begin [Expr] 
              deriving Show;
}