msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Transfer added guards and Eq derivation.

Browse Source
This commit is contained in:
bringert
2005-12-02 18:33:08 +00:00
parent 53a2f8383c
commit ece605f887
21 changed files with 1320 additions and 1168 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
src/Transfer/Core/Abs.hs
View File

@@ -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 (FieldValue _ _) = 30
index (Case _ _) = 31
index (Case _ _ _) = 29
index (FieldType _ _) = 30
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

7
src/Transfer/Core/Core.cf
View File

@@ -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 | '_' | '\'')*) ;

24
src/Transfer/Core/Doc.tex
View File

@@ -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}

2
src/Transfer/Core/Lex.hs
View File

File diff suppressed because one or more lines are too long

2
src/Transfer/Core/Lex.x
View File

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

347
src/Transfer/Core/Par.hs
View File

@@ -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
happyReduction_39 (happy_x_4 `HappyStk`
happyReduce_39 = happyReduce 5# 18# happyReduction_39
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
happyReduction_40 (happy_x_7 `HappyStk`
happyReduce_44 = happyReduce 7# 20# happyReduction_44
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
happyReduction_46 (happy_x_4 `HappyStk`
happy_x_3 `HappyStk`
happy_x_2 `HappyStk`
happy_x_1 `HappyStk`
happyRest)
= case happyOut28 happy_x_3 of { happy_var_3 ->
happyReduce_46 = happySpecReduce_2 21# happyReduction_46
happyReduction_46 happy_x_2
happy_x_1
= case happyOut26 happy_x_1 of { happy_var_1 ->
case happyOut27 happy_x_2 of { happy_var_2 ->
happyIn26
(ERecType happy_var_3
) `HappyStk` happyRest}
(EApp happy_var_1 happy_var_2
)}}
happyReduce_47 = happyReduce 4# 21# happyReduction_47
happyReduction_47 (happy_x_4 `HappyStk`
happyReduce_47 = happySpecReduce_1 21# happyReduction_47
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
happyReduction_48 happy_x_1
happyReduce_52 = happySpecReduce_1 23# happyReduction_52
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
happyReduction_49 happy_x_1
= happyIn26
happyReduce_53 = happySpecReduce_1 23# happyReduction_53
happyReduction_53 happy_x_1
= happyIn28
(EType
)
happyReduce_50 = happySpecReduce_1 21# happyReduction_50
happyReduction_50 happy_x_1
happyReduce_54 = happySpecReduce_1 23# happyReduction_54
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
happyReduction_51 happy_x_1
happyReduce_55 = happySpecReduce_1 23# happyReduction_55
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
happyReduction_52 happy_x_1
happyReduce_56 = happySpecReduce_1 23# happyReduction_56
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 happyOut28 happy_x_3 of { happy_var_3 ->
= case happyOut20 happy_x_2 of { happy_var_2 ->
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
happyReduction_63 happy_x_1
= 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
happyReduce_63 = happySpecReduce_3 26# happyReduction_63
happyReduction_63 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
(Case happy_var_1 happy_var_3
happyIn31
(FieldValue happy_var_1 happy_var_3
)}}
happyReduce_65 = happySpecReduce_0 28# happyReduction_65
happyReduction_65 = happyIn33
happyReduce_64 = happySpecReduce_0 27# happyReduction_64
happyReduction_64 = happyIn32
([]
)
happyReduce_66 = happySpecReduce_1 28# happyReduction_66
happyReduction_66 happy_x_1
= case happyOut32 happy_x_1 of { happy_var_1 ->
happyIn33
happyReduce_65 = happySpecReduce_1 27# happyReduction_65
happyReduction_65 happy_x_1
= case happyOut31 happy_x_1 of { happy_var_1 ->
happyIn32
((:[]) happy_var_1
)}
happyReduce_67 = happySpecReduce_3 28# happyReduction_67
happyReduction_67 happy_x_3
happyReduce_66 = happySpecReduce_3 27# happyReduction_66
happyReduction_66 happy_x_3
happy_x_2
happy_x_1
= case happyOut32 happy_x_1 of { happy_var_1 ->
case happyOut33 happy_x_3 of { happy_var_3 ->
happyIn33
= case happyOut31 happy_x_1 of { happy_var_1 ->
case happyOut32 happy_x_3 of { happy_var_3 ->
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 "Type") -> cont 12#;
PT _ (TS "case") -> cont 13#;
PT _ (TS "data") -> cont 14#;
PT _ (TS "in") -> cont 15#;
PT _ (TS "let") -> cont 16#;
PT _ (TS "of") -> cont 17#;
PT _ (TS "rec") -> cont 18#;
PT _ (TS "sig") -> cont 19#;
PT _ (TS "where") -> cont 20#;
PT _ (TL happy_dollar_dollar) -> cont 21#;
PT _ (TI happy_dollar_dollar) -> cont 22#;
PT _ (TD happy_dollar_dollar) -> cont 23#;
PT _ (T_TMeta happy_dollar_dollar) -> cont 24#;
PT _ (T_CIdent happy_dollar_dollar) -> cont 25#;
_ -> cont 26#;
PT _ (TS "\\") -> cont 11#;
PT _ (TS ".") -> cont 12#;
PT _ (TS "Type") -> cont 13#;
PT _ (TS "case") -> cont 14#;
PT _ (TS "data") -> cont 15#;
PT _ (TS "in") -> cont 16#;
PT _ (TS "let") -> cont 17#;
PT _ (TS "of") -> cont 18#;
PT _ (TS "rec") -> cont 19#;
PT _ (TS "sig") -> cont 20#;
PT _ (TS "where") -> cont 21#;
PT _ (TL happy_dollar_dollar) -> cont 22#;
PT _ (TI happy_dollar_dollar) -> cont 23#;
PT _ (TD happy_dollar_dollar) -> cont 24#;
PT _ (T_TMeta happy_dollar_dollar) -> cont 25#;
PT _ (T_CIdent happy_dollar_dollar) -> cont 26#;
_ -> cont 27#;
_ -> happyError' (tk:tks)
}

23
src/Transfer/Core/Par.y
View File

@@ -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 }
{

12
src/Transfer/Core/Print.hs
View File

@@ -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])

10
src/Transfer/Core/Skel.hs
View File

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

20
src/Transfer/Interpreter.hs
View File

@@ -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 _ [] = Nothing
firstMatch v (Case p e:cs) = case match p v of
Nothing -> firstMatch v cs
Just env -> Just (e,env)
firstMatch :: Env -> Value -> [Case] -> Maybe (Exp,Env)
firstMatch _ _ [] = Nothing
firstMatch env v (Case p g e:cs) =
case match p v of
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)]

220
src/Transfer/Syntax/Abs.hs
View File

@@ -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 (PListCons _ _) = 8
index (PConsTop _ _ _) = 9
index (PCons _ _) = 10
index (PRec _) = 11
index (PList _) = 12
index (PType ) = 13
index (PStr _) = 14
index (PInt _) = 15
index (PVar _) = 16
index (PWild ) = 17
index (PListElem _) = 18
index (FieldPattern _ _) = 19
index (ELet _ _) = 20
index (ECase _ _) = 21
index (EIf _ _ _) = 22
index (EDo _ _) = 23
index (GuardExp _) = 7
index (GuardNo ) = 8
index (POr _ _) = 9
index (PListCons _ _) = 10
index (PConsTop _ _ _) = 11
index (PCons _ _) = 12
index (PRec _) = 13
index (PList _) = 14
index (PType ) = 15
index (PStr _) = 16
index (PInt _) = 17
index (PVar _) = 18
index (PWild ) = 19
index (PListElem _) = 20
index (FieldPattern _ _) = 21
index (EPi _ _ _) = 22
index (EPiNoVar _ _) = 23
index (EAbs _ _) = 24
index (EPi _ _ _) = 25
index (EPiNoVar _ _) = 26
index (EBind _ _) = 27
index (EBindC _ _) = 28
index (EOr _ _) = 29
index (EAnd _ _) = 30
index (EEq _ _) = 31
index (ENe _ _) = 32
index (ELt _ _) = 33
index (ELe _ _) = 34
index (EGt _ _) = 35
index (EGe _ _) = 36
index (EListCons _ _) = 37
index (EAdd _ _) = 38
index (ESub _ _) = 39
index (EMul _ _) = 40
index (EDiv _ _) = 41
index (EMod _ _) = 42
index (ENeg _) = 43
index (EApp _ _) = 44
index (EProj _ _) = 45
index (ERecType _) = 46
index (ERec _) = 47
index (EList _) = 48
index (EVar _) = 49
index (EType ) = 50
index (EStr _) = 51
index (EInteger _) = 52
index (EDouble _) = 53
index (EMeta ) = 54
index (LetDef _ _ _) = 55
index (Case _ _) = 56
index (BindVar _ _) = 57
index (BindNoVar _) = 58
index (VVar _) = 59
index (VWild ) = 60
index (FieldType _ _) = 61
index (FieldValue _ _) = 62
index (Ident _) = 63
index (ELet _ _) = 25
index (ECase _ _) = 26
index (EIf _ _ _) = 27
index (EDo _ _) = 28
index (EBind _ _) = 29
index (EBindC _ _) = 30
index (EOr _ _) = 31
index (EAnd _ _) = 32
index (EEq _ _) = 33
index (ENe _ _) = 34
index (ELt _ _) = 35
index (ELe _ _) = 36
index (EGt _ _) = 37
index (EGe _ _) = 38
index (EListCons _ _) = 39
index (EAdd _ _) = 40
index (ESub _ _) = 41
index (EMul _ _) = 42
index (EDiv _ _) = 43
index (EMod _ _) = 44
index (ENeg _) = 45
index (EApp _ _) = 46
index (EProj _ _) = 47
index (ERecType _) = 48
index (ERec _) = 49
index (EList _) = 50
index (EVar _) = 51
index (EType ) = 52
index (EStr _) = 53
index (EInteger _) = 54
index (EDouble _) = 55
index (EMeta ) = 56
index (VVar _) = 57
index (VWild ) = 58
index (LetDef _ _ _) = 59
index (Case _ _ _) = 60
index (BindVar _ _) = 61
index (BindNoVar _) = 62
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_

63
src/Transfer/Syntax/Doc.tex
View File

@@ -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{$\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{$\backslash$}} &{\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}} \\
& {\delimit} &{\terminal{case}} {\nonterminal{Exp}} {\terminal{of}} {\terminal{\{}} {\nonterminal{ListCase}} {\terminal{\}}} \\
& {\delimit} &{\terminal{if}} {\nonterminal{Exp}} {\terminal{then}} {\nonterminal{Exp}} {\terminal{else}} {\nonterminal{Exp}} \\
& {\delimit} &{\terminal{do}} {\terminal{\{}} {\nonterminal{ListBind}} {\nonterminal{Exp}} {\terminal{\}}} \\
{\nonterminal{Exp}} & {\arrow} &{\terminal{(}} {\nonterminal{VarOrWild}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{)}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\
& {\delimit} &{\nonterminal{Exp1}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\
& {\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}

8
src/Transfer/Syntax/Lex.hs
View File

File diff suppressed because one or more lines are too long

2
src/Transfer/Syntax/Lex.x
View File

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

1385
src/Transfer/Syntax/Par.hs
View File

File diff suppressed because one or more lines are too long

48
src/Transfer/Syntax/Par.y
View File

@@ -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 }
| 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
| 'if' Exp 'then' Exp 'else' Exp { EIf $2 $4 $6 }
| 'do' '{' ListBind Exp '}' { EDo (reverse $3) $4 }
Exp : '(' VarOrWild ':' Exp ')' '->' Exp { EPi $2 $4 $7 }
| Exp1 '->' Exp { EPiNoVar $1 $3 }
| 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 }
Exp1 : Exp2 { $1 }
Exp2 :: { Exp }
Exp2 : Exp3 { $1 }
ListExp :: { [Exp] }

26
src/Transfer/Syntax/Print.hs
View File

@@ -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])
ECase exp cases -> prPrec _i 0 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
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])
EDo binds exp -> prPrec _i 0 (concatD [doc (showString "do") , doc (showString "{") , prt 0 binds , prt 0 exp , doc (showString "}")])
EAbs varorwild exp -> prPrec _i 2 (concatD [doc (showString "\\") , prt 0 varorwild , doc (showString "->") , prt 0 exp])
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])
EPiNoVar exp0 exp1 -> prPrec _i 2 (concatD [prt 3 exp0 , doc (showString "->") , prt 0 exp1])
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])
EPiNoVar exp0 exp1 -> prPrec _i 0 (concatD [prt 1 exp0 , doc (showString "->") , prt 0 exp1])
EAbs varorwild exp -> prPrec _i 1 (concatD [doc (showString "\\") , prt 0 varorwild , doc (showString "->") , prt 1 exp])
ELet letdefs exp -> prPrec _i 1 (concatD [doc (showString "let") , doc (showString "{") , prt 0 letdefs , doc (showString "}") , doc (showString "in") , prt 1 exp])
ECase exp cases -> prPrec _i 1 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
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])
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))

