Transfer added guards and Eq derivation.

src/Transfer/Core/Abs.hs

@@ -22,12 +22,12 @@ data Exp_
 type Exp = Tree Exp_
 data LetDef_
 type LetDef = Tree LetDef_
+data Case_
+type Case = Tree Case_
 data FieldType_
 type FieldType = Tree FieldType_
 data FieldValue_
 type FieldValue = Tree FieldValue_
-data Case_
-type Case = Tree Case_
 data TMeta_
 type TMeta = Tree TMeta_
 data CIdent_
@@ -63,9 +63,9 @@ data Tree :: * -> * where
     EDouble :: Double -> Tree Exp_
     EMeta :: TMeta -> Tree Exp_
     LetDef :: CIdent -> Exp -> Exp -> Tree LetDef_
+    Case :: Pattern -> Exp -> Exp -> Tree Case_
     FieldType :: CIdent -> Exp -> Tree FieldType_
     FieldValue :: CIdent -> Exp -> Tree FieldValue_
-    Case :: Pattern -> Exp -> Tree Case_
     TMeta :: String -> Tree TMeta_
     CIdent :: String -> Tree CIdent_
 
@@ -104,9 +104,9 @@ composOpM f t = case t of
     EVar cident -> return EVar `ap` f cident
     EMeta tmeta -> return EMeta `ap` f tmeta
     LetDef cident exp0 exp1 -> return LetDef `ap` f cident `ap` f exp0 `ap` f exp1
+    Case pattern exp0 exp1 -> return Case `ap` f pattern `ap` f exp0 `ap` f exp1
     FieldType cident exp -> return FieldType `ap` f cident `ap` f exp
     FieldValue cident exp -> return FieldValue `ap` f cident `ap` f exp
-    Case pattern exp -> return Case `ap` f pattern `ap` f exp
     _ -> return t
 
 composOpFold :: b -> (b -> b -> b) -> (forall a. Tree a -> b) -> Tree c -> b
@@ -132,9 +132,9 @@ composOpFold zero combine f t = case t of
     EVar cident -> f cident
     EMeta tmeta -> f tmeta
     LetDef cident exp0 exp1 -> f cident `combine` f exp0 `combine` f exp1
+    Case pattern exp0 exp1 -> f pattern `combine` f exp0 `combine` f exp1
     FieldType cident exp -> f cident `combine` f exp
     FieldValue cident exp -> f cident `combine` f exp
-    Case pattern exp -> f pattern `combine` f exp
     _ -> zero
 
 instance Show (Tree c) where
@@ -168,9 +168,9 @@ instance Show (Tree c) where
     EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n
     EMeta tmeta -> opar n . showString "EMeta" . showChar ' ' . showsPrec 1 tmeta . cpar n
     LetDef cident exp0 exp1 -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
+    Case pattern exp0 exp1 -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
     FieldType cident exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
     FieldValue cident exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
-    Case pattern exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp . cpar n
     TMeta str -> opar n . showString "TMeta" . showChar ' ' . showsPrec 1 str . cpar n
     CIdent str -> opar n . showString "CIdent" . showChar ' ' . showsPrec 1 str . cpar n
    where opar n = if n > 0 then showChar '(' else id
@@ -208,9 +208,9 @@ johnMajorEq (EInteger n) (EInteger n_) = n == n_
 johnMajorEq (EDouble d) (EDouble d_) = d == d_
 johnMajorEq (EMeta tmeta) (EMeta tmeta_) = tmeta == tmeta_
 johnMajorEq (LetDef cident exp0 exp1) (LetDef cident_ exp0_ exp1_) = cident == cident_ && exp0 == exp0_ && exp1 == exp1_
+johnMajorEq (Case pattern exp0 exp1) (Case pattern_ exp0_ exp1_) = pattern == pattern_ && exp0 == exp0_ && exp1 == exp1_
 johnMajorEq (FieldType cident exp) (FieldType cident_ exp_) = cident == cident_ && exp == exp_
 johnMajorEq (FieldValue cident exp) (FieldValue cident_ exp_) = cident == cident_ && exp == exp_
-johnMajorEq (Case pattern exp) (Case pattern_ exp_) = pattern == pattern_ && exp == exp_
 johnMajorEq (TMeta str) (TMeta str_) = str == str_
 johnMajorEq (CIdent str) (CIdent str_) = str == str_
 johnMajorEq _ _ = False
@@ -247,9 +247,9 @@ instance Ord (Tree c) where
     index (EDouble _) = 26
     index (EMeta _) = 27
     index (LetDef _ _ _) = 28
-    index (FieldType _ _) = 29
+    index (Case _ _ _) = 29
-    index (FieldValue _ _) = 30
+    index (FieldType _ _) = 30
-    index (Case _ _) = 31
+    index (FieldValue _ _) = 31
     index (TMeta _) = 32
     index (CIdent _) = 33
     compareSame (Module decls) (Module decls_) = compare decls decls_
