module NonDetType where {

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 
          | Try Expr Expr
          | Letrec Decl Expr | Amb Expr Expr | Fail Expr
          {- | Uniq Expr -}
            deriving Show;

data List a = Cons a (List a) | Failure String
              deriving Show;

nil :: List a;
nil = Failure "";

hdL :: List a -> a;
hdL (Cons a _) = a;

tlL :: List a -> List a;
tlL (Cons _ as) = as;

showL (Cons a (Cons b cs)) = showValue a ++ " or " ++ showL (Cons b cs);
showL (Cons a _)           = showValue a;
showL (Failure str)        = "Failure: " ++ str;			

append :: List a -> List a -> List a;
(Cons x xs) `append` ys = Cons x (xs `append` ys);
(Failure s) `append` (Failure "") = Failure s;
(Failure s) `append` ys = ys;

type M a = List a;

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

bindM :: M a -> (a -> M b) -> M b;
(Cons x xs) `bindM` k = k x `append` (xs `bindM` k);
(Failure m) `bindM` k = Failure m;

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;

tryM :: List a -> List a -> List a;
tryM (Failure _) ys = ys;
tryM xs _           = xs;

}