43
src/Transfer/Syntax/Skel.hs
View File

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

38
src/Transfer/Syntax/Syntax.cf
View File

@@ -12,15 +12,18 @@ Module. Module ::= [Import] [Decl] ;
Import. Import ::= "import" Ident ;
separator Import ";" ;
DataDecl. Decl ::= "data" Ident ":" Exp "where" "{" [ConsDecl] "}" ;
TypeDecl. Decl ::= Ident ":" Exp ;
ValueDecl. Decl ::= Ident [Pattern] "=" Exp ;
DeriveDecl. Decl ::= "derive" Ident Ident ;
DataDecl. Decl ::= "data" Ident ":" Exp "where" "{" [ConsDecl] "}" ;
TypeDecl. Decl ::= Ident ":" 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. Exp ::= "case" Exp "of" "{" [Case] "}" ;
Case. Case ::= Pattern "->" Exp ;
ECase. Exp1 ::= "case" Exp "of" "{" [Case] "}" ;
Case. Case ::= Pattern Guard "->" Exp ;
separator Case ";" ;
EIf. Exp ::= "if" Exp "then" Exp "else" Exp ;
EDo. Exp ::= "do" "{" [Bind] Exp "}" ;
EIf. Exp1 ::= "if" Exp "then" Exp "else" Exp1 ;
EDo. Exp1 ::= "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 ;