@@ -281,9 +281,9 @@ instance Ord (Tree c) where
     compareSame (EDouble d) (EDouble d_) = compare d d_
     compareSame (EMeta tmeta) (EMeta tmeta_) = compare tmeta tmeta_
     compareSame (LetDef cident exp0 exp1) (LetDef cident_ exp0_ exp1_) = mappend (compare cident cident_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
+    compareSame (Case pattern exp0 exp1) (Case pattern_ exp0_ exp1_) = mappend (compare pattern pattern_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
     compareSame (FieldType cident exp) (FieldType cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
     compareSame (FieldValue cident exp) (FieldValue cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
-    compareSame (Case pattern exp) (Case pattern_ exp_) = mappend (compare pattern pattern_) (compare exp exp_)
     compareSame (TMeta str) (TMeta str_) = compare str str_
     compareSame (CIdent str) (CIdent str_) = compare str str_
     compareSame x y = error "BNFC error:" compareSame

src/Transfer/Core/Core.cf

@@ -47,6 +47,9 @@ separator LetDef ";" ;
 
 -- Case expressions.
 ECase.     Exp  ::= "case" Exp "of" "{" [Case] "}" ;
+Case.      Case ::= Pattern "|" Exp "->" Exp ;
+separator  Case ";" ;
+
 
 -- Lambda abstractions.
 EAbs.      Exp2 ::= "\\" PatternVariable "->" Exp ;
@@ -88,10 +91,6 @@ token TMeta ('?' digit+) ;
 coercions Exp 5 ;
 
 
-Case. Case ::= Pattern "->" Exp ;
-separator Case ";" ;
-
-
 -- Identifiers in core can start with underscore to allow
 -- generating unique identifiers easily.
 token CIdent ((letter | '_') (letter | digit | '_' | '\'')*) ;

src/Transfer/Core/Doc.tex

@@ -64,8 +64,8 @@ The symbols used in Core are the following: \\
 \begin{tabular}{lll}
 {\symb{;}} &{\symb{:}} &{\symb{\{}} \\
 {\symb{\}}} &{\symb{{$=$}}} &{\symb{(}} \\
-{\symb{)}} &{\symb{\_}} &{\symb{$\backslash$}} \\
+{\symb{)}} &{\symb{\_}} &{\symb{{$|$}}} \\
-{\symb{{$-$}{$>$}}} &{\symb{.}} & \\
+{\symb{{$-$}{$>$}}} &{\symb{$\backslash$}} &{\symb{.}} \\
 \end{tabular}\\
 
 \subsection*{Comments}
@@ -148,6 +148,16 @@ All other symbols are terminals.\\
  & {\delimit}  &{\nonterminal{LetDef}} {\terminal{;}} {\nonterminal{ListLetDef}}  \\
 \end{tabular}\\
 
+\begin{tabular}{lll}
+{\nonterminal{Case}} & {\arrow}  &{\nonterminal{Pattern}} {\terminal{{$|$}}} {\nonterminal{Exp}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{ListCase}} & {\arrow}  &{\emptyP} \\
+ & {\delimit}  &{\nonterminal{Case}}  \\
+ & {\delimit}  &{\nonterminal{Case}} {\terminal{;}} {\nonterminal{ListCase}}  \\
+\end{tabular}\\
+
 \begin{tabular}{lll}
 {\nonterminal{Exp2}} & {\arrow}  &{\terminal{$\backslash$}} {\nonterminal{PatternVariable}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
  & {\delimit}  &{\terminal{(}} {\nonterminal{PatternVariable}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{)}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
@@ -200,16 +210,6 @@ All other symbols are terminals.\\
 {\nonterminal{Exp1}} & {\arrow}  &{\nonterminal{Exp2}}  \\
 \end{tabular}\\
 
-\begin{tabular}{lll}
-{\nonterminal{Case}} & {\arrow}  &{\nonterminal{Pattern}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
-\end{tabular}\\
-
-\begin{tabular}{lll}
-{\nonterminal{ListCase}} & {\arrow}  &{\emptyP} \\
- & {\delimit}  &{\nonterminal{Case}}  \\
- & {\delimit}  &{\nonterminal{Case}} {\terminal{;}} {\nonterminal{ListCase}}  \\
-\end{tabular}\\
-
 
 
 \end{document}

src/Transfer/Core/Lex.x

@@ -16,7 +16,7 @@ $i = [$l $d _ ']          -- identifier character
 $u = [\0-\255]          -- universal: any character
 
 @rsyms =    -- reserved words consisting of special symbols
-   \; | \: | \{ | \} | \= | \( | \) | \_ | \\ | \- \> | \.
+   \; | \: | \{ | \} | \= | \( | \) | \_ | \| | \- \> | \\ | \.
 
 :-
 "--" [.]* ; -- Toss single line comments

src/Transfer/Core/Par.hs

@@ -121,16 +121,16 @@ happyIn22 x = unsafeCoerce# x
 happyOut22 :: (HappyAbsSyn ) -> ([LetDef])
 happyOut22 x = unsafeCoerce# x
 {-# INLINE happyOut22 #-}
-happyIn23 :: (Exp) -> (HappyAbsSyn )
+happyIn23 :: (Case) -> (HappyAbsSyn )
 happyIn23 x = unsafeCoerce# x
 {-# INLINE happyIn23 #-}
-happyOut23 :: (HappyAbsSyn ) -> (Exp)
+happyOut23 :: (HappyAbsSyn ) -> (Case)
 happyOut23 x = unsafeCoerce# x
 {-# INLINE happyOut23 #-}
-happyIn24 :: (Exp) -> (HappyAbsSyn )
+happyIn24 :: ([Case]) -> (HappyAbsSyn )
 happyIn24 x = unsafeCoerce# x
 {-# INLINE happyIn24 #-}
-happyOut24 :: (HappyAbsSyn ) -> (Exp)
+happyOut24 :: (HappyAbsSyn ) -> ([Case])
 happyOut24 x = unsafeCoerce# x
 {-# INLINE happyOut24 #-}
 happyIn25 :: (Exp) -> (HappyAbsSyn )
@@ -145,46 +145,46 @@ happyIn26 x = unsafeCoerce# x
 happyOut26 :: (HappyAbsSyn ) -> (Exp)
 happyOut26 x = unsafeCoerce# x
 {-# INLINE happyOut26 #-}
-happyIn27 :: (FieldType) -> (HappyAbsSyn )
+happyIn27 :: (Exp) -> (HappyAbsSyn )
 happyIn27 x = unsafeCoerce# x
 {-# INLINE happyIn27 #-}
-happyOut27 :: (HappyAbsSyn ) -> (FieldType)
+happyOut27 :: (HappyAbsSyn ) -> (Exp)
 happyOut27 x = unsafeCoerce# x
 {-# INLINE happyOut27 #-}
-happyIn28 :: ([FieldType]) -> (HappyAbsSyn )
+happyIn28 :: (Exp) -> (HappyAbsSyn )
 happyIn28 x = unsafeCoerce# x
 {-# INLINE happyIn28 #-}
-happyOut28 :: (HappyAbsSyn ) -> ([FieldType])
+happyOut28 :: (HappyAbsSyn ) -> (Exp)
 happyOut28 x = unsafeCoerce# x
 {-# INLINE happyOut28 #-}
-happyIn29 :: (FieldValue) -> (HappyAbsSyn )
+happyIn29 :: (FieldType) -> (HappyAbsSyn )
 happyIn29 x = unsafeCoerce# x
 {-# INLINE happyIn29 #-}
-happyOut29 :: (HappyAbsSyn ) -> (FieldValue)
+happyOut29 :: (HappyAbsSyn ) -> (FieldType)
 happyOut29 x = unsafeCoerce# x
 {-# INLINE happyOut29 #-}
-happyIn30 :: ([FieldValue]) -> (HappyAbsSyn )
+happyIn30 :: ([FieldType]) -> (HappyAbsSyn )
 happyIn30 x = unsafeCoerce# x
 {-# INLINE happyIn30 #-}
-happyOut30 :: (HappyAbsSyn ) -> ([FieldValue])
+happyOut30 :: (HappyAbsSyn ) -> ([FieldType])
 happyOut30 x = unsafeCoerce# x
 {-# INLINE happyOut30 #-}
-happyIn31 :: (Exp) -> (HappyAbsSyn )
+happyIn31 :: (FieldValue) -> (HappyAbsSyn )
 happyIn31 x = unsafeCoerce# x
 {-# INLINE happyIn31 #-}
-happyOut31 :: (HappyAbsSyn ) -> (Exp)
+happyOut31 :: (HappyAbsSyn ) -> (FieldValue)
 happyOut31 x = unsafeCoerce# x
 {-# INLINE happyOut31 #-}
-happyIn32 :: (Case) -> (HappyAbsSyn )
+happyIn32 :: ([FieldValue]) -> (HappyAbsSyn )
 happyIn32 x = unsafeCoerce# x
 {-# INLINE happyIn32 #-}
-happyOut32 :: (HappyAbsSyn ) -> (Case)
+happyOut32 :: (HappyAbsSyn ) -> ([FieldValue])
 happyOut32 x = unsafeCoerce# x
 {-# INLINE happyOut32 #-}
-happyIn33 :: ([Case]) -> (HappyAbsSyn )
+happyIn33 :: (Exp) -> (HappyAbsSyn )
 happyIn33 x = unsafeCoerce# x
 {-# INLINE happyIn33 #-}
-happyOut33 :: (HappyAbsSyn ) -> ([Case])
+happyOut33 :: (HappyAbsSyn ) -> (Exp)
 happyOut33 x = unsafeCoerce# x
 {-# INLINE happyOut33 #-}
 happyInTok :: Token -> (HappyAbsSyn )
@@ -195,19 +195,19 @@ happyOutTok x = unsafeCoerce# x
 {-# INLINE happyOutTok #-}
 
 happyActOffsets :: HappyAddr
-happyActOffsets = HappyA# "\x35\x00\x67\x01\xd4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x00\x00\x00\x83\x01\xdd\x00\x00\x00\x00\x00\x53\x01\x0f\x00\x00\x00\x67\x01\xdc\x00\xdb\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\xbb\x00\x00\x00\xd2\x00\xc4\x00\xcc\x00\x35\x00\x67\x01\x67\x01\xb4\x00\xb4\x00\xb4\x00\xc3\x00\x00\x00\xc1\x00\x00\x00\x7b\x01\xc2\x00\xbc\x00\xa9\x00\xba\x00\x67\x01\x00\x00\x00\x00\x67\x01\x67\x01\xb7\x00\xb9\x00\xb8\x00\xae\x00\xb3\x00\xaf\x00\xa6\x00\xad\x00\xa8\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x67\x01\x8d\x00\x00\x00\x86\x00\x67\x01\x00\x00\x86\x00\x67\x01\x91\x00\x85\x00\x67\x01\x9c\x01\x00\x00\x90\x00\x8c\x00\x00\x00\x00\x00\x8b\x00\x00\x00\x93\x00\x8a\x00\x73\x00\x00\x00\x88\x00\x80\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\x00\x00\x77\x00\x58\x00\x00\x00\x67\x01\x58\x00\x00\x00\x00\x00\x9c\x01\x67\x01\x67\x01\x00\x00\x00\x00\x00\x00\x97\x01\x76\x00\x61\x00\x5d\x00\x00\x00\x54\x00\x4e\x00\x42\x00\x00\x00\x2b\x00\x67\x01\x00\x00\x2b\x00\x9c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+happyActOffsets = HappyA# "\x15\x00\x73\x01\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x00\x00\x00\x90\x01\xe0\x00\x00\x00\x00\x00\x5e\x01\x09\x00\x00\x00\x73\x01\xdf\x00\xde\x00\xdd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\xbd\x00\x00\x00\xd7\x00\xc9\x00\xd0\x00\x15\x00\x73\x01\x73\x01\xc0\x00\xc0\x00\xc0\x00\xbe\x00\x00\x00\xc7\x00\x00\x00\x88\x01\xcd\x00\xc6\x00\xab\x00\xbb\x00\x73\x01\x00\x00\x00\x00\x73\x01\x73\x01\xc3\x00\xc2\x00\xbc\x00\xb8\x00\xb6\x00\xb9\x00\xaf\x00\xb2\x00\xb1\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x73\x01\x95\x00\x00\x00\x8f\x00\x73\x01\x00\x00\x8f\x00\x73\x01\x90\x00\x85\x00\x73\x01\xad\x01\x00\x00\x97\x00\x8c\x00\x00\x00\x00\x00\x8e\x00\x00\x00\x8d\x00\x91\x00\x7a\x00\x00\x00\x8a\x00\x87\x00\x00\x00\x73\x01\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x69\x00\x00\x00\x73\x01\x69\x00\x00\x00\x00\x00\xad\x01\x73\x01\x73\x01\x00\x00\x71\x00\x00\x00\xa5\x01\x75\x00\x78\x00\x74\x00\x00\x00\x6d\x00\x65\x00\x5c\x00\x00\x00\x43\x00\x73\x01\x00\x00\x43\x00\xad\x01\x00\x00\x00\x00\x73\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
 
 happyGotoOffsets :: HappyAddr
-happyGotoOffsets = HappyA# "\x04\x00\x32\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x01\x00\x00\x00\x00\x00\x00\x12\x00\x49\x00\x00\x00\x29\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x2e\x00\x0e\x01\x05\x01\x14\x00\x25\x00\x6c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xea\x00\x00\x00\x00\x00\xe1\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x00\x00\x00\x00\x00\x0c\x00\xa2\x00\x00\x00\x02\x00\x99\x00\x00\x00\x48\x00\x7e\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x01\x00\x00\x5a\x00\x66\x00\x29\x00\x00\x00\x01\x00\x51\x00\x36\x00\x00\x00\x00\x00\x00\x00\xb8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x01\x2d\x00\x00\x00\x5b\x00\xb3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+happyGotoOffsets = HappyA# "\x4e\x00\x3a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x01\x00\x00\x00\x00\x00\x00\x01\x00\x04\x00\x00\x00\x31\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x00\x00\x6a\x00\x14\x01\x0b\x01\x28\x00\x44\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\xee\x00\x00\x00\x00\x00\xe5\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\x00\x00\x00\x00\x00\x02\x00\xa2\x00\x00\x00\x1e\x00\x99\x00\x00\x00\x03\x00\x7c\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x56\x00\x3e\x00\xff\xff\x00\x00\xbd\x01\x4d\x00\x30\x00\x00\x00\x00\x00\x00\x00\xd2\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x27\x00\x00\x00\x21\x00\x5c\x01\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
 
 happyDefActions :: HappyAddr
-happyDefActions = HappyA# "\xf7\xff\x00\x00\x00\x00\xfd\xff\xcd\xff\xcc\xff\xcb\xff\xca\xff\xcf\xff\x00\x00\xc0\xff\xd6\xff\xd4\xff\xd2\xff\xdd\xff\x00\x00\x00\x00\xce\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\xfb\xff\xfa\xff\xf9\xff\x00\x00\x00\x00\xf8\xff\xf6\xff\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\xc7\xff\xc3\xff\xdb\xff\x00\x00\xe1\xff\x00\x00\xe0\xff\xe1\xff\x00\x00\x00\x00\x00\x00\xd5\xff\x00\x00\xd3\xff\xc9\xff\x00\x00\x00\x00\x00\x00\x00\x00\xda\xff\x00\x00\x00\x00\xc2\xff\x00\x00\x00\x00\xc6\xff\x00\x00\xf2\xff\xf3\xff\xf5\xff\x00\x00\x00\x00\xd1\xff\xc7\xff\x00\x00\xd0\xff\xc3\xff\x00\x00\x00\x00\xdb\xff\x00\x00\xbe\xff\xd8\xff\x00\x00\x00\x00\xe7\xff\xe6\xff\x00\x00\xea\xff\xbd\xff\x00\x00\x00\x00\xe8\xff\x00\x00\x00\x00\xd9\xff\x00\x00\xc4\xff\xc1\xff\xc8\xff\xc5\xff\x00\x00\xf0\xff\xdf\xff\x00\x00\xe4\xff\xed\xff\xde\xff\xbe\xff\x00\x00\x00\x00\xd7\xff\xbf\xff\xbc\xff\x00\x00\x00\x00\xe3\xff\x00\x00\xdc\xff\x00\x00\xef\xff\x00\x00\xf4\xff\xf0\xff\x00\x00\xe9\xff\xe4\xff\x00\x00\xec\xff\xeb\xff\xe5\xff\xe2\xff\xf1\xff\xee\xff"#
+happyDefActions = HappyA# "\xf7\xff\x00\x00\x00\x00\xfd\xff\xc9\xff\xc8\xff\xc7\xff\xc6\xff\xcb\xff\x00\x00\xbc\xff\xd2\xff\xd0\xff\xce\xff\xdd\xff\x00\x00\x00\x00\xca\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\xfb\xff\xfa\xff\xf9\xff\x00\x00\x00\x00\xf8\xff\xf6\xff\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\xc3\xff\xbf\xff\xdb\xff\x00\x00\xe1\xff\x00\x00\xe0\xff\xe1\xff\x00\x00\x00\x00\x00\x00\xd1\xff\x00\x00\xcf\xff\xc5\xff\x00\x00\x00\x00\x00\x00\x00\x00\xda\xff\x00\x00\x00\x00\xbe\xff\x00\x00\x00\x00\xc2\xff\x00\x00\xf2\xff\xf3\xff\xf5\xff\x00\x00\x00\x00\xcd\xff\xc3\xff\x00\x00\xcc\xff\xbf\xff\x00\x00\x00\x00\xdb\xff\x00\x00\xd7\xff\xd4\xff\x00\x00\x00\x00\xe7\xff\xe6\xff\x00\x00\xea\xff\xd6\xff\x00\x00\x00\x00\xe8\xff\x00\x00\x00\x00\xd9\xff\x00\x00\xc0\xff\xbd\xff\xc4\xff\xc1\xff\x00\x00\xf0\xff\xdf\xff\x00\x00\xe4\xff\xed\xff\xde\xff\xd7\xff\x00\x00\x00\x00\xd3\xff\x00\x00\xd5\xff\x00\x00\x00\x00\xe3\xff\x00\x00\xdc\xff\x00\x00\xef\xff\x00\x00\xf4\xff\xf0\xff\x00\x00\xe9\xff\xe4\xff\x00\x00\xec\xff\xeb\xff\x00\x00\xd8\xff\xe5\xff\xe2\xff\xf1\xff\xee\xff"#
 
 happyCheck :: HappyAddr
-happyCheck = HappyA# "\xff\xff\x00\x00\x01\x00\x00\x00\x01\x00\x04\x00\x04\x00\x04\x00\x04\x00\x05\x00\x06\x00\x07\x00\x0b\x00\x04\x00\x0b\x00\x0e\x00\x04\x00\x0e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x08\x00\x04\x00\x04\x00\x18\x00\x19\x00\x1b\x00\x1c\x00\x1b\x00\x1c\x00\x0e\x00\x0f\x00\x16\x00\x17\x00\x12\x00\x13\x00\x14\x00\x15\x00\x19\x00\x04\x00\x16\x00\x17\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0a\x00\x06\x00\x07\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x18\x00\x19\x00\x12\x00\x13\x00\x14\x00\x15\x00\x0e\x00\x19\x00\x0f\x00\x04\x00\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x04\x00\x19\x00\x01\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x02\x00\x0e\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x04\x00\x01\x00\x12\x00\x13\x00\x14\x00\x15\x00\x0c\x00\x0d\x00\x0f\x00\x04\x00\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\x04\x00\x19\x00\x0c\x00\x0d\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\x05\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x02\x00\x0f\x00\x05\x00\x05\x00\x12\x00\x13\x00\x14\x00\x15\x00\x03\x00\x19\x00\x0f\x00\x04\x00\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\x01\x00\x0a\x00\x0a\x00\x07\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x19\x00\x19\x00\x0f\x00\x14\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x01\x00\x04\x00\x12\x00\x13\x00\x14\x00\x15\x00\x02\x00\x01\x00\x0f\x00\x04\x00\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\x05\x00\x01\x00\x03\x00\x02\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x19\x00\x07\x00\x02\x00\x0b\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x0a\x00\x0f\x00\x19\x00\x02\x00\x12\x00\x13\x00\x14\x00\x15\x00\x01\x00\x11\x00\x0f\x00\x1b\x00\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\x03\x00\x19\x00\x03\x00\x03\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1b\x00\xff\xff\x0b\x00\x15\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x0f\x00\xff\xff\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x0f\x00\xff\xff\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\x12\x00\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\x0f\x00\xff\xff\x1a\x00\x12\x00\x13\x00\x14\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\xff\xff\xff\xff\xff\xff\x08\x00\x09\x00\xff\xff\x06\x00\xff\xff\x08\x00\x09\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x14\x00\x15\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x06\x00\xff\xff\xff\xff\x09\x00\x04\x00\xff\xff\x0c\x00\x0d\x00\x08\x00\x09\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\x0b\x00\x0c\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\x12\x00\x13\x00\x0c\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x12\x00\x13\x00\xff\xff\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x06\x00\x07\x00\x08\x00\xff\xff\xff\xff\x06\x00\x0c\x00\x08\x00\xff\xff\xff\xff\xff\xff\x0c\x00\x12\x00\xff\xff\xff\xff\x15\x00\x16\x00\x12\x00\xff\xff\x19\x00\x15\x00\x16\x00\x00\x00\x01\x00\x19\x00\xff\xff\x04\x00\x00\x00\x01\x00\xff\xff\xff\xff\x04\x00\xff\xff\x0b\x00\xff\xff\xff\xff\x0e\x00\xff\xff\x0b\x00\xff\xff\xff\xff\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+happyCheck = HappyA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x04\x00\x04\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x0e\x00\x0f\x00\x08\x00\x0e\x00\x10\x00\x11\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x18\x00\x19\x00\x04\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x04\x00\x1a\x00\x0f\x00\x04\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0c\x00\x0d\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x02\x00\x1a\x00\x1b\x00\x05\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x18\x00\x19\x00\x04\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x04\x00\x04\x00\x0c\x00\x0d\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x1a\x00\x1a\x00\x1b\x00\x04\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x01\x00\x10\x00\x11\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x04\x00\x02\x00\x06\x00\x07\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x01\x00\x05\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x1a\x00\x03\x00\x08\x00\x09\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x05\x00\x03\x00\x01\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x1a\x00\x04\x00\x0a\x00\x09\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x07\x00\x1a\x00\x10\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x1a\x00\x15\x00\x08\x00\x09\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x01\x00\x04\x00\x02\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x01\x00\x05\x00\x04\x00\x01\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x02\x00\x1a\x00\x03\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x07\x00\x0f\x00\x02\x00\x12\x00\x0a\x00\x02\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x01\x00\x1c\x00\x1a\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x03\x00\x03\x00\x03\x00\x1a\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1c\x00\x16\x00\x0c\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\xff\xff\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\x08\x00\x0b\x00\xff\xff\x0b\x00\x0e\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x11\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\xff\xff\x0d\x00\x0e\x00\xff\xff\xff\xff\x11\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\x14\x00\x0d\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x06\x00\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x06\x00\xff\xff\x08\x00\xff\xff\xff\xff\x13\x00\xff\xff\x0d\x00\x16\x00\x17\x00\x00\x00\x01\x00\x1a\x00\x13\x00\x04\x00\xff\xff\x16\x00\x17\x00\xff\xff\xff\xff\x1a\x00\x0b\x00\x00\x00\x01\x00\x0e\x00\xff\xff\x04\x00\xff\xff\x12\x00\x13\x00\xff\xff\x00\x00\x01\x00\x0b\x00\xff\xff\x04\x00\x0e\x00\xff\xff\xff\xff\xff\xff\x12\x00\x13\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
 
 happyTable :: HappyAddr
-happyTable = HappyA# "\x00\x00\x50\x00\x51\x00\x50\x00\x51\x00\x27\x00\x38\x00\x27\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x52\x00\x65\x00\x52\x00\x53\x00\x3b\x00\x53\x00\x04\x00\x05\x00\x06\x00\x07\x00\x2a\x00\x2a\x00\x3b\x00\x30\x00\x39\x00\x5d\x00\x54\x00\x6c\x00\x54\x00\x55\x00\x2b\x00\x2c\x00\x3c\x00\x5f\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1a\x00\x38\x00\x3c\x00\x3d\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x6d\x00\x40\x00\x1d\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1f\x00\x7f\x00\x39\x00\x3a\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1f\x00\x1a\x00\x6a\x00\x76\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x35\x00\x27\x00\x1a\x00\x77\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x78\x00\x28\x00\x36\x00\x5a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x6e\x00\x6b\x00\x79\x00\x7a\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x6f\x00\x7e\x00\x71\x00\x6e\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x35\x00\x1a\x00\x6f\x00\x70\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x62\x00\x7b\x00\x36\x00\x37\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x22\x00\x62\x00\x64\x00\x23\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x65\x00\x1a\x00\x59\x00\x67\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x68\x00\x69\x00\x6a\x00\x50\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x1a\x00\x5c\x00\x61\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x44\x00\x5c\x00\x45\x00\x47\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x46\x00\x48\x00\x5e\x00\x4a\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x49\x00\x4b\x00\x4d\x00\x4c\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x32\x00\x33\x00\x2e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x34\x00\x42\x00\x1a\x00\x42\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x21\x00\x35\x00\x4d\x00\xff\xff\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x24\x00\x1a\x00\x25\x00\x26\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x00\x00\x2e\x00\x04\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x3f\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x26\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x09\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x72\x00\x00\x00\x00\x00\x00\x00\x73\x00\x80\x00\x00\x00\x10\x00\x00\x00\x2a\x00\x11\x00\x00\x00\x00\x00\x12\x00\x13\x00\x2e\x00\x0d\x00\x14\x00\x00\x00\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x10\x00\x00\x00\x00\x00\x11\x00\x72\x00\x00\x00\x12\x00\x13\x00\x73\x00\x74\x00\x14\x00\x00\x00\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\xcf\xff\xcf\xff\x00\x00\x00\x00\x00\x00\xcf\xff\xcf\xff\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\xcf\xff\xcf\xff\x12\x00\xcf\xff\xcf\xff\xcf\xff\xcf\xff\xcf\xff\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x57\x00\x7d\x00\x2a\x00\x00\x00\x00\x00\x57\x00\x58\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x58\x00\x59\x00\x00\x00\x00\x00\x04\x00\x17\x00\x59\x00\x00\x00\x1a\x00\x04\x00\x17\x00\x50\x00\x51\x00\x1a\x00\x00\x00\x27\x00\x50\x00\x51\x00\x00\x00\x00\x00\x27\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x53\x00\x00\x00\x7b\x00\x00\x00\x00\x00\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+happyTable = HappyA# "\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x2a\x00\x3b\x00\x35\x00\x27\x00\x6d\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x2b\x00\x2c\x00\x2a\x00\x28\x00\x36\x00\x5a\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7e\x00\x3c\x00\x5f\x00\x65\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x38\x00\x1a\x00\x1f\x00\x6e\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x3b\x00\x6f\x00\x80\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x30\x00\x81\x00\x22\x00\x39\x00\x5d\x00\x23\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x6a\x00\x3c\x00\x3d\x00\x6e\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x38\x00\x1f\x00\x6f\x00\x70\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x35\x00\x6b\x00\x1a\x00\x39\x00\x3a\x00\x76\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x71\x00\x77\x00\x36\x00\x37\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1a\x00\x78\x00\x40\x00\x1d\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x79\x00\x7a\x00\x7b\x00\x7e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x72\x00\x62\x00\x1a\x00\x62\x00\x73\x00\x82\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x59\x00\x64\x00\x65\x00\x68\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1a\x00\x67\x00\x6a\x00\x69\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x50\x00\x1a\x00\x5c\x00\x44\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x72\x00\x5c\x00\x1a\x00\x61\x00\x73\x00\x74\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x5e\x00\x45\x00\x47\x00\x46\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x4c\x00\x1a\x00\x4d\x00\x2e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x32\x00\x42\x00\x33\x00\x35\x00\x34\x00\x42\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x4d\x00\x21\x00\xff\xff\x1a\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x24\x00\x25\x00\x26\x00\x1a\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x04\x00\x2e\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x50\x00\x51\x00\x00\x00\x00\x00\x27\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x2a\x00\x7f\x00\x00\x00\x11\x00\x53\x00\x12\x00\x13\x00\x2e\x00\x0d\x00\x14\x00\x00\x00\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x12\x00\x13\x00\x00\x00\x00\x00\x14\x00\x00\x00\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\xcb\xff\xcb\xff\x00\x00\x00\x00\x00\x00\x00\x00\xcb\xff\xcb\xff\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\xff\xcb\xff\x12\x00\xcb\xff\xcb\xff\xcb\xff\xcb\xff\xcb\xff\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x57\x00\x7d\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x57\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x59\x00\x00\x00\x58\x00\x04\x00\x17\x00\x50\x00\x51\x00\x1a\x00\x59\x00\x27\x00\x00\x00\x04\x00\x17\x00\x00\x00\x00\x00\x1a\x00\x52\x00\x50\x00\x51\x00\x53\x00\x00\x00\x27\x00\x00\x00\x54\x00\x6c\x00\x00\x00\x50\x00\x51\x00\x52\x00\x00\x00\x27\x00\x53\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x7b\x00\x00\x00\x00\x00\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
 
 happyReduceArr = array (2, 67) [
 	(2 , happyReduce_2),
@@ -278,7 +278,7 @@ happyReduceArr = array (2, 67) [
 	(67 , happyReduce_67)
 	]
 
-happy_n_terms = 28 :: Int
+happy_n_terms = 29 :: Int
 happy_n_nonterms = 29 :: Int
 
 happyReduce_2 = happySpecReduce_1 0# happyReduction_2
@@ -546,14 +546,14 @@ happyReduction_33 (happy_x_6 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOut20 happy_x_2 of { happy_var_2 -> 
-	case happyOut33 happy_x_5 of { happy_var_5 -> 
+	case happyOut24 happy_x_5 of { happy_var_5 -> 
 	happyIn20
 		 (ECase happy_var_2 happy_var_5
 	) `HappyStk` happyRest}}
 
 happyReduce_34 = happySpecReduce_1 15# happyReduction_34
 happyReduction_34 happy_x_1
-	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
 	happyIn20
 		 (happy_var_1
 	)}
@@ -594,20 +594,56 @@ happyReduction_38 happy_x_3
 		 ((:) happy_var_1 happy_var_3
 	)}}
 
-happyReduce_39 = happyReduce 4# 18# happyReduction_39
+happyReduce_39 = happyReduce 5# 18# happyReduction_39
-happyReduction_39 (happy_x_4 `HappyStk`
+happyReduction_39 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut16 happy_x_1 of { happy_var_1 -> 
+	case happyOut20 happy_x_3 of { happy_var_3 -> 
+	case happyOut20 happy_x_5 of { happy_var_5 -> 
+	happyIn23
+		 (Case happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_40 = happySpecReduce_0 19# happyReduction_40
+happyReduction_40  =  happyIn24
+		 ([]
+	)
+
+happyReduce_41 = happySpecReduce_1 19# happyReduction_41
+happyReduction_41 happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn24
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_42 = happySpecReduce_3 19# happyReduction_42
+happyReduction_42 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	case happyOut24 happy_x_3 of { happy_var_3 -> 
+	happyIn24
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_43 = happyReduce 4# 20# happyReduction_43
+happyReduction_43 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOut19 happy_x_2 of { happy_var_2 -> 
 	case happyOut20 happy_x_4 of { happy_var_4 -> 
-	happyIn23
+	happyIn25
 		 (EAbs happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}
 
-happyReduce_40 = happyReduce 7# 18# happyReduction_40
+happyReduce_44 = happyReduce 7# 20# happyReduction_44
-happyReduction_40 (happy_x_7 `HappyStk`
+happyReduction_44 (happy_x_7 `HappyStk`
 	happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
@@ -618,43 +654,10 @@ happyReduction_40 (happy_x_7 `HappyStk`
 	 = case happyOut19 happy_x_2 of { happy_var_2 -> 
 	case happyOut20 happy_x_4 of { happy_var_4 -> 
 	case happyOut20 happy_x_7 of { happy_var_7 -> 
-	happyIn23
+	happyIn25
 		 (EPi happy_var_2 happy_var_4 happy_var_7
 	) `HappyStk` happyRest}}}
 
-happyReduce_41 = happySpecReduce_1 18# happyReduction_41
-happyReduction_41 happy_x_1
-	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
-	happyIn23
-		 (happy_var_1
-	)}
-
-happyReduce_42 = happySpecReduce_2 19# happyReduction_42
-happyReduction_42 happy_x_2
-	happy_x_1
-	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
-	case happyOut25 happy_x_2 of { happy_var_2 -> 
-	happyIn24
-		 (EApp happy_var_1 happy_var_2
-	)}}
-
-happyReduce_43 = happySpecReduce_1 19# happyReduction_43
-happyReduction_43 happy_x_1
-	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
-	happyIn24
-		 (happy_var_1
-	)}
-
-happyReduce_44 = happySpecReduce_3 20# happyReduction_44
-happyReduction_44 happy_x_3
-	happy_x_2
-	happy_x_1
-	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
-	case happyOut9 happy_x_3 of { happy_var_3 -> 
-	happyIn25
-		 (EProj happy_var_1 happy_var_3
-	)}}
-
 happyReduce_45 = happySpecReduce_1 20# happyReduction_45
 happyReduction_45 happy_x_1
 	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
@@ -662,109 +665,110 @@ happyReduction_45 happy_x_1
 		 (happy_var_1
 	)}
 
-happyReduce_46 = happyReduce 4# 21# happyReduction_46
+happyReduce_46 = happySpecReduce_2 21# happyReduction_46
-happyReduction_46 (happy_x_4 `HappyStk`
+happyReduction_46 happy_x_2
-	happy_x_3 `HappyStk`
+	happy_x_1
-	happy_x_2 `HappyStk`
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
-	happy_x_1 `HappyStk`
+	case happyOut27 happy_x_2 of { happy_var_2 -> 
-	happyRest)
-	 = case happyOut28 happy_x_3 of { happy_var_3 -> 
 	happyIn26
-		 (ERecType happy_var_3
+		 (EApp happy_var_1 happy_var_2
-	) `HappyStk` happyRest}
+	)}}
 
-happyReduce_47 = happyReduce 4# 21# happyReduction_47
+happyReduce_47 = happySpecReduce_1 21# happyReduction_47
-happyReduction_47 (happy_x_4 `HappyStk`
+happyReduction_47 happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (happy_var_1
+	)}
+
+happyReduce_48 = happySpecReduce_3 22# happyReduction_48
+happyReduction_48 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	case happyOut9 happy_x_3 of { happy_var_3 -> 
+	happyIn27
+		 (EProj happy_var_1 happy_var_3
+	)}}
+
+happyReduce_49 = happySpecReduce_1 22# happyReduction_49
+happyReduction_49 happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	happyIn27
+		 (happy_var_1
+	)}
+
+happyReduce_50 = happyReduce 4# 23# happyReduction_50
+happyReduction_50 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOut30 happy_x_3 of { happy_var_3 -> 
-	happyIn26
+	happyIn28
+		 (ERecType happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_51 = happyReduce 4# 23# happyReduction_51
+happyReduction_51 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut32 happy_x_3 of { happy_var_3 -> 
+	happyIn28
 		 (ERec happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_48 = happySpecReduce_1 21# happyReduction_48
+happyReduce_52 = happySpecReduce_1 23# happyReduction_52
-happyReduction_48 happy_x_1
+happyReduction_52 happy_x_1
 	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
-	happyIn26
+	happyIn28
 		 (EVar happy_var_1
 	)}
 
-happyReduce_49 = happySpecReduce_1 21# happyReduction_49
+happyReduce_53 = happySpecReduce_1 23# happyReduction_53
-happyReduction_49 happy_x_1
+happyReduction_53 happy_x_1
-	 =  happyIn26
+	 =  happyIn28
 		 (EType
 	)
 
-happyReduce_50 = happySpecReduce_1 21# happyReduction_50
+happyReduce_54 = happySpecReduce_1 23# happyReduction_54
-happyReduction_50 happy_x_1
+happyReduction_54 happy_x_1
 	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
-	happyIn26
+	happyIn28
 		 (EStr happy_var_1
 	)}
 
-happyReduce_51 = happySpecReduce_1 21# happyReduction_51
+happyReduce_55 = happySpecReduce_1 23# happyReduction_55
-happyReduction_51 happy_x_1
+happyReduction_55 happy_x_1
 	 =  case happyOut6 happy_x_1 of { happy_var_1 -> 
-	happyIn26
+	happyIn28
 		 (EInteger happy_var_1
 	)}
 
-happyReduce_52 = happySpecReduce_1 21# happyReduction_52
+happyReduce_56 = happySpecReduce_1 23# happyReduction_56
-happyReduction_52 happy_x_1
+happyReduction_56 happy_x_1
 	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
-	happyIn26
+	happyIn28
 		 (EDouble happy_var_1
 	)}
 
-happyReduce_53 = happySpecReduce_1 21# happyReduction_53
-happyReduction_53 happy_x_1
-	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
-	happyIn26
-		 (EMeta happy_var_1
-	)}
-
-happyReduce_54 = happySpecReduce_3 21# happyReduction_54
-happyReduction_54 happy_x_3
-	happy_x_2
-	happy_x_1
-	 =  case happyOut20 happy_x_2 of { happy_var_2 -> 
-	happyIn26
-		 (happy_var_2
-	)}
-
-happyReduce_55 = happySpecReduce_3 22# happyReduction_55
-happyReduction_55 happy_x_3
-	happy_x_2
-	happy_x_1
-	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
-	case happyOut20 happy_x_3 of { happy_var_3 -> 
-	happyIn27
-		 (FieldType happy_var_1 happy_var_3
-	)}}
-
-happyReduce_56 = happySpecReduce_0 23# happyReduction_56
-happyReduction_56  =  happyIn28
-		 ([]
-	)
-
 happyReduce_57 = happySpecReduce_1 23# happyReduction_57
 happyReduction_57 happy_x_1
-	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
 	happyIn28
-		 ((:[]) happy_var_1
+		 (EMeta happy_var_1
 	)}
 
 happyReduce_58 = happySpecReduce_3 23# happyReduction_58
 happyReduction_58 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut20 happy_x_2 of { happy_var_2 -> 
-	case happyOut28 happy_x_3 of { happy_var_3 -> 
 	happyIn28
-		 ((:) happy_var_1 happy_var_3
+		 (happy_var_2
-	)}}
+	)}
 
 happyReduce_59 = happySpecReduce_3 24# happyReduction_59
 happyReduction_59 happy_x_3
@@ -773,7 +777,7 @@ happyReduction_59 happy_x_3
 	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
 	case happyOut20 happy_x_3 of { happy_var_3 -> 
 	happyIn29
-		 (FieldValue happy_var_1 happy_var_3
+		 (FieldType happy_var_1 happy_var_3
 	)}}
 
 happyReduce_60 = happySpecReduce_0 25# happyReduction_60
@@ -798,47 +802,47 @@ happyReduction_62 happy_x_3
 		 ((:) happy_var_1 happy_var_3
 	)}}
 
-happyReduce_63 = happySpecReduce_1 26# happyReduction_63
+happyReduce_63 = happySpecReduce_3 26# happyReduction_63
-happyReduction_63 happy_x_1
+happyReduction_63 happy_x_3
-	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
-	happyIn31
-		 (happy_var_1
-	)}
-
-happyReduce_64 = happySpecReduce_3 27# happyReduction_64
-happyReduction_64 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut16 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
 	case happyOut20 happy_x_3 of { happy_var_3 -> 
-	happyIn32
+	happyIn31
-		 (Case happy_var_1 happy_var_3
+		 (FieldValue happy_var_1 happy_var_3
 	)}}
 
-happyReduce_65 = happySpecReduce_0 28# happyReduction_65
+happyReduce_64 = happySpecReduce_0 27# happyReduction_64
-happyReduction_65  =  happyIn33
+happyReduction_64  =  happyIn32
 		 ([]
 	)
 
-happyReduce_66 = happySpecReduce_1 28# happyReduction_66
+happyReduce_65 = happySpecReduce_1 27# happyReduction_65
-happyReduction_66 happy_x_1
+happyReduction_65 happy_x_1
-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
-	happyIn33
+	happyIn32
 		 ((:[]) happy_var_1
 	)}
 
-happyReduce_67 = happySpecReduce_3 28# happyReduction_67
+happyReduce_66 = happySpecReduce_3 27# happyReduction_66
-happyReduction_67 happy_x_3
+happyReduction_66 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
-	case happyOut33 happy_x_3 of { happy_var_3 -> 
+	case happyOut32 happy_x_3 of { happy_var_3 -> 
-	happyIn33
+	happyIn32
 		 ((:) happy_var_1 happy_var_3
 	)}}
 
+happyReduce_67 = happySpecReduce_1 28# happyReduction_67
+happyReduction_67 happy_x_1
+	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
+	happyIn33
+		 (happy_var_1
+	)}
+
 happyNewToken action sts stk [] =
-	happyDoAction 27# (error "reading EOF!") action sts stk []
+	happyDoAction 28# (error "reading EOF!") action sts stk []
 
 happyNewToken action sts stk (tk:tks) =
 	let cont i = happyDoAction i tk action sts stk tks in
@@ -851,24 +855,25 @@ happyNewToken action sts stk (tk:tks) =
 	PT _ (TS "(") -> cont 6#;
 	PT _ (TS ")") -> cont 7#;
 	PT _ (TS "_") -> cont 8#;
-	PT _ (TS "\\") -> cont 9#;
+	PT _ (TS "|") -> cont 9#;
 	PT _ (TS "->") -> cont 10#;
-	PT _ (TS ".") -> cont 11#;
+	PT _ (TS "\\") -> cont 11#;
-	PT _ (TS "Type") -> cont 12#;
+	PT _ (TS ".") -> cont 12#;
-	PT _ (TS "case") -> cont 13#;
+	PT _ (TS "Type") -> cont 13#;
-	PT _ (TS "data") -> cont 14#;
+	PT _ (TS "case") -> cont 14#;
-	PT _ (TS "in") -> cont 15#;
+	PT _ (TS "data") -> cont 15#;
-	PT _ (TS "let") -> cont 16#;
+	PT _ (TS "in") -> cont 16#;
-	PT _ (TS "of") -> cont 17#;
+	PT _ (TS "let") -> cont 17#;
-	PT _ (TS "rec") -> cont 18#;
+	PT _ (TS "of") -> cont 18#;
-	PT _ (TS "sig") -> cont 19#;
+	PT _ (TS "rec") -> cont 19#;
-	PT _ (TS "where") -> cont 20#;
+	PT _ (TS "sig") -> cont 20#;
-	PT _ (TL happy_dollar_dollar) -> cont 21#;
+	PT _ (TS "where") -> cont 21#;
-	PT _ (TI happy_dollar_dollar) -> cont 22#;
+	PT _ (TL happy_dollar_dollar) -> cont 22#;
-	PT _ (TD happy_dollar_dollar) -> cont 23#;
+	PT _ (TI happy_dollar_dollar) -> cont 23#;
-	PT _ (T_TMeta happy_dollar_dollar) -> cont 24#;
+	PT _ (TD happy_dollar_dollar) -> cont 24#;
-	PT _ (T_CIdent happy_dollar_dollar) -> cont 25#;
+	PT _ (T_TMeta happy_dollar_dollar) -> cont 25#;
-	_ -> cont 26#;
+	PT _ (T_CIdent happy_dollar_dollar) -> cont 26#;
+	_ -> cont 27#;
 	_ -> happyError' (tk:tks)
 	}
 

src/Transfer/Core/Par.y

@@ -22,8 +22,9 @@ import Transfer.ErrM
  '(' { PT _ (TS "(") }
  ')' { PT _ (TS ")") }
  '_' { PT _ (TS "_") }
- '\\' { PT _ (TS "\\") }
+ '|' { PT _ (TS "|") }
  '->' { PT _ (TS "->") }
+ '\\' { PT _ (TS "\\") }
  '.' { PT _ (TS ".") }
  'Type' { PT _ (TS "Type") }
  'case' { PT _ (TS "case") }
@@ -122,6 +123,16 @@ ListLetDef : {- empty -} { [] }
   | LetDef ';' ListLetDef { (:) $1 $3 }
 
 
+Case :: { Case }
+Case : Pattern '|' Exp '->' Exp { Case $1 $3 $5 } 
+
+
+ListCase :: { [Case] }
+ListCase : {- empty -} { [] } 
+  | Case { (:[]) $1 }
+  | Case ';' ListCase { (:) $1 $3 }
+
+
 Exp2 :: { Exp }
 Exp2 : '\\' PatternVariable '->' Exp { EAbs $2 $4 } 
   | '(' PatternVariable ':' Exp ')' '->' Exp { EPi $2 $4 $7 }
@@ -174,16 +185,6 @@ Exp1 :: { Exp }
 Exp1 : Exp2 { $1 } 
 
 
-Case :: { Case }
-Case : Pattern '->' Exp { Case $1 $3 } 
-
-
-ListCase :: { [Case] }
-ListCase : {- empty -} { [] } 
-  | Case { (:[]) $1 }
-  | Case ';' ListCase { (:) $1 $3 }
-
-
 
 {
 

src/Transfer/Core/Print.hs

@@ -109,9 +109,9 @@ instance Print (Tree c) where
     EDouble d -> prPrec _i 5 (concatD [prt 0 d])
     EMeta tmeta -> prPrec _i 5 (concatD [prt 0 tmeta])
     LetDef cident exp0 exp1 -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp1])
+    Case pattern exp0 exp1 -> prPrec _i 0 (concatD [prt 0 pattern , doc (showString "|") , prt 0 exp0 , doc (showString "->") , prt 0 exp1])
     FieldType cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp])
     FieldValue cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString "=") , prt 0 exp])
-    Case pattern exp -> prPrec _i 0 (concatD [prt 0 pattern , doc (showString "->") , prt 0 exp])
     TMeta str -> prPrec _i 0 (doc (showString str))
     CIdent str -> prPrec _i 0 (doc (showString str))
 
@@ -139,6 +139,11 @@ instance Print [LetDef] where
    [] -> (concatD [])
    [x] -> (concatD [prt 0 x])
    x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+instance Print [Case] where
+  prt _ es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
 instance Print [FieldType] where
   prt _ es = case es of
    [] -> (concatD [])
@@ -149,8 +154,3 @@ instance Print [FieldValue] where
    [] -> (concatD [])
    [x] -> (concatD [prt 0 x])
    x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
-instance Print [Case] where
-  prt _ es = case es of
-   [] -> (concatD [])
-   [x] -> (concatD [prt 0 x])
-   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])

src/Transfer/Core/Skel.hs

@@ -40,9 +40,9 @@ transTree t = case t of
   EDouble d -> failure t
   EMeta tmeta -> failure t
   LetDef cident exp0 exp1 -> failure t
+  Case pattern exp0 exp1 -> failure t
   FieldType cident exp -> failure t
   FieldValue cident exp -> failure t
-  Case pattern exp -> failure t
   TMeta str -> failure t
   CIdent str -> failure t
 
@@ -99,6 +99,10 @@ transLetDef :: LetDef -> Result
 transLetDef t = case t of
   LetDef cident exp0 exp1 -> failure t
 
+transCase :: Case -> Result
+transCase t = case t of
+  Case pattern exp0 exp1 -> failure t
+
 transFieldType :: FieldType -> Result
 transFieldType t = case t of
   FieldType cident exp -> failure t
@@ -107,10 +111,6 @@ transFieldValue :: FieldValue -> Result
 transFieldValue t = case t of
   FieldValue cident exp -> failure t
 
-transCase :: Case -> Result
-transCase t = case t of
-  Case pattern exp -> failure t
-
 transTMeta :: TMeta -> Result
 transTMeta t = case t of
   TMeta str -> failure t

src/Transfer/Interpreter.hs

@@ -137,9 +137,9 @@ eval env x = case x of
        in eval (seqEnv env') exp2
   ECase exp cases -> 
       let v = eval env exp
-          r = case firstMatch v cases of
+          r = case firstMatch env v cases of
                   Nothing -> error $ "No pattern matched " ++ printValue v
-                  Just (e,bs) -> eval (bs `addToEnv` env) e
+                  Just (e,env') -> eval env' e
        in v `seq` r
   EAbs _ _ -> VClos env x
   EPi _ _ _  -> VClos env x
@@ -169,11 +169,17 @@ eval env x = case x of
   EDouble n  -> VDbl n
   EMeta (TMeta t) -> VMeta (read $ drop 1 t)
 
-firstMatch :: Value -> [Case] -> Maybe (Exp,[(CIdent,Value)])
+firstMatch :: Env -> Value -> [Case] -> Maybe (Exp,Env)
-firstMatch _ [] = Nothing
+firstMatch _ _ [] = Nothing
-firstMatch v (Case p e:cs) = case match p v of
+firstMatch env v (Case p g e:cs) = 
-                                            Nothing -> firstMatch v cs
+    case match p v of
-                                            Just env -> Just (e,env)
+        Nothing -> firstMatch env v cs
+        Just bs -> let env' = bs `addToEnv` env
+                    in case eval env' g of
+                           VCons (CIdent "True")  [] -> Just (e,env')
+                           VCons (CIdent "False") [] -> firstMatch env v cs
+                           x -> error $ "Error in guard: " ++ printValue x 
+                                        ++ " is not a Bool"
 
 bind :: PatternVariable -> Value -> [(CIdent,Value)]
 bind (PVVar x) v = [(x,v)]

src/Transfer/Syntax/Abs.hs

@@ -14,6 +14,8 @@ data Decl_
 type Decl = Tree Decl_
 data ConsDecl_
 type ConsDecl = Tree ConsDecl_
+data Guard_
+type Guard = Tree Guard_
 data Pattern_
 type Pattern = Tree Pattern_
 data PListElem_
@@ -22,14 +24,14 @@ data FieldPattern_
 type FieldPattern = Tree FieldPattern_
 data Exp_
 type Exp = Tree Exp_
+data VarOrWild_
+type VarOrWild = Tree VarOrWild_
 data LetDef_
 type LetDef = Tree LetDef_
 data Case_
 type Case = Tree Case_
 data Bind_
 type Bind = Tree Bind_
-data VarOrWild_
-type VarOrWild = Tree VarOrWild_
 data FieldType_
 type FieldType = Tree FieldType_
 data FieldValue_
@@ -42,9 +44,11 @@ data Tree :: * -> * where
     Import :: Ident -> Tree Import_
     DataDecl :: Ident -> Exp -> [ConsDecl] -> Tree Decl_
     TypeDecl :: Ident -> Exp -> Tree Decl_
-    ValueDecl :: Ident -> [Pattern] -> Exp -> Tree Decl_
+    ValueDecl :: Ident -> [Pattern] -> Guard -> Exp -> Tree Decl_
     DeriveDecl :: Ident -> Ident -> Tree Decl_
     ConsDecl :: Ident -> Exp -> Tree ConsDecl_
+    GuardExp :: Exp -> Tree Guard_
+    GuardNo :: Tree Guard_
     POr :: Pattern -> Pattern -> Tree Pattern_
     PListCons :: Pattern -> Pattern -> Tree Pattern_
     PConsTop :: Ident -> Pattern -> [Pattern] -> Tree Pattern_
@@ -58,13 +62,13 @@ data Tree :: * -> * where
     PWild :: Tree Pattern_
     PListElem :: Pattern -> Tree PListElem_
     FieldPattern :: Ident -> Pattern -> Tree FieldPattern_
+    EPi :: VarOrWild -> Exp -> Exp -> Tree Exp_
+    EPiNoVar :: Exp -> Exp -> Tree Exp_
+    EAbs :: VarOrWild -> Exp -> Tree Exp_
     ELet :: [LetDef] -> Exp -> Tree Exp_
     ECase :: Exp -> [Case] -> Tree Exp_
     EIf :: Exp -> Exp -> Exp -> Tree Exp_
     EDo :: [Bind] -> Exp -> Tree Exp_
-    EAbs :: VarOrWild -> Exp -> Tree Exp_
-    EPi :: VarOrWild -> Exp -> Exp -> Tree Exp_
-    EPiNoVar :: Exp -> Exp -> Tree Exp_
     EBind :: Exp -> Exp -> Tree Exp_
     EBindC :: Exp -> Exp -> Tree Exp_
     EOr :: Exp -> Exp -> Tree Exp_
@@ -93,12 +97,12 @@ data Tree :: * -> * where
     EInteger :: Integer -> Tree Exp_
     EDouble :: Double -> Tree Exp_
     EMeta :: Tree Exp_
-    LetDef :: Ident -> Exp -> Exp -> Tree LetDef_
-    Case :: Pattern -> Exp -> Tree Case_
-    BindVar :: VarOrWild -> Exp -> Tree Bind_
-    BindNoVar :: Exp -> Tree Bind_
     VVar :: Ident -> Tree VarOrWild_
     VWild :: Tree VarOrWild_
+    LetDef :: Ident -> Exp -> Exp -> Tree LetDef_
+    Case :: Pattern -> Guard -> Exp -> Tree Case_
+    BindVar :: VarOrWild -> Exp -> Tree Bind_
+    BindNoVar :: Exp -> Tree Bind_
     FieldType :: Ident -> Exp -> Tree FieldType_
     FieldValue :: Ident -> Exp -> Tree FieldValue_
     Ident :: String -> Tree Ident_
@@ -121,9 +125,10 @@ composOpM f t = case t of
     Import i -> return Import `ap` f i
     DataDecl i exp consdecls -> return DataDecl `ap` f i `ap` f exp `ap` mapM f consdecls
     TypeDecl i exp -> return TypeDecl `ap` f i `ap` f exp
-    ValueDecl i patterns exp -> return ValueDecl `ap` f i `ap` mapM f patterns `ap` f exp
+    ValueDecl i patterns guard exp -> return ValueDecl `ap` f i `ap` mapM f patterns `ap` f guard `ap` f exp
     DeriveDecl i0 i1 -> return DeriveDecl `ap` f i0 `ap` f i1
     ConsDecl i exp -> return ConsDecl `ap` f i `ap` f exp
+    GuardExp exp -> return GuardExp `ap` f exp
     POr pattern0 pattern1 -> return POr `ap` f pattern0 `ap` f pattern1
     PListCons pattern0 pattern1 -> return PListCons `ap` f pattern0 `ap` f pattern1
     PConsTop i pattern patterns -> return PConsTop `ap` f i `ap` f pattern `ap` mapM f patterns
@@ -133,13 +138,13 @@ composOpM f t = case t of
     PVar i -> return PVar `ap` f i
     PListElem pattern -> return PListElem `ap` f pattern
     FieldPattern i pattern -> return FieldPattern `ap` f i `ap` f pattern
+    EPi varorwild exp0 exp1 -> return EPi `ap` f varorwild `ap` f exp0 `ap` f exp1
+    EPiNoVar exp0 exp1 -> return EPiNoVar `ap` f exp0 `ap` f exp1
+    EAbs varorwild exp -> return EAbs `ap` f varorwild `ap` f exp
     ELet letdefs exp -> return ELet `ap` mapM f letdefs `ap` f exp
     ECase exp cases -> return ECase `ap` f exp `ap` mapM f cases
     EIf exp0 exp1 exp2 -> return EIf `ap` f exp0 `ap` f exp1 `ap` f exp2
     EDo binds exp -> return EDo `ap` mapM f binds `ap` f exp
-    EAbs varorwild exp -> return EAbs `ap` f varorwild `ap` f exp
-    EPi varorwild exp0 exp1 -> return EPi `ap` f varorwild `ap` f exp0 `ap` f exp1
-    EPiNoVar exp0 exp1 -> return EPiNoVar `ap` f exp0 `ap` f exp1
     EBind exp0 exp1 -> return EBind `ap` f exp0 `ap` f exp1
     EBindC exp0 exp1 -> return EBindC `ap` f exp0 `ap` f exp1
     EOr exp0 exp1 -> return EOr `ap` f exp0 `ap` f exp1
@@ -163,11 +168,11 @@ composOpM f t = case t of
     ERec fieldvalues -> return ERec `ap` mapM f fieldvalues
     EList exps -> return EList `ap` mapM f exps
     EVar i -> return EVar `ap` f i
+    VVar i -> return VVar `ap` f i
     LetDef i exp0 exp1 -> return LetDef `ap` f i `ap` f exp0 `ap` f exp1
-    Case pattern exp -> return Case `ap` f pattern `ap` f exp
+    Case pattern guard exp -> return Case `ap` f pattern `ap` f guard `ap` f exp
     BindVar varorwild exp -> return BindVar `ap` f varorwild `ap` f exp
     BindNoVar exp -> return BindNoVar `ap` f exp
-    VVar i -> return VVar `ap` f i
     FieldType i exp -> return FieldType `ap` f i `ap` f exp
     FieldValue i exp -> return FieldValue `ap` f i `ap` f exp
     _ -> return t
@@ -178,9 +183,10 @@ composOpFold zero combine f t = case t of
     Import i -> f i
     DataDecl i exp consdecls -> f i `combine` f exp `combine` foldr combine zero (map f consdecls)
     TypeDecl i exp -> f i `combine` f exp
-    ValueDecl i patterns exp -> f i `combine` foldr combine zero (map f patterns) `combine` f exp
+    ValueDecl i patterns guard exp -> f i `combine` foldr combine zero (map f patterns) `combine` f guard `combine` f exp
     DeriveDecl i0 i1 -> f i0 `combine` f i1
     ConsDecl i exp -> f i `combine` f exp
+    GuardExp exp -> f exp
     POr pattern0 pattern1 -> f pattern0 `combine` f pattern1
     PListCons pattern0 pattern1 -> f pattern0 `combine` f pattern1
     PConsTop i pattern patterns -> f i `combine` f pattern `combine` foldr combine zero (map f patterns)
@@ -190,13 +196,13 @@ composOpFold zero combine f t = case t of
     PVar i -> f i
     PListElem pattern -> f pattern
     FieldPattern i pattern -> f i `combine` f pattern
+    EPi varorwild exp0 exp1 -> f varorwild `combine` f exp0 `combine` f exp1
+    EPiNoVar exp0 exp1 -> f exp0 `combine` f exp1
+    EAbs varorwild exp -> f varorwild `combine` f exp
     ELet letdefs exp -> foldr combine zero (map f letdefs) `combine` f exp
     ECase exp cases -> f exp `combine` foldr combine zero (map f cases)
     EIf exp0 exp1 exp2 -> f exp0 `combine` f exp1 `combine` f exp2
     EDo binds exp -> foldr combine zero (map f binds) `combine` f exp
-    EAbs varorwild exp -> f varorwild `combine` f exp
-    EPi varorwild exp0 exp1 -> f varorwild `combine` f exp0 `combine` f exp1
-    EPiNoVar exp0 exp1 -> f exp0 `combine` f exp1
     EBind exp0 exp1 -> f exp0 `combine` f exp1
     EBindC exp0 exp1 -> f exp0 `combine` f exp1
     EOr exp0 exp1 -> f exp0 `combine` f exp1
@@ -220,11 +226,11 @@ composOpFold zero combine f t = case t of
     ERec fieldvalues -> foldr combine zero (map f fieldvalues)
     EList exps -> foldr combine zero (map f exps)
     EVar i -> f i
+    VVar i -> f i
     LetDef i exp0 exp1 -> f i `combine` f exp0 `combine` f exp1
-    Case pattern exp -> f pattern `combine` f exp
+    Case pattern guard exp -> f pattern `combine` f guard `combine` f exp
     BindVar varorwild exp -> f varorwild `combine` f exp
     BindNoVar exp -> f exp
-    VVar i -> f i
     FieldType i exp -> f i `combine` f exp
     FieldValue i exp -> f i `combine` f exp
     _ -> zero
@@ -235,9 +241,11 @@ instance Show (Tree c) where
     Import i -> opar n . showString "Import" . showChar ' ' . showsPrec 1 i . cpar n
     DataDecl i exp consdecls -> opar n . showString "DataDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 consdecls . cpar n
     TypeDecl i exp -> opar n . showString "TypeDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
-    ValueDecl i patterns exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . showChar ' ' . showsPrec 1 exp . cpar n
+    ValueDecl i patterns guard exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . showChar ' ' . showsPrec 1 guard . showChar ' ' . showsPrec 1 exp . cpar n
     DeriveDecl i0 i1 -> opar n . showString "DeriveDecl" . showChar ' ' . showsPrec 1 i0 . showChar ' ' . showsPrec 1 i1 . cpar n
     ConsDecl i exp -> opar n . showString "ConsDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
+    GuardExp exp -> opar n . showString "GuardExp" . showChar ' ' . showsPrec 1 exp . cpar n
+    GuardNo -> showString "GuardNo"
     POr pattern0 pattern1 -> opar n . showString "POr" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n
     PListCons pattern0 pattern1 -> opar n . showString "PListCons" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n
     PConsTop i pattern patterns -> opar n . showString "PConsTop" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 patterns . cpar n
@@ -251,13 +259,13 @@ instance Show (Tree c) where
     PWild -> showString "PWild"
     PListElem pattern -> opar n . showString "PListElem" . showChar ' ' . showsPrec 1 pattern . cpar n
     FieldPattern i pattern -> opar n . showString "FieldPattern" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . cpar n
+    EPi varorwild exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
+    EPiNoVar exp0 exp1 -> opar n . showString "EPiNoVar" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
+    EAbs varorwild exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
     ELet letdefs exp -> opar n . showString "ELet" . showChar ' ' . showsPrec 1 letdefs . showChar ' ' . showsPrec 1 exp . cpar n
     ECase exp cases -> opar n . showString "ECase" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cases . cpar n
     EIf exp0 exp1 exp2 -> opar n . showString "EIf" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . showChar ' ' . showsPrec 1 exp2 . cpar n
     EDo binds exp -> opar n . showString "EDo" . showChar ' ' . showsPrec 1 binds . showChar ' ' . showsPrec 1 exp . cpar n
-    EAbs varorwild exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
-    EPi varorwild exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
-    EPiNoVar exp0 exp1 -> opar n . showString "EPiNoVar" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
     EBind exp0 exp1 -> opar n . showString "EBind" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
     EBindC exp0 exp1 -> opar n . showString "EBindC" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
     EOr exp0 exp1 -> opar n . showString "EOr" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
@@ -286,12 +294,12 @@ instance Show (Tree c) where
     EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n
     EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n
     EMeta -> showString "EMeta"
-    LetDef i exp0 exp1 -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
-    Case pattern exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp . cpar n
-    BindVar varorwild exp -> opar n . showString "BindVar" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
-    BindNoVar exp -> opar n . showString "BindNoVar" . showChar ' ' . showsPrec 1 exp . cpar n
     VVar i -> opar n . showString "VVar" . showChar ' ' . showsPrec 1 i . cpar n
     VWild -> showString "VWild"
+    LetDef i exp0 exp1 -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
+    Case pattern guard exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 guard . showChar ' ' . showsPrec 1 exp . cpar n
+    BindVar varorwild exp -> opar n . showString "BindVar" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n
+    BindNoVar exp -> opar n . showString "BindNoVar" . showChar ' ' . showsPrec 1 exp . cpar n
     FieldType i exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
     FieldValue i exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n
     Ident str -> opar n . showString "Ident" . showChar ' ' . showsPrec 1 str . cpar n
@@ -305,9 +313,11 @@ johnMajorEq (Module imports decls) (Module imports_ decls_) = imports == imports
 johnMajorEq (Import i) (Import i_) = i == i_
 johnMajorEq (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = i == i_ && exp == exp_ && consdecls == consdecls_
 johnMajorEq (TypeDecl i exp) (TypeDecl i_ exp_) = i == i_ && exp == exp_
-johnMajorEq (ValueDecl i patterns exp) (ValueDecl i_ patterns_ exp_) = i == i_ && patterns == patterns_ && exp == exp_
+johnMajorEq (ValueDecl i patterns guard exp) (ValueDecl i_ patterns_ guard_ exp_) = i == i_ && patterns == patterns_ && guard == guard_ && exp == exp_
 johnMajorEq (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = i0 == i0_ && i1 == i1_
 johnMajorEq (ConsDecl i exp) (ConsDecl i_ exp_) = i == i_ && exp == exp_
+johnMajorEq (GuardExp exp) (GuardExp exp_) = exp == exp_
+johnMajorEq GuardNo GuardNo = True
 johnMajorEq (POr pattern0 pattern1) (POr pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
 johnMajorEq (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
 johnMajorEq (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = i == i_ && pattern == pattern_ && patterns == patterns_
@@ -321,13 +331,13 @@ johnMajorEq (PVar i) (PVar i_) = i == i_
 johnMajorEq PWild PWild = True
 johnMajorEq (PListElem pattern) (PListElem pattern_) = pattern == pattern_
 johnMajorEq (FieldPattern i pattern) (FieldPattern i_ pattern_) = i == i_ && pattern == pattern_
+johnMajorEq (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = varorwild == varorwild_ && exp0 == exp0_ && exp1 == exp1_
+johnMajorEq (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
+johnMajorEq (EAbs varorwild exp) (EAbs varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
 johnMajorEq (ELet letdefs exp) (ELet letdefs_ exp_) = letdefs == letdefs_ && exp == exp_
 johnMajorEq (ECase exp cases) (ECase exp_ cases_) = exp == exp_ && cases == cases_
 johnMajorEq (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = exp0 == exp0_ && exp1 == exp1_ && exp2 == exp2_
 johnMajorEq (EDo binds exp) (EDo binds_ exp_) = binds == binds_ && exp == exp_
-johnMajorEq (EAbs varorwild exp) (EAbs varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
-johnMajorEq (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = varorwild == varorwild_ && exp0 == exp0_ && exp1 == exp1_
-johnMajorEq (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
 johnMajorEq (EBind exp0 exp1) (EBind exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
 johnMajorEq (EBindC exp0 exp1) (EBindC exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
 johnMajorEq (EOr exp0 exp1) (EOr exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_
@@ -356,12 +366,12 @@ johnMajorEq (EStr str) (EStr str_) = str == str_
 johnMajorEq (EInteger n) (EInteger n_) = n == n_
 johnMajorEq (EDouble d) (EDouble d_) = d == d_
 johnMajorEq EMeta EMeta = True
-johnMajorEq (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = i == i_ && exp0 == exp0_ && exp1 == exp1_
-johnMajorEq (Case pattern exp) (Case pattern_ exp_) = pattern == pattern_ && exp == exp_
-johnMajorEq (BindVar varorwild exp) (BindVar varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
-johnMajorEq (BindNoVar exp) (BindNoVar exp_) = exp == exp_
 johnMajorEq (VVar i) (VVar i_) = i == i_
 johnMajorEq VWild VWild = True
+johnMajorEq (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = i == i_ && exp0 == exp0_ && exp1 == exp1_
+johnMajorEq (Case pattern guard exp) (Case pattern_ guard_ exp_) = pattern == pattern_ && guard == guard_ && exp == exp_
+johnMajorEq (BindVar varorwild exp) (BindVar varorwild_ exp_) = varorwild == varorwild_ && exp == exp_
+johnMajorEq (BindNoVar exp) (BindNoVar exp_) = exp == exp_
 johnMajorEq (FieldType i exp) (FieldType i_ exp_) = i == i_ && exp == exp_
 johnMajorEq (FieldValue i exp) (FieldValue i_ exp_) = i == i_ && exp == exp_
 johnMajorEq (Ident str) (Ident str_) = str == str_
@@ -374,73 +384,77 @@ instance Ord (Tree c) where
     index (Import _) = 1
     index (DataDecl _ _ _) = 2
     index (TypeDecl _ _) = 3
-    index (ValueDecl _ _ _) = 4
+    index (ValueDecl _ _ _ _) = 4
     index (DeriveDecl _ _) = 5
     index (ConsDecl _ _) = 6
-    index (POr _ _) = 7
+    index (GuardExp _) = 7
-    index (PListCons _ _) = 8
+    index (GuardNo ) = 8
-    index (PConsTop _ _ _) = 9
+    index (POr _ _) = 9
-    index (PCons _ _) = 10
+    index (PListCons _ _) = 10
-    index (PRec _) = 11
+    index (PConsTop _ _ _) = 11
-    index (PList _) = 12
+    index (PCons _ _) = 12
-    index (PType ) = 13
+    index (PRec _) = 13
-    index (PStr _) = 14
+    index (PList _) = 14
-    index (PInt _) = 15
+    index (PType ) = 15
-    index (PVar _) = 16
+    index (PStr _) = 16
-    index (PWild ) = 17
+    index (PInt _) = 17
-    index (PListElem _) = 18
+    index (PVar _) = 18
-    index (FieldPattern _ _) = 19
+    index (PWild ) = 19
-    index (ELet _ _) = 20
+    index (PListElem _) = 20
-    index (ECase _ _) = 21
+    index (FieldPattern _ _) = 21
-    index (EIf _ _ _) = 22
+    index (EPi _ _ _) = 22
-    index (EDo _ _) = 23
+    index (EPiNoVar _ _) = 23
     index (EAbs _ _) = 24
-    index (EPi _ _ _) = 25
+    index (ELet _ _) = 25
-    index (EPiNoVar _ _) = 26
+    index (ECase _ _) = 26
-    index (EBind _ _) = 27
+    index (EIf _ _ _) = 27
-    index (EBindC _ _) = 28
+    index (EDo _ _) = 28
-    index (EOr _ _) = 29
+    index (EBind _ _) = 29
-    index (EAnd _ _) = 30
+    index (EBindC _ _) = 30
-    index (EEq _ _) = 31
+    index (EOr _ _) = 31
-    index (ENe _ _) = 32
+    index (EAnd _ _) = 32
-    index (ELt _ _) = 33
+    index (EEq _ _) = 33
-    index (ELe _ _) = 34
+    index (ENe _ _) = 34
-    index (EGt _ _) = 35
+    index (ELt _ _) = 35
-    index (EGe _ _) = 36
+    index (ELe _ _) = 36
-    index (EListCons _ _) = 37
+    index (EGt _ _) = 37
-    index (EAdd _ _) = 38
+    index (EGe _ _) = 38
-    index (ESub _ _) = 39
+    index (EListCons _ _) = 39
-    index (EMul _ _) = 40
+    index (EAdd _ _) = 40
-    index (EDiv _ _) = 41
+    index (ESub _ _) = 41
-    index (EMod _ _) = 42
+    index (EMul _ _) = 42
-    index (ENeg _) = 43
+    index (EDiv _ _) = 43
-    index (EApp _ _) = 44
+    index (EMod _ _) = 44
-    index (EProj _ _) = 45
+    index (ENeg _) = 45
-    index (ERecType _) = 46
+    index (EApp _ _) = 46
-    index (ERec _) = 47
+    index (EProj _ _) = 47
-    index (EList _) = 48
+    index (ERecType _) = 48
-    index (EVar _) = 49
+    index (ERec _) = 49
-    index (EType ) = 50
+    index (EList _) = 50
-    index (EStr _) = 51
+    index (EVar _) = 51
-    index (EInteger _) = 52
+    index (EType ) = 52
-    index (EDouble _) = 53
+    index (EStr _) = 53
-    index (EMeta ) = 54
+    index (EInteger _) = 54
-    index (LetDef _ _ _) = 55
+    index (EDouble _) = 55
-    index (Case _ _) = 56
+    index (EMeta ) = 56
-    index (BindVar _ _) = 57
+    index (VVar _) = 57
-    index (BindNoVar _) = 58
+    index (VWild ) = 58
-    index (VVar _) = 59
+    index (LetDef _ _ _) = 59
-    index (VWild ) = 60
+    index (Case _ _ _) = 60
-    index (FieldType _ _) = 61
+    index (BindVar _ _) = 61
-    index (FieldValue _ _) = 62
+    index (BindNoVar _) = 62
-    index (Ident _) = 63
+    index (FieldType _ _) = 63
+    index (FieldValue _ _) = 64
+    index (Ident _) = 65
     compareSame (Module imports decls) (Module imports_ decls_) = mappend (compare imports imports_) (compare decls decls_)
     compareSame (Import i) (Import i_) = compare i i_
     compareSame (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = mappend (compare i i_) (mappend (compare exp exp_) (compare consdecls consdecls_))
     compareSame (TypeDecl i exp) (TypeDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
-    compareSame (ValueDecl i patterns exp) (ValueDecl i_ patterns_ exp_) = mappend (compare i i_) (mappend (compare patterns patterns_) (compare exp exp_))
+    compareSame (ValueDecl i patterns guard exp) (ValueDecl i_ patterns_ guard_ exp_) = mappend (compare i i_) (mappend (compare patterns patterns_) (mappend (compare guard guard_) (compare exp exp_)))
     compareSame (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = mappend (compare i0 i0_) (compare i1 i1_)
     compareSame (ConsDecl i exp) (ConsDecl i_ exp_) = mappend (compare i i_) (compare exp exp_)
+    compareSame (GuardExp exp) (GuardExp exp_) = compare exp exp_
+    compareSame GuardNo GuardNo = EQ
     compareSame (POr pattern0 pattern1) (POr pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_)
     compareSame (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_)
     compareSame (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = mappend (compare i i_) (mappend (compare pattern pattern_) (compare patterns patterns_))
@@ -454,13 +468,13 @@ instance Ord (Tree c) where
     compareSame PWild PWild = EQ
     compareSame (PListElem pattern) (PListElem pattern_) = compare pattern pattern_
     compareSame (FieldPattern i pattern) (FieldPattern i_ pattern_) = mappend (compare i i_) (compare pattern pattern_)
+    compareSame (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = mappend (compare varorwild varorwild_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
+    compareSame (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
+    compareSame (EAbs varorwild exp) (EAbs varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
     compareSame (ELet letdefs exp) (ELet letdefs_ exp_) = mappend (compare letdefs letdefs_) (compare exp exp_)
     compareSame (ECase exp cases) (ECase exp_ cases_) = mappend (compare exp exp_) (compare cases cases_)
     compareSame (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = mappend (compare exp0 exp0_) (mappend (compare exp1 exp1_) (compare exp2 exp2_))
     compareSame (EDo binds exp) (EDo binds_ exp_) = mappend (compare binds binds_) (compare exp exp_)
-    compareSame (EAbs varorwild exp) (EAbs varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
-    compareSame (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = mappend (compare varorwild varorwild_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
-    compareSame (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
     compareSame (EBind exp0 exp1) (EBind exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
     compareSame (EBindC exp0 exp1) (EBindC exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
     compareSame (EOr exp0 exp1) (EOr exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_)
@@ -489,12 +503,12 @@ instance Ord (Tree c) where
     compareSame (EInteger n) (EInteger n_) = compare n n_
     compareSame (EDouble d) (EDouble d_) = compare d d_
     compareSame EMeta EMeta = EQ
-    compareSame (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = mappend (compare i i_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
-    compareSame (Case pattern exp) (Case pattern_ exp_) = mappend (compare pattern pattern_) (compare exp exp_)
-    compareSame (BindVar varorwild exp) (BindVar varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
-    compareSame (BindNoVar exp) (BindNoVar exp_) = compare exp exp_
     compareSame (VVar i) (VVar i_) = compare i i_
     compareSame VWild VWild = EQ
+    compareSame (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = mappend (compare i i_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
+    compareSame (Case pattern guard exp) (Case pattern_ guard_ exp_) = mappend (compare pattern pattern_) (mappend (compare guard guard_) (compare exp exp_))
+    compareSame (BindVar varorwild exp) (BindVar varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_)
+    compareSame (BindNoVar exp) (BindNoVar exp_) = compare exp exp_
     compareSame (FieldType i exp) (FieldType i_ exp_) = mappend (compare i i_) (compare exp exp_)
     compareSame (FieldValue i exp) (FieldValue i_ exp_) = mappend (compare i i_) (compare exp exp_)
     compareSame (Ident str) (Ident str_) = compare str str_

src/Transfer/Syntax/Doc.tex

@@ -62,16 +62,16 @@ The symbols used in Syntax are the following: \\
 
 \begin{tabular}{lll}
 {\symb{;}} &{\symb{:}} &{\symb{\{}} \\
-{\symb{\}}} &{\symb{{$=$}}} &{\symb{{$|$}{$|$}}} \\
+{\symb{\}}} &{\symb{{$=$}}} &{\symb{{$|$}}} \\
-{\symb{::}} &{\symb{(}} &{\symb{)}} \\
+{\symb{{$|$}{$|$}}} &{\symb{::}} &{\symb{(}} \\
-{\symb{[}} &{\symb{]}} &{\symb{,}} \\
+{\symb{)}} &{\symb{[}} &{\symb{]}} \\
-{\symb{\_}} &{\symb{{$-$}{$>$}}} &{\symb{{$<$}{$-$}}} \\
+{\symb{,}} &{\symb{\_}} &{\symb{{$-$}{$>$}}} \\
-{\symb{$\backslash$}} &{\symb{{$>$}{$>$}{$=$}}} &{\symb{{$>$}{$>$}}} \\
+{\symb{$\backslash$}} &{\symb{{$<$}{$-$}}} &{\symb{{$>$}{$>$}{$=$}}} \\
-{\symb{\&\&}} &{\symb{{$=$}{$=$}}} &{\symb{/{$=$}}} \\
+{\symb{{$>$}{$>$}}} &{\symb{\&\&}} &{\symb{{$=$}{$=$}}} \\
-{\symb{{$<$}}} &{\symb{{$<$}{$=$}}} &{\symb{{$>$}}} \\
+{\symb{/{$=$}}} &{\symb{{$<$}}} &{\symb{{$<$}{$=$}}} \\
-{\symb{{$>$}{$=$}}} &{\symb{{$+$}}} &{\symb{{$-$}}} \\
+{\symb{{$>$}}} &{\symb{{$>$}{$=$}}} &{\symb{{$+$}}} \\
-{\symb{*}} &{\symb{/}} &{\symb{\%}} \\
+{\symb{{$-$}}} &{\symb{*}} &{\symb{/}} \\
-{\symb{.}} &{\symb{?}} & \\
+{\symb{\%}} &{\symb{.}} &{\symb{?}} \\
 \end{tabular}\\
 
 \subsection*{Comments}
@@ -100,7 +100,7 @@ All other symbols are terminals.\\
 \begin{tabular}{lll}
 {\nonterminal{Decl}} & {\arrow}  &{\terminal{data}} {\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{where}} {\terminal{\{}} {\nonterminal{ListConsDecl}} {\terminal{\}}}  \\
  & {\delimit}  &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}}  \\
- & {\delimit}  &{\nonterminal{Ident}} {\nonterminal{ListPattern}} {\terminal{{$=$}}} {\nonterminal{Exp}}  \\
+ & {\delimit}  &{\nonterminal{Ident}} {\nonterminal{ListPattern}} {\nonterminal{Guard}} {\terminal{{$=$}}} {\nonterminal{Exp}}  \\
  & {\delimit}  &{\terminal{derive}} {\nonterminal{Ident}} {\nonterminal{Ident}}  \\
 \end{tabular}\\
 
@@ -120,6 +120,11 @@ All other symbols are terminals.\\
  & {\delimit}  &{\nonterminal{ConsDecl}} {\terminal{;}} {\nonterminal{ListConsDecl}}  \\
 \end{tabular}\\
 
+\begin{tabular}{lll}
+{\nonterminal{Guard}} & {\arrow}  &{\terminal{{$|$}}} {\nonterminal{Exp1}}  \\
+ & {\delimit}  &{\emptyP} \\
+\end{tabular}\\
+
 \begin{tabular}{lll}
 {\nonterminal{Pattern}} & {\arrow}  &{\nonterminal{Pattern1}} {\terminal{{$|$}{$|$}}} {\nonterminal{Pattern}}  \\
  & {\delimit}  &{\nonterminal{Pattern1}}  \\
@@ -172,13 +177,25 @@ All other symbols are terminals.\\
 \end{tabular}\\
 
 \begin{tabular}{lll}
-{\nonterminal{Exp}} & {\arrow}  &{\terminal{let}} {\terminal{\{}} {\nonterminal{ListLetDef}} {\terminal{\}}} {\terminal{in}} {\nonterminal{Exp}}  \\
+{\nonterminal{Exp}} & {\arrow}  &{\terminal{(}} {\nonterminal{VarOrWild}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{)}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
- & {\delimit}  &{\terminal{case}} {\nonterminal{Exp}} {\terminal{of}} {\terminal{\{}} {\nonterminal{ListCase}} {\terminal{\}}}  \\
+ & {\delimit}  &{\nonterminal{Exp1}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
- & {\delimit}  &{\terminal{if}} {\nonterminal{Exp}} {\terminal{then}} {\nonterminal{Exp}} {\terminal{else}} {\nonterminal{Exp}}  \\
- & {\delimit}  &{\terminal{do}} {\terminal{\{}} {\nonterminal{ListBind}} {\nonterminal{Exp}} {\terminal{\}}}  \\
  & {\delimit}  &{\nonterminal{Exp1}}  \\
 \end{tabular}\\
 
+\begin{tabular}{lll}
+{\nonterminal{VarOrWild}} & {\arrow}  &{\nonterminal{Ident}}  \\
+ & {\delimit}  &{\terminal{\_}}  \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{Exp1}} & {\arrow}  &{\terminal{$\backslash$}} {\nonterminal{VarOrWild}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp1}}  \\
+ & {\delimit}  &{\terminal{let}} {\terminal{\{}} {\nonterminal{ListLetDef}} {\terminal{\}}} {\terminal{in}} {\nonterminal{Exp1}}  \\
+ & {\delimit}  &{\terminal{case}} {\nonterminal{Exp}} {\terminal{of}} {\terminal{\{}} {\nonterminal{ListCase}} {\terminal{\}}}  \\
+ & {\delimit}  &{\terminal{if}} {\nonterminal{Exp}} {\terminal{then}} {\nonterminal{Exp}} {\terminal{else}} {\nonterminal{Exp1}}  \\
+ & {\delimit}  &{\terminal{do}} {\terminal{\{}} {\nonterminal{ListBind}} {\nonterminal{Exp}} {\terminal{\}}}  \\
+ & {\delimit}  &{\nonterminal{Exp2}}  \\
+\end{tabular}\\
+
 \begin{tabular}{lll}
 {\nonterminal{LetDef}} & {\arrow}  &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{{$=$}}} {\nonterminal{Exp}}  \\
 \end{tabular}\\
@@ -190,7 +207,7 @@ All other symbols are terminals.\\
 \end{tabular}\\
 
 \begin{tabular}{lll}
-{\nonterminal{Case}} & {\arrow}  &{\nonterminal{Pattern}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
+{\nonterminal{Case}} & {\arrow}  &{\nonterminal{Pattern}} {\nonterminal{Guard}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
 \end{tabular}\\
 
 \begin{tabular}{lll}
@@ -209,18 +226,6 @@ All other symbols are terminals.\\
  & {\delimit}  &{\nonterminal{Bind}} {\terminal{;}} {\nonterminal{ListBind}}  \\
 \end{tabular}\\
 
-\begin{tabular}{lll}
-{\nonterminal{Exp2}} & {\arrow}  &{\terminal{$\backslash$}} {\nonterminal{VarOrWild}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
- & {\delimit}  &{\terminal{(}} {\nonterminal{VarOrWild}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{)}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
- & {\delimit}  &{\nonterminal{Exp3}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}}  \\
- & {\delimit}  &{\nonterminal{Exp3}}  \\
-\end{tabular}\\
-
-\begin{tabular}{lll}
-{\nonterminal{VarOrWild}} & {\arrow}  &{\nonterminal{Ident}}  \\
- & {\delimit}  &{\terminal{\_}}  \\
-\end{tabular}\\
-
 \begin{tabular}{lll}
 {\nonterminal{Exp3}} & {\arrow}  &{\nonterminal{Exp3}} {\terminal{{$>$}{$>$}{$=$}}} {\nonterminal{Exp4}}  \\
  & {\delimit}  &{\nonterminal{Exp3}} {\terminal{{$>$}{$>$}}} {\nonterminal{Exp4}}  \\
@@ -314,7 +319,7 @@ All other symbols are terminals.\\
 \end{tabular}\\
 
 \begin{tabular}{lll}
-{\nonterminal{Exp1}} & {\arrow}  &{\nonterminal{Exp2}}  \\
+{\nonterminal{Exp2}} & {\arrow}  &{\nonterminal{Exp3}}  \\
 \end{tabular}\\
 
 \begin{tabular}{lll}

src/Transfer/Syntax/Lex.x

@@ -16,7 +16,7 @@ $i = [$l $d _ ']          -- identifier character
 $u = [\0-\255]          -- universal: any character
 
 @rsyms =    -- reserved words consisting of special symbols
-   \; | \: | \{ | \} | \= | \| \| | \: \: | \( | \) | \[ | \] | \, | \_ | \- \> | \< \- | \\ | \> \> \= | \> \> | \& \& | \= \= | \/ \= | \< | \< \= | \> | \> \= | \+ | \- | \* | \/ | \% | \. | \?
+   \; | \: | \{ | \} | \= | \| | \| \| | \: \: | \( | \) | \[ | \] | \, | \_ | \- \> | \\ | \< \- | \> \> \= | \> \> | \& \& | \= \= | \/ \= | \< | \< \= | \> | \> \= | \+ | \- | \* | \/ | \% | \. | \?
 
 :-
 "--" [.]* ; -- Toss single line comments

src/Transfer/Syntax/Par.y

@@ -19,6 +19,7 @@ import Transfer.ErrM
  '{' { PT _ (TS "{") }
  '}' { PT _ (TS "}") }
  '=' { PT _ (TS "=") }
+ '|' { PT _ (TS "|") }
  '||' { PT _ (TS "||") }
  '::' { PT _ (TS "::") }
  '(' { PT _ (TS "(") }
@@ -28,8 +29,8 @@ import Transfer.ErrM
  ',' { PT _ (TS ",") }
  '_' { PT _ (TS "_") }
  '->' { PT _ (TS "->") }
- '<-' { PT _ (TS "<-") }
  '\\' { PT _ (TS "\\") }
+ '<-' { PT _ (TS "<-") }
  '>>=' { PT _ (TS ">>=") }
  '>>' { PT _ (TS ">>") }
  '&&' { PT _ (TS "&&") }
@@ -93,7 +94,7 @@ ListImport : {- empty -} { [] }
 Decl :: { Decl }
 Decl : 'data' Ident ':' Exp 'where' '{' ListConsDecl '}' { DataDecl $2 $4 $7 } 
   | Ident ':' Exp { TypeDecl $1 $3 }
-  | Ident ListPattern '=' Exp { ValueDecl $1 (reverse $2) $4 }
+  | Ident ListPattern Guard '=' Exp { ValueDecl $1 (reverse $2) $3 $5 }
   | 'derive' Ident Ident { DeriveDecl $2 $3 }
 
 
@@ -113,6 +114,11 @@ ListConsDecl : {- empty -} { [] }
   | ConsDecl ';' ListConsDecl { (:) $1 $3 }
 
 
+Guard :: { Guard }
+Guard : '|' Exp1 { GuardExp $2 } 
+  | {- empty -} { GuardNo }
+
+
 Pattern :: { Pattern }
 Pattern : Pattern1 '||' Pattern { POr $1 $3 } 
   | Pattern1 { $1 }
@@ -165,13 +171,25 @@ ListFieldPattern : {- empty -} { [] }
 
 
 Exp :: { Exp }
-Exp : 'let' '{' ListLetDef '}' 'in' Exp { ELet $3 $6 } 
+Exp : '(' VarOrWild ':' Exp ')' '->' Exp { EPi $2 $4 $7 } 
-  | 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
+  | Exp1 '->' Exp { EPiNoVar $1 $3 }
-  | 'if' Exp 'then' Exp 'else' Exp { EIf $2 $4 $6 }
-  | 'do' '{' ListBind Exp '}' { EDo (reverse $3) $4 }
   | Exp1 { $1 }
 
 
+VarOrWild :: { VarOrWild }
+VarOrWild : Ident { VVar $1 } 
+  | '_' { VWild }
+
+
+Exp1 :: { Exp }
+Exp1 : '\\' VarOrWild '->' Exp1 { EAbs $2 $4 } 
+  | 'let' '{' ListLetDef '}' 'in' Exp1 { ELet $3 $6 }
+  | 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
+  | 'if' Exp 'then' Exp 'else' Exp1 { EIf $2 $4 $6 }
+  | 'do' '{' ListBind Exp '}' { EDo (reverse $3) $4 }
+  | Exp2 { $1 }
+
+
 LetDef :: { LetDef }
 LetDef : Ident ':' Exp '=' Exp { LetDef $1 $3 $5 } 
 
@@ -183,7 +201,7 @@ ListLetDef : {- empty -} { [] }
 
 
 Case :: { Case }
-Case : Pattern '->' Exp { Case $1 $3 } 
+Case : Pattern Guard '->' Exp { Case $1 $2 $4 } 
 
 
 ListCase :: { [Case] }
@@ -202,18 +220,6 @@ ListBind : {- empty -} { [] }
   | ListBind Bind ';' { flip (:) $1 $2 }
 
 
-Exp2 :: { Exp }
-Exp2 : '\\' VarOrWild '->' Exp { EAbs $2 $4 } 
-  | '(' VarOrWild ':' Exp ')' '->' Exp { EPi $2 $4 $7 }
-  | Exp3 '->' Exp { EPiNoVar $1 $3 }
-  | Exp3 { $1 }
-
-
-VarOrWild :: { VarOrWild }
-VarOrWild : Ident { VVar $1 } 
-  | '_' { VWild }
-
-
 Exp3 :: { Exp }
 Exp3 : Exp3 '>>=' Exp4 { EBind $1 $3 } 
   | Exp3 '>>' Exp4 { EBindC $1 $3 }
@@ -306,8 +312,8 @@ ListFieldValue : {- empty -} { [] }
   | FieldValue ';' ListFieldValue { (:) $1 $3 }
 
 
-Exp1 :: { Exp }
+Exp2 :: { Exp }
-Exp1 : Exp2 { $1 } 
+Exp2 : Exp3 { $1 } 
 
 
 ListExp :: { [Exp] }

src/Transfer/Syntax/Print.hs

@@ -84,9 +84,11 @@ instance Print (Tree c) where
     Import i -> prPrec _i 0 (concatD [doc (showString "import") , prt 0 i])
     DataDecl i exp consdecls -> prPrec _i 0 (concatD [doc (showString "data") , prt 0 i , doc (showString ":") , prt 0 exp , doc (showString "where") , doc (showString "{") , prt 0 consdecls , doc (showString "}")])
     TypeDecl i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp])
-    ValueDecl i patterns exp -> prPrec _i 0 (concatD [prt 0 i , prt 0 patterns , doc (showString "=") , prt 0 exp])
+    ValueDecl i patterns guard exp -> prPrec _i 0 (concatD [prt 0 i , prt 0 patterns , prt 0 guard , doc (showString "=") , prt 0 exp])
     DeriveDecl i0 i1 -> prPrec _i 0 (concatD [doc (showString "derive") , prt 0 i0 , prt 0 i1])
     ConsDecl i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp])
+    GuardExp exp -> prPrec _i 0 (concatD [doc (showString "|") , prt 1 exp])
+    GuardNo  -> prPrec _i 0 (concatD [])
     POr pattern0 pattern1 -> prPrec _i 0 (concatD [prt 1 pattern0 , doc (showString "||") , prt 0 pattern1])
     PListCons pattern0 pattern1 -> prPrec _i 1 (concatD [prt 2 pattern0 , doc (showString "::") , prt 1 pattern1])
     PConsTop i pattern patterns -> prPrec _i 2 (concatD [prt 0 i , prt 3 pattern , prt 0 patterns])
@@ -100,13 +102,13 @@ instance Print (Tree c) where
     PWild  -> prPrec _i 3 (concatD [doc (showString "_")])
     PListElem pattern -> prPrec _i 0 (concatD [prt 0 pattern])
     FieldPattern i pattern -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 pattern])
-    ELet letdefs exp -> prPrec _i 0 (concatD [doc (showString "let") , doc (showString "{") , prt 0 letdefs , doc (showString "}") , doc (showString "in") , prt 0 exp])
+    EPi varorwild exp0 exp1 -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 varorwild , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp1])
-    ECase exp cases -> prPrec _i 0 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
+    EPiNoVar exp0 exp1 -> prPrec _i 0 (concatD [prt 1 exp0 , doc (showString "->") , prt 0 exp1])
-    EIf exp0 exp1 exp2 -> prPrec _i 0 (concatD [doc (showString "if") , prt 0 exp0 , doc (showString "then") , prt 0 exp1 , doc (showString "else") , prt 0 exp2])
+    EAbs varorwild exp -> prPrec _i 1 (concatD [doc (showString "\\") , prt 0 varorwild , doc (showString "->") , prt 1 exp])
-    EDo binds exp -> prPrec _i 0 (concatD [doc (showString "do") , doc (showString "{") , prt 0 binds , prt 0 exp , doc (showString "}")])
+    ELet letdefs exp -> prPrec _i 1 (concatD [doc (showString "let") , doc (showString "{") , prt 0 letdefs , doc (showString "}") , doc (showString "in") , prt 1 exp])
-    EAbs varorwild exp -> prPrec _i 2 (concatD [doc (showString "\\") , prt 0 varorwild , doc (showString "->") , prt 0 exp])
+    ECase exp cases -> prPrec _i 1 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
-    EPi varorwild exp0 exp1 -> prPrec _i 2 (concatD [doc (showString "(") , prt 0 varorwild , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp1])
+    EIf exp0 exp1 exp2 -> prPrec _i 1 (concatD [doc (showString "if") , prt 0 exp0 , doc (showString "then") , prt 0 exp1 , doc (showString "else") , prt 1 exp2])
-    EPiNoVar exp0 exp1 -> prPrec _i 2 (concatD [prt 3 exp0 , doc (showString "->") , prt 0 exp1])
+    EDo binds exp -> prPrec _i 1 (concatD [doc (showString "do") , doc (showString "{") , prt 0 binds , prt 0 exp , doc (showString "}")])
     EBind exp0 exp1 -> prPrec _i 3 (concatD [prt 3 exp0 , doc (showString ">>=") , prt 4 exp1])
     EBindC exp0 exp1 -> prPrec _i 3 (concatD [prt 3 exp0 , doc (showString ">>") , prt 4 exp1])
     EOr exp0 exp1 -> prPrec _i 4 (concatD [prt 5 exp0 , doc (showString "||") , prt 4 exp1])
@@ -135,12 +137,12 @@ instance Print (Tree c) where
     EInteger n -> prPrec _i 13 (concatD [prt 0 n])
     EDouble d -> prPrec _i 13 (concatD [prt 0 d])
     EMeta  -> prPrec _i 13 (concatD [doc (showString "?")])
-    LetDef i exp0 exp1 -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp1])
-    Case pattern exp -> prPrec _i 0 (concatD [prt 0 pattern , doc (showString "->") , prt 0 exp])
-    BindVar varorwild exp -> prPrec _i 0 (concatD [prt 0 varorwild , doc (showString "<-") , prt 0 exp])
-    BindNoVar exp -> prPrec _i 0 (concatD [prt 0 exp])
     VVar i -> prPrec _i 0 (concatD [prt 0 i])
     VWild  -> prPrec _i 0 (concatD [doc (showString "_")])
+    LetDef i exp0 exp1 -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp1])
+    Case pattern guard exp -> prPrec _i 0 (concatD [prt 0 pattern , prt 0 guard , doc (showString "->") , prt 0 exp])
+    BindVar varorwild exp -> prPrec _i 0 (concatD [prt 0 varorwild , doc (showString "<-") , prt 0 exp])
+    BindNoVar exp -> prPrec _i 0 (concatD [prt 0 exp])
     FieldType i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp])
     FieldValue i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 exp])
     Ident str -> prPrec _i 0 (doc (showString str))

src/Transfer/Syntax/Skel.hs

@@ -15,9 +15,11 @@ transTree t = case t of
   Import i -> failure t
   DataDecl i exp consdecls -> failure t
   TypeDecl i exp -> failure t
-  ValueDecl i patterns exp -> failure t
+  ValueDecl i patterns guard exp -> failure t
   DeriveDecl i0 i1 -> failure t
   ConsDecl i exp -> failure t
+  GuardExp exp -> failure t
+  GuardNo  -> failure t
   POr pattern0 pattern1 -> failure t
   PListCons pattern0 pattern1 -> failure t
   PConsTop i pattern patterns -> failure t
@@ -31,13 +33,13 @@ transTree t = case t of
   PWild  -> failure t
   PListElem pattern -> failure t
   FieldPattern i pattern -> failure t
+  EPi varorwild exp0 exp1 -> failure t
+  EPiNoVar exp0 exp1 -> failure t
+  EAbs varorwild exp -> failure t
   ELet letdefs exp -> failure t
   ECase exp cases -> failure t
   EIf exp0 exp1 exp2 -> failure t
   EDo binds exp -> failure t
-  EAbs varorwild exp -> failure t
-  EPi varorwild exp0 exp1 -> failure t
-  EPiNoVar exp0 exp1 -> failure t
   EBind exp0 exp1 -> failure t
   EBindC exp0 exp1 -> failure t
   EOr exp0 exp1 -> failure t
@@ -66,12 +68,12 @@ transTree t = case t of
   EInteger n -> failure t
   EDouble d -> failure t
   EMeta  -> failure t
-  LetDef i exp0 exp1 -> failure t
-  Case pattern exp -> failure t
-  BindVar varorwild exp -> failure t
-  BindNoVar exp -> failure t
   VVar i -> failure t
   VWild  -> failure t
+  LetDef i exp0 exp1 -> failure t
+  Case pattern guard exp -> failure t
+  BindVar varorwild exp -> failure t
+  BindNoVar exp -> failure t
   FieldType i exp -> failure t
   FieldValue i exp -> failure t
   Ident str -> failure t
@@ -88,13 +90,18 @@ transDecl :: Decl -> Result
 transDecl t = case t of
   DataDecl i exp consdecls -> failure t
   TypeDecl i exp -> failure t
-  ValueDecl i patterns exp -> failure t
+  ValueDecl i patterns guard exp -> failure t
   DeriveDecl i0 i1 -> failure t
 
 transConsDecl :: ConsDecl -> Result
 transConsDecl t = case t of
   ConsDecl i exp -> failure t
 
+transGuard :: Guard -> Result
+transGuard t = case t of
+  GuardExp exp -> failure t
+  GuardNo  -> failure t
+
 transPattern :: Pattern -> Result
 transPattern t = case t of
   POr pattern0 pattern1 -> failure t
@@ -119,13 +126,13 @@ transFieldPattern t = case t of
 
 transExp :: Exp -> Result
 transExp t = case t of
+  EPi varorwild exp0 exp1 -> failure t
+  EPiNoVar exp0 exp1 -> failure t
+  EAbs varorwild exp -> failure t
   ELet letdefs exp -> failure t
   ECase exp cases -> failure t
   EIf exp0 exp1 exp2 -> failure t
   EDo binds exp -> failure t
-  EAbs varorwild exp -> failure t
-  EPi varorwild exp0 exp1 -> failure t
-  EPiNoVar exp0 exp1 -> failure t
   EBind exp0 exp1 -> failure t
   EBindC exp0 exp1 -> failure t
   EOr exp0 exp1 -> failure t
@@ -155,24 +162,24 @@ transExp t = case t of
   EDouble d -> failure t
   EMeta  -> failure t
 
+transVarOrWild :: VarOrWild -> Result
+transVarOrWild t = case t of
+  VVar i -> failure t
+  VWild  -> failure t
+
 transLetDef :: LetDef -> Result
 transLetDef t = case t of
   LetDef i exp0 exp1 -> failure t
 
 transCase :: Case -> Result
 transCase t = case t of
-  Case pattern exp -> failure t
+  Case pattern guard exp -> failure t
 
 transBind :: Bind -> Result
 transBind t = case t of
   BindVar varorwild exp -> failure t
   BindNoVar exp -> failure t
 
-transVarOrWild :: VarOrWild -> Result
-transVarOrWild t = case t of
-  VVar i -> failure t
-  VWild  -> failure t
-
 transFieldType :: FieldType -> Result
 transFieldType t = case t of
   FieldType i exp -> failure t

src/Transfer/Syntax/Syntax.cf

@@ -14,13 +14,16 @@ separator Import ";" ;
 
 DataDecl.     Decl ::= "data" Ident ":" Exp "where" "{" [ConsDecl] "}" ;
 TypeDecl.     Decl ::= Ident ":" Exp ;
-ValueDecl. Decl ::= Ident [Pattern] "=" Exp ;
+ValueDecl.    Decl ::= Ident [Pattern] Guard "=" Exp ;
 DeriveDecl.   Decl ::= "derive" Ident Ident ;
 separator Decl ";" ;
 
 ConsDecl. ConsDecl ::= Ident ":" Exp ;
 separator ConsDecl ";" ;
 
+GuardExp.  Guard ::= "|" Exp1 ;
+GuardNo.   Guard ::= ;
+
 -- Disjunctive patterns.
 POr.      Pattern ::= Pattern1 "||" Pattern ;
 
@@ -61,27 +64,26 @@ coercions Pattern 3 ;
 FieldPattern. FieldPattern ::= Ident "=" Pattern ;
 separator FieldPattern ";" ;
 
-ELet.      Exp  ::= "let" "{" [LetDef] "}" "in" Exp ;
+-- Function types have precedence < 1 to keep the
+-- "->" from conflicting with the "->" after guards
+EPi.       Exp ::= "(" VarOrWild ":" Exp ")" "->" Exp ;
+EPiNoVar.  Exp ::= Exp1 "->" Exp ;
+VVar.      VarOrWild ::= Ident ;
+VWild.     VarOrWild ::= "_" ;
+
+EAbs.      Exp1 ::= "\\" VarOrWild "->" Exp1 ;
+ELet.      Exp1 ::= "let" "{" [LetDef] "}" "in" Exp1 ;
 LetDef.    LetDef ::= Ident ":" Exp "=" Exp ;
 separator LetDef ";" ;
-
+ECase.     Exp1 ::= "case" Exp "of" "{" [Case] "}" ;
-ECase.     Exp  ::= "case" Exp "of" "{" [Case] "}" ;
+Case.     Case ::= Pattern Guard "->" Exp ;
-Case. Case ::= Pattern "->" Exp ;
 separator Case ";" ;
-
+EIf.       Exp1 ::= "if" Exp "then" Exp "else" Exp1 ;
-EIf.       Exp  ::= "if" Exp "then" Exp "else" Exp ;
+EDo.       Exp1 ::= "do" "{" [Bind] Exp "}" ;
-
-EDo.       Exp  ::= "do" "{" [Bind] Exp "}" ;
 BindVar.   Bind ::= VarOrWild "<-" Exp ;
 BindNoVar. Bind ::= Exp ;
 terminator Bind ";" ;
 
-EAbs.      Exp2 ::= "\\" VarOrWild "->" Exp ;
-EPi.       Exp2 ::= "(" VarOrWild ":" Exp ")" "->" Exp ;
-EPiNoVar.  Exp2 ::= Exp3 "->" Exp ;
-VVar.      VarOrWild ::= Ident ;
-VWild.     VarOrWild ::= "_" ;
-
 EBind.     Exp3 ::= Exp3 ">>=" Exp4 ;
 EBindC.    Exp3 ::= Exp3 ">>"  Exp4 ;
 

src/Transfer/SyntaxToCore.hs

@@ -28,11 +28,11 @@ declsToCore :: [Decl] -> [Decl]
 declsToCore m = evalState (declsToCore_ m) newState
 
 declsToCore_ :: [Decl] -> C [Decl]
-declsToCore_ =     desugar 
+declsToCore_ =     deriveDecls
-               >>> numberMetas
+               >>> desugar 
-               >>> deriveDecls
-               >>> replaceCons 
                >>> compilePattDecls 
+               >>> numberMetas
+               >>> replaceCons 
                >>> expandOrPatts
                >>> optimize
 
@@ -61,13 +61,14 @@ numberMetas = mapM f
                         return $ EVar $ Ident $ "?" ++ show (nextMeta st) -- FIXME: hack
                _ -> composOpM f t
 
+
 --
 -- * Pattern equations
 --
 
 compilePattDecls :: [Decl] -> C [Decl]
 compilePattDecls [] = return []
-compilePattDecls (d@(ValueDecl x _ _):ds) =
+compilePattDecls (d@(ValueDecl x _ _ _):ds) =
     do
     let (xs,rest) = span (isValueDecl x) ds
     d <- mergeDecls (d:xs)
@@ -75,20 +76,26 @@ compilePattDecls (d@(ValueDecl x _ _):ds) =
     return (d:rs)
 compilePattDecls (d:ds) = liftM (d:) (compilePattDecls ds)
 
--- | Take a non-empty list of pattern equations for the same
+-- | Checks if a declaration is a value declaration
---   function, and produce a single declaration.
+--   of the given identifier.
+isValueDecl :: Ident -> Decl -> Bool
+isValueDecl x (ValueDecl y _ _ _) = x == y
+isValueDecl _ _ = False
+
+-- | Take a non-empty list of pattern equations with guards 
+--   for the same function, and produce a single declaration.
 mergeDecls :: [Decl] -> C Decl
-mergeDecls ds@(ValueDecl x p _:_)
+mergeDecls ds@(ValueDecl x p _ _:_)
-    = do let cs = [ (ps,rhs) | ValueDecl _ ps rhs <- ds ]
+    = do let cs = [ (ps,g,rhs) | ValueDecl _ ps g rhs <- ds ]
-             (pss,rhss) = unzip cs
+             (pss,_,_) = unzip3 cs
              n = length p
          when (not (all ((== n) . length) pss))
               $ fail $ "Pattern count mismatch for " ++ printTree x
          vs <- freshIdents n
-         let cases = map (\ (ps,rhs) -> Case (mkPRec ps) rhs) cs
+         let cases = map (\ (ps,g,rhs) -> Case (mkPRec ps) g rhs) cs
              c = ECase (mkERec (map EVar vs)) cases
              f = foldr (EAbs . VVar) c vs
-         return $ ValueDecl x [] f
+         return $ ValueDecl x [] GuardNo f
   where mkRec r f = r . zipWith (\i e -> f (Ident ("p"++show i)) e) [0..]
         mkPRec = mkRec PRec FieldPattern
         mkERec = mkRec ERec FieldValue
@@ -118,6 +125,10 @@ derivators = [
               ("Ord", deriveOrd)
              ]
 
+--
+-- * Deriving instances of Compos
+--
+
 deriveCompos :: Derivator
 deriveCompos t@(Ident ts) k cs = 
     do
@@ -128,7 +139,7 @@ deriveCompos t@(Ident ts) k cs =
         dt = apply (EVar (Ident "Compos")) [c, EVar t]
         r = ERec [FieldValue (Ident "composOp") co,
                   FieldValue (Ident "composFold") cf]
-    return [TypeDecl d dt, ValueDecl d [] r]
+    return [TypeDecl d dt, ValueDecl d [] GuardNo r]
 
 deriveComposOp :: Ident -> Exp -> [(Ident,Exp)] -> C Exp
 deriveComposOp t k cs = 
@@ -149,9 +160,9 @@ deriveComposOp t k cs =
                                    EApp (EVar t') c | t' == t -> apply (e f) [c, e v]
                                    _ -> e v
                 calls = zipWith rec vars (argumentTypes ct)
-            return $ Case (PCons ci (map PVar vars)) (apply (e ci) calls)
+            return $ Case (PCons ci (map PVar vars)) gtrue (apply (e ci) calls)
     cases <- mapM (uncurry mkCase) cs
-    let cases' = cases ++ [Case PWild (e x)]
+    let cases' = cases ++ [Case PWild gtrue (e x)]
     fb <- abstract (arity k) $ const $ pv f \-> pv x \-> ECase (e x) cases'
     return fb
 
@@ -180,17 +191,61 @@ deriveComposFold t k cs =
                 p = EProj (e r) (Ident "mplus")
                 joinCalls [] = z
                 joinCalls cs = foldr1 (\x y -> apply p [x,y]) cs
-            return $ Case (PCons ci (map PVar vars)) (joinCalls calls)
+            return $ Case (PCons ci (map PVar vars)) gtrue (joinCalls calls)
     cases <- mapM (uncurry mkCase) cs
-    let cases' = cases ++ [Case PWild (e x)]
+    let cases' = cases ++ [Case PWild gtrue (e x)]
     fb <- abstract (arity k) $ const $ pv f \-> pv x \-> ECase (e x) cases'
     return $ VWild \-> pv r \-> fb
 
+--
+-- * Deriving instances of Show
+--
+
 deriveShow :: Derivator
 deriveShow t k cs = fail $ "derive Show not implemented"
 
+--
+-- * Deriving instances of Eq
+--
+
+-- FIXME: how do we require Eq instances for all
+-- constructor arguments?
+
 deriveEq :: Derivator
-deriveEq t k cs = fail $ "derive Eq not implemented"
+deriveEq t@(Ident tn) k cs = 
+    do
+    let ats = argumentTypes k
+        d = Ident ("eq_"++tn)
+    dt <- abstractType ats (EApp (EVar (Ident "Eq")) . apply (EVar t))
+    eq <- mkEq
+    r <- abstract (arity k) (\_ -> ERec [FieldValue (Ident "eq") eq])
+    return [TypeDecl d dt, ValueDecl d [] GuardNo r]
+  where
+  mkEq = do
+         x <- freshIdent
+         cases <- mapM (uncurry mkEqCase) cs
+         return $ EAbs (VVar x) (ECase (EVar x) cases)
+  mkEqCase c ct = 
+      do
+      let n = arity ct
+      vs1 <- freshIdents n
+      vs2 <- freshIdents n
+      y <- freshIdent
+      let p1 = PCons c (map PVar vs1)
+          p2 = PCons c (map PVar vs2)
+          es1 = map EVar vs1
+          es2 = map EVar vs2
+          tc | n == 0 = true
+               -- FIXME: using EEq doesn't work right now
+             | otherwise = foldr1 EAnd (zipWith EEq es1 es2)
+          c1 = Case p2 gtrue tc
+          c2 = Case PWild gtrue false
+      return $ Case p1 gtrue (EAbs (VVar y) (ECase (EVar y) [c1,c2]))
+               
+
+--
+-- * Deriving instances of Ord
+--
 
 deriveOrd :: Derivator
 deriveOrd t k cs = fail $ "derive Ord not implemented"
@@ -268,10 +323,10 @@ removeUselessMatch = return . map f
  f x = case x of
        EAbs (VVar x) b ->
            case f b of
-                    -- replace \x -> case x of { y -> e } with \y -> e,
+                    -- replace \x -> case x of { y | True -> e } with \y -> e,
                     -- if x is not free in e
-                    ECase (EVar x') [Case (PVar y) e]
+                    ECase (EVar x') [Case (PVar y) g e]
-                          | x' == x && not (x `isFreeIn` e)
+                          | x' == x && isTrueGuard g && not (x `isFreeIn` e)
                               -> f (EAbs (VVar y) e)
                     -- replace unused variable in lambda with wild card
                     e | not (x `isFreeIn` e) -> f (EAbs VWild e)
@@ -282,31 +337,33 @@ removeUselessMatch = return . map f
                v = if not (x `isFreeIn` e') then VWild else VVar x
             in EPi v (f t) e'
        -- replace unused variables in case patterns with wild cards
-       Case p e ->
+       Case p (GuardExp g) e ->
-           let e' = f e
+           let g' = f g
-               p' = f (removeUnusedVarPatts (freeVars e') p)
+               e' = f e
-            in Case p' e'
+               used = freeVars g' `Set.union` freeVars e'
+               p' = f (removeUnusedVarPatts used p)
+            in Case p' (GuardExp g') e'
        -- for value declarations without patterns, compilePattDecls 
        -- generates pattern matching on the empty record, remove these
-       ECase (ERec []) [Case (PRec []) e] -> f e
+       ECase (ERec []) [Case (PRec []) g e] | isTrueGuard g -> f e
        -- if the pattern matching is on a single field of a record expression
        -- with only one field, there is no need to wrap it in a record
        ECase (ERec [FieldValue x e]) cs | all (isSingleFieldPattern x) (casePatterns cs)
-              -> f (ECase e [ Case p r | Case (PRec [FieldPattern _ p]) r <- cs ])
+              -> f (ECase e [ Case p g r | Case (PRec [FieldPattern _ p]) g r <- cs ])
-       -- for all fields in record matching where all patterns just
+       -- for all fields in record matching where all patterns for the field just
        -- bind variables, substitute in the field value (if it is a variable)
-       -- in the right hand sides.
+       -- in the guards and right hand sides.
        ECase (ERec fs) cs | all isPRec (casePatterns cs) ->
-           let g (FieldValue f v@(EVar _):fs) xs
+           let h (FieldValue f v@(EVar _):fs) xs
                    | all (onlyBindsFieldToVariable f) (casePatterns xs)
-                          = g fs (map (inlineField f v) xs)
+                          = h fs (map (inlineField f v) xs)
-               g (f:fs) xs = let (fs',xs') = g fs xs in (f:fs',xs')
+               h (f:fs) xs = let (fs',xs') = h fs xs in (f:fs',xs')
-               g [] xs = ([],xs)
+               h [] xs = ([],xs)
-               inlineField f v (Case (PRec fps) e) = 
+               inlineField f v (Case (PRec fps) (GuardExp g) e) = 
                    let p' = PRec [fp | fp@(FieldPattern f' _) <- fps, f' /= f]
                        ss = zip (fieldPatternVars f fps) (repeat v)
-                    in Case p' (substs ss e)
+                    in Case p' (GuardExp (substs ss g)) (substs ss e)
-               (fs',cs') = g fs cs
+               (fs',cs') = h fs cs
                x' = ECase (ERec fs') cs'
             in if length fs' < length fs then f x' else composOp f x'
        -- Remove wild card patterns in record patterns
@@ -314,6 +371,11 @@ removeUselessMatch = return . map f
           where wildcards = [fp | fp@(FieldPattern _ PWild) <- fps]
        _ -> composOp f x
 
+isTrueGuard :: Guard -> Bool
+isTrueGuard (GuardExp (EVar (Ident "True"))) = True
+isTrueGuard GuardNo = True
+isTrueGuard _ = False
+
 removeUnusedVarPatts :: Set Ident -> Tree a -> Tree a
 removeUnusedVarPatts keep x = case x of
                     PVar id | not (id `Set.member` keep) -> PWild
@@ -325,7 +387,7 @@ isSingleFieldPattern x p = case p of
                                 _ -> False
 
 casePatterns :: [Case] -> [Pattern]
-casePatterns cs = [p | Case p _ <- cs]
+casePatterns cs = [p | Case p _ _ <- cs]
 
 isPRec :: Pattern -> Bool
 isPRec (PRec _) = True
@@ -357,7 +419,7 @@ expandOrPatts = return . map f
               _          -> composOp f x
 
 expandCase :: Case -> [Case]
-expandCase (Case p e) = [ Case p' e | p' <- expandPatt p ]
+expandCase (Case p g e) = [ Case p' g e | p' <- expandPatt p ]
 
 expandPatt :: Pattern -> [Pattern]
 expandPatt p = case p of
@@ -383,14 +445,15 @@ desugar = return . map f
  f x = case x of
               PListCons p1 p2    -> pListCons        <| p1   <| p2
               PList xs           -> pList (map f [p | PListElem p <- xs])
+              GuardNo            -> gtrue
               EIf exp0 exp1 exp2 -> ifBool           <| exp0 <| exp1 <| exp2
               EDo bs e           -> mkDo (map f bs) (f e)
               BindNoVar exp0     -> BindVar VWild    <| exp0
               EPiNoVar exp0 exp1 -> EPi VWild        <| exp0 <| exp1
               EBind exp0 exp1    -> appBind          <| exp0 <| exp1
               EBindC exp0 exp1   -> appBindC         <| exp0 <| exp1
-              EOr  exp0 exp1     -> andBool          <| exp0 <| exp1
+              EOr  exp0 exp1     -> orBool           <| exp0 <| exp1
-              EAnd exp0 exp1     -> orBool           <| exp0 <| exp1
+              EAnd exp0 exp1     -> andBool          <| exp0 <| exp1
               EEq  exp0 exp1     -> overlBin "eq"    <| exp0 <| exp1
               ENe  exp0 exp1     -> overlBin "ne"    <| exp0 <| exp1
               ELt  exp0 exp1     -> overlBin "lt"    <| exp0 <| exp1
@@ -457,14 +520,14 @@ appCons e1 e2 = apply (EVar (Ident "Cons")) [EMeta,e1,e2]
 --
 
 andBool :: Exp -> Exp -> Exp
-andBool e1 e2 = ifBool e1 e2 (var "False")
+andBool e1 e2 = ifBool e1 e2 false
 
 orBool :: Exp -> Exp -> Exp
-orBool e1 e2 = ifBool e1 (var "True") e2
+orBool e1 e2 = ifBool e1 true e2
 
 ifBool :: Exp -> Exp -> Exp -> Exp
-ifBool c t e = ECase c [Case (PCons (Ident "True") []) t,
+ifBool c t e = ECase c [Case (PCons (Ident "True") []) gtrue t,
-                        Case (PCons (Ident "False") []) e]
+                        Case (PCons (Ident "False") []) gtrue e]
 
 --
 -- * Substitution
@@ -483,7 +546,7 @@ substs ss = f (Map.fromList ss)
    ELet ds e3 ->
      ELet [LetDef id (f ss e1) (f ss' e2) | LetDef id e1 e2 <- ds] (f ss' e3)
       where ss' = ss `mapMinusSet` letDefBinds ds
-   Case p e -> Case p (f ss' e) where ss' = ss `mapMinusSet` binds p
+   Case p g e -> Case p (f ss' g) (f ss' e) where ss' = ss `mapMinusSet` binds p
    EAbs (VVar id) e -> EAbs (VVar id) (f ss' e) where ss' = Map.delete id ss
    EPi (VVar id) e1 e2 -> 
        EPi (VVar id) (f ss e1) (f ss' e2) where ss' = Map.delete id ss
@@ -497,6 +560,15 @@ substs ss = f (Map.fromList ss)
 var :: String -> Exp
 var s = EVar (Ident s)
 
+true :: Exp
+true = var "True"
+
+false :: Exp
+false = var "False"
+
+gtrue :: Guard
+gtrue = GuardExp true
+
 -- | Apply an expression to a list of arguments.
 apply :: Exp -> [Exp] -> Exp
 apply = foldl EApp
@@ -511,7 +583,8 @@ abstract n f =
 
 -- | Abstract a type over some arguments.
 abstractType :: [Exp] -- ^ argument types
-             -> ([Exp] -> Exp)
+             -> ([Exp] -> Exp) -- ^ function from variable expressions
+                               --   to the expression to return
              -> C Exp
 abstractType ts f = 
     do
@@ -551,7 +624,8 @@ freeVars = f
            (Set.unions (f exp3:map f (letDefRhss defs)) Set.\\ letDefBinds defs)
            :map f (letDefTypes defs)
    ECase exp cases -> f exp `Set.union` 
-                      Set.unions [ f e Set.\\ binds p | Case p e <- cases]
+                      Set.unions [(f g `Set.union` f e) Set.\\ binds p 
+                                      | Case p g e <- cases]
    EAbs (VVar id) exp -> Set.delete id (f exp)
    EPi (VVar id) exp1 exp2 -> f exp1 `Set.union` Set.delete id (f exp2)
    EVar i -> Set.singleton i
@@ -568,7 +642,7 @@ countFreeOccur x = f
   f t = case t of
    ELet defs _ | x `Set.member` letDefBinds defs ->
             sum (map f (letDefTypes defs))
-   Case p e | x `Set.member` binds p -> 0
+   Case p _ _ | x `Set.member` binds p -> 0
    EAbs (VVar id) _ | id == x -> 0
    EPi (VVar id) exp1 _ | id == x -> f exp1
    EVar id | id == x -> 1
@@ -584,11 +658,6 @@ binds = f
                  PVar id -> Set.singleton id 
                  _ -> composOpMonoid f p
 
--- | Checks if a declaration is a value declaration
---   of the given identifier.
-isValueDecl :: Ident -> Decl -> Bool
-isValueDecl x (ValueDecl y _ _) = x == y
-isValueDecl _ _ = False
 
 fromPRec :: [FieldPattern] -> [(Ident,Pattern)]
 fromPRec fps = [ (l,p) | FieldPattern l p <- fps ]

transfer/lib/prelude.tr

@@ -19,6 +19,10 @@ flip _ _ _ f x y = f y x
 compose : (A:Type) -> (B:Type) -> (C:Type) -> (B -> C) -> (A -> B) -> A -> C
 compose _ _ _ f g x = f (g x)
 
+otherwise : Bool
+otherwise = True
+
+
 --
 -- The Integer type
 --
@@ -133,6 +137,11 @@ map : (A:Type) -> (B:Type) -> (A -> B) -> List A -> List B
 map _ _ _ [] = []
 map A B f (x::xs) = f x :: map A B f xs
 
+filter : (A:Type) -> (A -> Bool) -> List A -> List A
+filter _ _ []            = []
+filter A f (x::xs) | f x = x :: filter A f xs
+filter A f (x::xs)       = filter A f xs
+
 append : (A:Type) -> List A -> List A -> List A
 append A xs ys = foldr A (List A) (Cons A) ys xs
 
@@ -165,7 +174,7 @@ data Maybe : Type -> Type where
 	Just : (A : Type) -> A -> Maybe A
 
 -- derive Show Maybe
--- derive Eq Maybe
+derive Eq Maybe
 -- derive Ord Maybe