Transfer: added support for disjunctive patterns.

src/Transfer/Syntax/Abs.hs

@@ -43,6 +43,7 @@ data Tree :: * -> * where
     ValueDecl :: Ident -> [Pattern] -> Exp -> Tree Decl_
     DeriveDecl :: Ident -> Ident -> Tree Decl_
     ConsDecl :: Ident -> Exp -> Tree ConsDecl_
+    POr :: Pattern -> Pattern -> Tree Pattern_
     PConsTop :: Ident -> Pattern -> [Pattern] -> Tree Pattern_
     PCons :: Ident -> [Pattern] -> Tree Pattern_
     PRec :: [FieldPattern] -> Tree Pattern_
@@ -117,6 +118,7 @@ composOpM f t = case t of
     ValueDecl i patterns exp -> return ValueDecl `ap` f i `ap` mapM f patterns `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
+    POr pattern0 pattern1 -> return POr `ap` f pattern0 `ap` f pattern1
     PConsTop i pattern patterns -> return PConsTop `ap` f i `ap` f pattern `ap` mapM f patterns
     PCons i patterns -> return PCons `ap` f i `ap` mapM f patterns
     PRec fieldpatterns -> return PRec `ap` mapM f fieldpatterns
@@ -170,6 +172,7 @@ composOpFold zero combine f t = case t of
     ValueDecl i patterns exp -> f i `combine` foldr combine zero (map f patterns) `combine` f exp
     DeriveDecl i0 i1 -> f i0 `combine` f i1
     ConsDecl i exp -> f i `combine` f exp
+    POr pattern0 pattern1 -> f pattern0 `combine` f pattern1
     PConsTop i pattern patterns -> f i `combine` f pattern `combine` foldr combine zero (map f patterns)
     PCons i patterns -> f i `combine` foldr combine zero (map f patterns)
     PRec fieldpatterns -> foldr combine zero (map f fieldpatterns)
@@ -223,6 +226,7 @@ instance Show (Tree c) where
     ValueDecl i patterns exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . 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
+    POr pattern0 pattern1 -> opar n . showString "POr" . 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
     PCons i patterns -> opar n . showString "PCons" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . cpar n
     PRec fieldpatterns -> opar n . showString "PRec" . showChar ' ' . showsPrec 1 fieldpatterns . cpar n
@@ -288,6 +292,7 @@ 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 (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = i0 == i0_ && i1 == i1_
 johnMajorEq (ConsDecl i exp) (ConsDecl i_ exp_) = i == i_ && exp == exp_
+johnMajorEq (POr pattern0 pattern1) (POr pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_
 johnMajorEq (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = i == i_ && pattern == pattern_ && patterns == patterns_
 johnMajorEq (PCons i patterns) (PCons i_ patterns_) = i == i_ && patterns == patterns_
 johnMajorEq (PRec fieldpatterns) (PRec fieldpatterns_) = fieldpatterns == fieldpatterns_
@@ -352,58 +357,59 @@ instance Ord (Tree c) where
     index (ValueDecl _ _ _) = 4
     index (DeriveDecl _ _) = 5
     index (ConsDecl _ _) = 6
-    index (PConsTop _ _ _) = 7
-    index (PCons _ _) = 8
-    index (PRec _) = 9
-    index (PType ) = 10
-    index (PStr _) = 11
-    index (PInt _) = 12
-    index (PVar _) = 13
-    index (PWild ) = 14
-    index (FieldPattern _ _) = 15
-    index (ELet _ _) = 16
-    index (ECase _ _) = 17
-    index (EIf _ _ _) = 18
-    index (EDo _ _) = 19
-    index (EAbs _ _) = 20
-    index (EPi _ _ _) = 21
-    index (EPiNoVar _ _) = 22
-    index (EBind _ _) = 23
-    index (EBindC _ _) = 24
-    index (EOr _ _) = 25
-    index (EAnd _ _) = 26
-    index (EEq _ _) = 27
-    index (ENe _ _) = 28
-    index (ELt _ _) = 29
-    index (ELe _ _) = 30
-    index (EGt _ _) = 31
-    index (EGe _ _) = 32
-    index (EListCons _ _) = 33
-    index (EAdd _ _) = 34
-    index (ESub _ _) = 35
-    index (EMul _ _) = 36
-    index (EDiv _ _) = 37
-    index (EMod _ _) = 38
-    index (ENeg _) = 39
-    index (EApp _ _) = 40
-    index (EProj _ _) = 41
-    index (ERecType _) = 42
-    index (ERec _) = 43
-    index (EList _) = 44
-    index (EVar _) = 45
-    index (EType ) = 46
-    index (EStr _) = 47
-    index (EInt _) = 48
-    index (EMeta ) = 49
-    index (LetDef _ _ _) = 50
-    index (Case _ _) = 51
-    index (BindVar _ _) = 52
-    index (BindNoVar _) = 53
-    index (VVar _) = 54
-    index (VWild ) = 55
-    index (FieldType _ _) = 56
-    index (FieldValue _ _) = 57
-    index (Ident _) = 58
+    index (POr _ _) = 7
+    index (PConsTop _ _ _) = 8
+    index (PCons _ _) = 9
+    index (PRec _) = 10
+    index (PType ) = 11
+    index (PStr _) = 12
+    index (PInt _) = 13
+    index (PVar _) = 14
+    index (PWild ) = 15
+    index (FieldPattern _ _) = 16
+    index (ELet _ _) = 17
+    index (ECase _ _) = 18
+    index (EIf _ _ _) = 19
+    index (EDo _ _) = 20
+    index (EAbs _ _) = 21
+    index (EPi _ _ _) = 22
+    index (EPiNoVar _ _) = 23
+    index (EBind _ _) = 24
+    index (EBindC _ _) = 25
+    index (EOr _ _) = 26
+    index (EAnd _ _) = 27
+    index (EEq _ _) = 28
+    index (ENe _ _) = 29
+    index (ELt _ _) = 30
+    index (ELe _ _) = 31
+    index (EGt _ _) = 32
+    index (EGe _ _) = 33
+    index (EListCons _ _) = 34
+    index (EAdd _ _) = 35
+    index (ESub _ _) = 36
+    index (EMul _ _) = 37
+    index (EDiv _ _) = 38
+    index (EMod _ _) = 39
+    index (ENeg _) = 40
+    index (EApp _ _) = 41
+    index (EProj _ _) = 42
+    index (ERecType _) = 43
+    index (ERec _) = 44
+    index (EList _) = 45
+    index (EVar _) = 46
+    index (EType ) = 47
+    index (EStr _) = 48
+    index (EInt _) = 49
+    index (EMeta ) = 50
+    index (LetDef _ _ _) = 51
+    index (Case _ _) = 52
+    index (BindVar _ _) = 53
+    index (BindNoVar _) = 54
+    index (VVar _) = 55
+    index (VWild ) = 56
+    index (FieldType _ _) = 57
+    index (FieldValue _ _) = 58
+    index (Ident _) = 59
     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_))
@@ -411,6 +417,7 @@ instance Ord (Tree c) where
     compareSame (ValueDecl i patterns exp) (ValueDecl i_ patterns_ exp_) = mappend (compare i i_) (mappend (compare patterns patterns_) (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 (POr pattern0 pattern1) (POr 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_))
     compareSame (PCons i patterns) (PCons i_ patterns_) = mappend (compare i i_) (compare patterns patterns_)
     compareSame (PRec fieldpatterns) (PRec fieldpatterns_) = compare fieldpatterns fieldpatterns_

src/Transfer/Syntax/Doc.tex

@@ -56,10 +56,10 @@ The symbols used in Syntax are the following: \\
 
 \begin{tabular}{lll}
 {\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{$\backslash$}} \\
+{\symb{{$>$}{$>$}{$=$}}} &{\symb{{$>$}{$>$}}} &{\symb{\&\&}} \\
 {\symb{{$=$}{$=$}}} &{\symb{/{$=$}}} &{\symb{{$<$}}} \\
 {\symb{{$<$}{$=$}}} &{\symb{{$>$}}} &{\symb{{$>$}{$=$}}} \\
 {\symb{::}} &{\symb{{$+$}}} &{\symb{{$-$}}} \\
@@ -115,23 +115,28 @@ All other symbols are terminals.\\
 \end{tabular}\\
 
 \begin{tabular}{lll}
-{\nonterminal{Pattern}} & {\arrow}  &{\nonterminal{Ident}} {\nonterminal{Pattern1}} {\nonterminal{ListPattern}}  \\
+{\nonterminal{Pattern}} & {\arrow}  &{\nonterminal{Pattern1}} {\terminal{{$|$}{$|$}}} {\nonterminal{Pattern}}  \\
  & {\delimit}  &{\nonterminal{Pattern1}}  \\
 \end{tabular}\\
 
 \begin{tabular}{lll}
-{\nonterminal{Pattern1}} & {\arrow}  &{\terminal{(}} {\nonterminal{Ident}} {\nonterminal{ListPattern}} {\terminal{)}}  \\
- & {\delimit}  &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldPattern}} {\terminal{\}}}  \\
+{\nonterminal{Pattern1}} & {\arrow}  &{\nonterminal{Ident}} {\nonterminal{Pattern2}} {\nonterminal{ListPattern}}  \\
+ & {\delimit}  &{\nonterminal{Pattern2}}  \\
+\end{tabular}\\
+
+\begin{tabular}{lll}
+{\nonterminal{Pattern2}} & {\arrow}  &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldPattern}} {\terminal{\}}}  \\
  & {\delimit}  &{\terminal{Type}}  \\
  & {\delimit}  &{\nonterminal{String}}  \\
  & {\delimit}  &{\nonterminal{Integer}}  \\
  & {\delimit}  &{\nonterminal{Ident}}  \\
  & {\delimit}  &{\terminal{\_}}  \\
+ & {\delimit}  &{\terminal{(}} {\nonterminal{Pattern}} {\terminal{)}}  \\
 \end{tabular}\\
 
 \begin{tabular}{lll}
 {\nonterminal{ListPattern}} & {\arrow}  &{\emptyP} \\
- & {\delimit}  &{\nonterminal{Pattern1}} {\nonterminal{ListPattern}}  \\
+ & {\delimit}  &{\nonterminal{Pattern2}} {\nonterminal{ListPattern}}  \\
 \end{tabular}\\
 
 \begin{tabular}{lll}

src/Transfer/Syntax/Lex.x

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

src/Transfer/Syntax/Par.y

@@ -19,6 +19,7 @@ import Transfer.ErrM
  '{' { PT _ (TS "{") }
  '}' { PT _ (TS "}") }
  '=' { PT _ (TS "=") }
+ '||' { PT _ (TS "||") }
  '(' { PT _ (TS "(") }
  ')' { PT _ (TS ")") }
  '_' { PT _ (TS "_") }
@@ -27,7 +28,6 @@ import Transfer.ErrM
  '\\' { PT _ (TS "\\") }
  '>>=' { PT _ (TS ">>=") }
  '>>' { PT _ (TS ">>") }
- '||' { PT _ (TS "||") }
  '&&' { PT _ (TS "&&") }
  '==' { PT _ (TS "==") }
  '/=' { PT _ (TS "/=") }
@@ -112,23 +112,28 @@ ListConsDecl : {- empty -} { [] }
 
 
 Pattern :: { Pattern }
-Pattern : Ident Pattern1 ListPattern { PConsTop $1 $2 (reverse $3) } 
+Pattern : Pattern1 '||' Pattern { POr $1 $3 } 
   | Pattern1 { $1 }
 
 
 Pattern1 :: { Pattern }
-Pattern1 : '(' Ident ListPattern ')' { PCons $2 (reverse $3) } 
-  | 'rec' '{' ListFieldPattern '}' { PRec $3 }
+Pattern1 : Ident Pattern2 ListPattern { PConsTop $1 $2 (reverse $3) } 
+  | Pattern2 { $1 }
+
+
+Pattern2 :: { Pattern }
+Pattern2 : 'rec' '{' ListFieldPattern '}' { PRec $3 } 
   | 'Type' { PType }
   | String { PStr $1 }
   | Integer { PInt $1 }
   | Ident { PVar $1 }
   | '_' { PWild }
+  | '(' Pattern ')' { $2 }
 
 
 ListPattern :: { [Pattern] }
 ListPattern : {- empty -} { [] } 
-  | ListPattern Pattern1 { flip (:) $1 $2 }
+  | ListPattern Pattern2 { flip (:) $1 $2 }
 
 
 FieldPattern :: { FieldPattern }

src/Transfer/Syntax/Print.hs

@@ -87,14 +87,15 @@ instance Print (Tree c) where
     ValueDecl i patterns exp -> prPrec _i 0 (concatD [prt 0 i , prt 0 patterns , 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])
-    PConsTop i pattern patterns -> prPrec _i 0 (concatD [prt 0 i , prt 1 pattern , prt 0 patterns])
-    PCons i patterns -> prPrec _i 1 (concatD [doc (showString "(") , prt 0 i , prt 0 patterns , doc (showString ")")])
-    PRec fieldpatterns -> prPrec _i 1 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldpatterns , doc (showString "}")])
-    PType  -> prPrec _i 1 (concatD [doc (showString "Type")])
-    PStr str -> prPrec _i 1 (concatD [prt 0 str])
-    PInt n -> prPrec _i 1 (concatD [prt 0 n])
-    PVar i -> prPrec _i 1 (concatD [prt 0 i])
-    PWild  -> prPrec _i 1 (concatD [doc (showString "_")])
+    POr pattern0 pattern1 -> prPrec _i 0 (concatD [prt 1 pattern0 , doc (showString "||") , prt 0 pattern1])
+    PConsTop i pattern patterns -> prPrec _i 1 (concatD [prt 0 i , prt 2 pattern , prt 0 patterns])
+    PCons i patterns -> prPrec _i 2 (concatD [doc (showString "(") , prt 0 i , prt 0 patterns , doc (showString ")")])
+    PRec fieldpatterns -> prPrec _i 2 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldpatterns , doc (showString "}")])
+    PType  -> prPrec _i 2 (concatD [doc (showString "Type")])
+    PStr str -> prPrec _i 2 (concatD [prt 0 str])
+    PInt n -> prPrec _i 2 (concatD [prt 0 n])
+    PVar i -> prPrec _i 2 (concatD [prt 0 i])
+    PWild  -> prPrec _i 2 (concatD [doc (showString "_")])
     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 "}")])
@@ -158,7 +159,7 @@ instance Print [ConsDecl] where
 instance Print [Pattern] where
   prt _ es = case es of
    [] -> (concatD [])
-   x:xs -> (concatD [prt 1 x , prt 0 xs])
+   x:xs -> (concatD [prt 2 x , prt 0 xs])
 instance Print [FieldPattern] where
   prt _ es = case es of
    [] -> (concatD [])

src/Transfer/Syntax/Skel.hs

@@ -18,6 +18,7 @@ transTree t = case t of
   ValueDecl i patterns exp -> failure t
   DeriveDecl i0 i1 -> failure t
   ConsDecl i exp -> failure t
+  POr pattern0 pattern1 -> failure t
   PConsTop i pattern patterns -> failure t
   PCons i patterns -> failure t
   PRec fieldpatterns -> failure t
@@ -92,6 +93,7 @@ transConsDecl t = case t of
 
 transPattern :: Pattern -> Result
 transPattern t = case t of
+  POr pattern0 pattern1 -> failure t
   PConsTop i pattern patterns -> failure t
   PCons i patterns -> failure t
   PRec fieldpatterns -> failure t

src/Transfer/Syntax/Syntax.cf

@@ -21,27 +21,33 @@ separator Decl ";" ;
 ConsDecl. ConsDecl ::= Ident ":" Exp ;
 separator ConsDecl ";" ;
 
+-- Disjunctive patterns.
+POr.      Pattern ::= Pattern1 "||" Pattern ;
+
 -- Hack: constructor applied to at least one pattern
 -- this is to separate it from variable patterns
-PConsTop. Pattern ::= Ident Pattern1 [Pattern] ;
-_.        Pattern ::= Pattern1 ;
--- Constructor pattern with parantheses
-PCons.    Pattern1 ::= "(" Ident [Pattern] ")" ;
+PConsTop. Pattern1 ::= Ident Pattern2 [Pattern] ;
+
+-- Real constructor pattern
+internal PCons.    Pattern2 ::= "(" Ident [Pattern] ")" ;
+
 -- Record patterns
-PRec.     Pattern1 ::= "rec" "{" [FieldPattern] "}";
+PRec.     Pattern2 ::= "rec" "{" [FieldPattern] "}";
 -- The pattern matching the Type constant
-PType.    Pattern1 ::= "Type" ;
+PType.    Pattern2 ::= "Type" ;
 -- String literal patterns
-PStr.     Pattern1 ::= String ;
+PStr.     Pattern2 ::= String ;
 -- Integer literal patterns
-PInt.     Pattern1 ::= Integer ;
+PInt.     Pattern2 ::= Integer ;
 -- Variable patterns
-PVar.     Pattern1 ::= Ident ;
+PVar.     Pattern2 ::= Ident ;
 -- Wild card patterns
-PWild.    Pattern1 ::= "_" ;
+PWild.    Pattern2 ::= "_" ;
+
+coercions Pattern 2 ;
 
 [].  [Pattern] ::= ;
-(:). [Pattern] ::= Pattern1 [Pattern] ;
+(:). [Pattern] ::= Pattern2 [Pattern] ;
 
 FieldPattern. FieldPattern ::= Ident "=" Pattern ;
 separator FieldPattern ";" ;

src/Transfer/SyntaxToCore.hs

@@ -33,6 +33,7 @@ declsToCore_ =     desugar
                >>> deriveDecls
                >>> replaceCons 
                >>> compilePattDecls 
+               >>> expandOrPatts
                >>> optimize
 
 optimize :: [Decl] -> C [Decl]
@@ -343,6 +344,34 @@ onlyBindsFieldToVariable _ _ = False
 fieldPatternVars :: Ident -> [FieldPattern] -> [Ident]
 fieldPatternVars f fps = [p | FieldPattern f' (PVar p) <- fps, f == f']
 
+--
+-- * Expand disjunctive patterns.
+--
+
+expandOrPatts :: [Decl] -> C [Decl]
+expandOrPatts = return . map f
+ where
+ f :: Tree a -> Tree a
+ f x = case x of
+              ECase e cs -> ECase (f e) (concatMap (expandCase . f) cs)
+              _          -> composOp f x
+
+expandCase :: Case -> [Case]
+expandCase (Case p e) = [ Case p' e | p' <- expandPatt p ]
+
+expandPatt :: Pattern -> [Pattern]
+expandPatt p = case p of
+                    POr p1 p2  -> expandPatt p1 ++ expandPatt p2
+                    PCons i ps -> map (PCons i) $ expandPatts ps
+                    PRec fps   -> let (fs,ps) = unzip $ fromPRec fps
+                                      fpss = map (zip fs) (expandPatts ps)
+                                   in map (PRec . toPRec) fpss
+                    _ -> [p]
+
+expandPatts :: [Pattern] -> [[Pattern]]
+expandPatts [] = [[]]
+expandPatts (p:ps) = [ p':ps' | p' <- expandPatt p, ps' <- expandPatts ps]
+
 --
 -- * Remove simple syntactic sugar.
 --
@@ -549,6 +578,12 @@ isValueDecl :: Ident -> Decl -> Bool
 isValueDecl x (ValueDecl y _ _) = x == y
 isValueDecl _ _ = False
 
+fromPRec :: [FieldPattern] -> [(Ident,Pattern)]
+fromPRec fps = [ (l,p) | FieldPattern l p <- fps ]
+
+toPRec :: [(Ident,Pattern)] -> [FieldPattern]
+toPRec = map (uncurry FieldPattern)
+
 --
 -- * Data types
 --

transfer/README

@@ -0,0 +1,23 @@
+Some features of the Transfer language:
+
+* Purely functional
+* Dependent types
+* Eager evaluation
+* Generalized algebraic datatypes
+* Metavariables
+* Records with subtyping
+* Overloading by explicit dictionary passing
+* Pattern matching by case expressions
+
+Additional features in the front-end language:
+
+* Disjunctive patterns
+* do-notation
+* Hidden arguments (not implemented yet)
+* Automatic derivation of some operations on user-defined GADTs:
+  - Compositional maps and folds
+  - Equality
+  - Ordering
+  - Showing
+* Pattern equations
+* Operator syntax for common functions, most are overloaded

transfer/examples/disjpatt.tr

@@ -0,0 +1,24 @@
+data Cat : Type where
+    VarOrWild : Cat
+    Exp : Cat
+    Ident : Cat
+
+data Tree : Cat -> Type where
+    EAbs : Tree VarOrWild -> Tree Exp -> Tree Exp
+    EPi : Tree VarOrWild -> Tree Exp -> Tree Exp -> Tree Exp
+    EVar : Tree Ident -> Tree Exp
+    EType : Tree Exp
+    EStr : String -> Tree Exp
+    EInt : Integer -> Tree Exp
+    VVar : Tree Ident -> Tree VarOrWild
+    VWild : Tree VarOrWild
+    Ident : String -> Tree Ident
+
+
+f e = case e of
+       EAbs (VWild || VVar _) e || EPi (VWild || VVar _) _ e -> doSomething e
+       Ident i -> Ident i
+       _ -> catchAll
+
+
+g (Ident x || EAbs (VWild || VVar _) t e) = x e