175
src/Transfer/SyntaxToCore.hs
View File

@@ -28,11 +28,11 @@ declsToCore :: [Decl] -> [Decl]
declsToCore m = evalState (declsToCore_ m) newState
declsToCore_ :: [Decl] -> C [Decl]
declsToCore_ = desugar
>>> numberMetas
>>> deriveDecls
>>> replaceCons
declsToCore_ = deriveDecls
>>> desugar
>>> 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
-- function, and produce a single declaration.
-- | Checks if a declaration is a value 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 _:_)
= do let cs = [ (ps,rhs) | ValueDecl _ ps rhs <- ds ]
(pss,rhss) = unzip cs
mergeDecls ds@(ValueDecl x p _ _:_)
= do let cs = [ (ps,g,rhs) | ValueDecl _ ps g rhs <- ds ]
(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]
| x' == x && not (x `isFreeIn` e)
ECase (EVar x') [Case (PVar y) g 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 ->
let e' = f e
p' = f (removeUnusedVarPatts (freeVars e') p)
in Case p' e'
Case p (GuardExp g) e ->
let g' = f g
e' = f 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 ])
-- for all fields in record matching where all patterns just
-> f (ECase e [ Case p g r | Case (PRec [FieldPattern _ p]) g r <- cs ])
-- 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)
g (f:fs) xs = let (fs',xs') = g fs xs in (f:fs',xs')
g [] xs = ([],xs)
inlineField f v (Case (PRec fps) e) =
= h fs (map (inlineField f v) xs)
h (f:fs) xs = let (fs',xs') = h fs xs in (f:fs',xs')
h [] xs = ([],xs)
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)
(fs',cs') = g fs cs
in Case p' (GuardExp (substs ss g)) (substs ss e)
(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
EAnd exp0 exp1 -> orBool <| exp0 <| exp1
EOr 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,
Case (PCons (Ident "False") []) e]
ifBool c t e = ECase c [Case (PCons (Ident "True") []) gtrue t,
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 ]

11
transfer/lib/prelude.tr
View File

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