regex patterns for tokens

src/GF/Compile/CheckGrammar.hs

@@ -512,6 +512,10 @@ inferLType gr trm = case trm of
      PString _ -> True
      PInt _ -> True
      PFloat _ -> True
+     PSeq p q -> isConstPatt p && isConstPatt q
+     PAlt p q -> isConstPatt p && isConstPatt q
+     PRep p -> isConstPatt p
+     PAs _ p -> isConstPatt p
      _ -> False
 
    inferPatt p = case p of
@@ -664,7 +668,7 @@ checkLType env trm typ0 = do
 pattContext :: LTEnv -> Type -> Patt -> Check Context
 pattContext env typ p = case p of
   PV x -> return [(x,typ)]
-  PP q c ps | q /= cPredef || prt c == "CC" -> do ---- why this /=? AR 6/1/2006
+  PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
     t <- checkErr $ lookupResType cnc q c
     (cont,v) <- checkErr $ typeFormCnc t
     checkCond ("wrong number of arguments for constructor in" +++ prt p) 
@@ -683,7 +687,21 @@ pattContext env typ p = case p of
     checkEqLType env typ t (patt2term p')
     pattContext env typ p'
 
-  _ -> return [] ----
+  PAs x p -> do
+    g <- pattContext env typ p
+    return $ (x,typ):g
+
+  PAlt p q -> do
+    g1 <- pattContext env typ p
+    g2 <- pattContext env typ q
+    return $ filter (flip elem g1) g2 -- must be in both
+  PSeq p q -> do
+    g1 <- pattContext env typ p
+    g2 <- pattContext env typ q
+    return $ g1 ++ g2
+  PRep p -> pattContext env typeStr p
+
+  _ -> return [] ---- check types!
  where 
    cnc = env
 

src/GF/Compile/Rename.hs

@@ -241,6 +241,24 @@ renamePattern env patt = case patt of
     let (ps',vs') = unzip psvss
     return (PR (zip ls ps'), concat vs') 
 
+  PAlt p q -> do
+    (p',vs) <- renp p
+    (q',ws) <- renp q
+    return (PAlt p' q', vs ++ ws)
+
+  PSeq p q -> do
+    (p',vs) <- renp p
+    (q',ws) <- renp q
+    return (PSeq p' q', vs ++ ws)
+
+  PRep p -> do
+    (p',vs) <- renp p
+    return (PRep p', vs)
+
+  PAs x p -> do
+    (p',vs) <- renp p
+    return (PAs x p', x:vs)
+
   _ -> return (patt,[])
 
  where 

src/GF/Grammar/Compute.hs

@@ -304,6 +304,13 @@ computeTermOpt rec gr = comp where
        PP _ _ ps -> concatMap contP ps
        PT _ p -> contP p
        PR rs -> concatMap (contP . snd) rs
+
+       PAs x p -> (x,Vr x) : contP p
+
+       PSeq p q -> concatMap contP [p,q]
+       PAlt p q -> concatMap contP [p,q]
+       PRep p   -> contP p
+
        _ -> []
 
      prawitz g i f cs e = do

src/GF/Grammar/Grammar.hs

@@ -171,6 +171,14 @@ data Patt =
  | PInt    Integer        -- ^ integer literal pattern: @12@    -- only abstract
  | PFloat Double          -- ^ float literal pattern: @1.2@    -- only abstract
  | PT Type Patt           -- ^ type-annotated pattern
+
+ | PAs Ident Patt         -- ^ as-pattern: x@p
+
+ -- regular expression patterns
+ | PAlt Patt Patt         -- ^ disjunctive pattern: p1 | p2
+ | PSeq Patt Patt         -- ^ sequence of token parts
+ | PRep Patt              -- ^ repetition of token part
+
   deriving (Read, Show, Eq, Ord)
 
 -- | to guide computation and type checking of tables

src/GF/Grammar/Macros.hs

@@ -504,6 +504,24 @@ term2patt trm = case termForm trm of
   Ok ([],EInt i,[]) -> return $ PInt i
   Ok ([],EFloat i,[]) -> return $ PFloat i
   Ok ([],K s,   []) -> return $ PString s
+
+--- encodings due to excessive use of term-patt convs. AR 7/1/2005
+  Ok ([], Cn (IC "@"), [Vr a,b]) -> do
+    b' <- term2patt b
+    return (PAs a b')
+  Ok ([], Cn (IC "*"), [a]) -> do
+    a' <- term2patt a
+    return (PRep a')
+  Ok ([], Cn (IC "+"), [a,b]) -> do
+    a' <- term2patt a
+    b' <- term2patt b
+    return (PSeq a' b')
+  Ok ([], Cn (IC "|"), [a,b]) -> do
+    a' <- term2patt a
+    b' <- term2patt b
+    return (PAlt a' b')
+
+
   _ -> prtBad "no pattern corresponds to term" trm
 
 patt2term :: Patt -> Term
@@ -518,6 +536,12 @@ patt2term pt = case pt of
   PFloat i  -> EFloat i
   PString s -> K s 
 
+  PAs x p   -> appc "@" [Vr x, patt2term p]            --- an encoding
+  PSeq a b  -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
+  PAlt a b  -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
+  PRep a    -> appc "*" [(patt2term a)]                --- an encoding
+
+
 redirectTerm :: Ident -> Term -> Term
 redirectTerm n t = case t of
   QC _ f -> QC n f

src/GF/Grammar/PatternMatch.hs

@@ -67,11 +67,6 @@ tryMatch (p,t) = do
          do matches <- mapM tryMatch (zip pp tt)
             return (concat matches)
 
-      (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
-         let cuts = [splitAt n s | n <- [0 .. length s]] 
-         matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
-         return (concat matches)
-
       (PP q p pp, ([], QC r f, tt)) | 
             -- q `eqStrIdent` r &&  --- not for inherited AR 10/10/2005
             p `eqStrIdent` f && length pp == length tt ->
@@ -91,6 +86,24 @@ tryMatch (p,t) = do
             return (concat matches)
       (PT _ p',_) -> trym p' t'
       (_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
+
+--      (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
+
+      (PAs x p',_) -> do
+         subst <- trym p' t'
+         return $ (x,t) : subst
+
+      (PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t']
+
+      (PSeq p1 p2, ([],K s, [])) -> do
+         let cuts = [splitAt n s | n <- [0 .. length s]] 
+         matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
+         return (concat matches)
+
+      (PRep p1, ([],K s, [])) -> checks [
+        trym (foldr (const (PSeq p1)) (PString "") [0..n]) t' | n <- [1 .. length s]
+        ]
+
       _ -> prtBad "no match in case expr for" t
   
 isInConstantForm :: Term -> Bool

src/GF/Grammar/Refresh.hs

@@ -71,6 +71,13 @@ refreshPatt p = case p of
   PP q c ps -> liftM (PP q c) (mapM refreshPatt ps)
   PR r    -> liftM PR     (mapPairsM refreshPatt r)
   PT t p' -> liftM2 PT    (refresh t) (refreshPatt p')
+
+  PAs x p'   -> liftM2 PAs     (refVar x) (refreshPatt p')
+
+  PSeq p' q' -> liftM2 PSeq    (refreshPatt p') (refreshPatt q')
+  PAlt p' q' -> liftM2 PAlt    (refreshPatt p') (refreshPatt q')
+  PRep p'    -> liftM  PRep    (refreshPatt p')
+
   _ -> return p
 
 refreshRecord r = case r of

src/GF/Source/AbsGF.hs

@@ -221,6 +221,9 @@ data Patt =
  | PC Ident [Patt]
  | PQC Ident Ident [Patt]
  | PDisj Patt Patt
+ | PSeq Patt Patt
+ | PRep Patt
+ | PAs Ident Patt
   deriving (Eq,Ord,Show)
 
 data PattAss =

src/GF/Source/GF.cf

@@ -200,7 +200,7 @@ EEqs.      Exp  ::= "fn" "{" [Equation] "}" ;
 
 EExample.  Exp  ::= "in" Exp5 String ;
 
-coercions Exp 4 ;
+coercions Exp 6 ;
 
 separator Exp ";" ; -- in variants
 
@@ -222,6 +222,9 @@ PTup.   Patt2  ::= "<" [PattTupleComp] ">" ;
 PC.     Patt1  ::= Ident [Patt] ;
 PQC.    Patt1  ::= Ident "." Ident [Patt] ;
 PDisj.  Patt   ::= Patt "|" Patt1 ;
+PSeq.   Patt   ::= Patt "+" Patt1 ;
+PRep.   Patt1  ::= Patt2 "*" ;
+PAs.    Patt1  ::= Ident "@" Patt2 ;
 
 coercions Patt 2 ;
 

src/GF/Source/GrammarToSource.hs

@@ -197,6 +197,12 @@ trp p = case p of
     PFloat i -> P.PFloat i
     PT t p -> trp p ---- prParenth (prt p +++ ":" +++ prt t)
 
+    PAs  x p -> P.PAs (tri x) (trp p)
+
+    PAlt p q -> P.PDisj (trp p) (trp q)
+    PSeq p q -> P.PSeq (trp p) (trp q)
+    PRep p   -> P.PRep (trp p)
+
 
 trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
   where 

src/GF/Source/LexGF.x

@@ -1,10 +1,10 @@
 -- -*- haskell -*-
 -- This Alex file was machine-generated by the BNF converter
 {
-module GF.Source.LexGF where -- H
+module LexGF where
 
-import GF.Data.ErrM          -- H
+import ErrM
-import GF.Data.SharedString  -- H
+import SharedString
 }
 
 
@@ -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
@@ -30,7 +30,7 @@ $l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
 \" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
 
 $d+      { tok (\p s -> PT p (TI $ share s))    }
-
+$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
 
 {
 

src/GF/Source/ParGF.y

@@ -1,10 +1,9 @@
 -- This Happy file was machine-generated by the BNF converter
 {
-module GF.Source.ParGF where -- H
+module ParGF where
-import GF.Source.AbsGF       -- H
+import AbsGF
-import GF.Source.LexGF       -- H
+import LexGF
-import GF.Infra.Ident        -- H
+import ErrM
-import GF.Data.ErrM          -- H
 }
 
 %name pGrammar Grammar
@@ -29,6 +28,7 @@ import GF.Data.ErrM          -- H
  ',' { PT _ (TS ",") }
  '[' { PT _ (TS "[") }
  ']' { PT _ (TS "]") }
+ '-' { PT _ (TS "-") }
  '.' { PT _ (TS ".") }
  '|' { PT _ (TS "|") }
  '%' { PT _ (TS "%") }
@@ -38,14 +38,13 @@ import GF.Data.ErrM          -- H
  '@' { PT _ (TS "@") }
  '!' { PT _ (TS "!") }
  '*' { PT _ (TS "*") }
+ '+' { PT _ (TS "+") }
+ '++' { PT _ (TS "++") }
  '\\' { PT _ (TS "\\") }
  '=>' { PT _ (TS "=>") }
- '++' { PT _ (TS "++") }
- '+' { PT _ (TS "+") }
  '_' { PT _ (TS "_") }
  '$' { PT _ (TS "$") }
  '/' { PT _ (TS "/") }
- '-' { PT _ (TS "-") }
  'Lin' { PT _ (TS "Lin") }
  'PType' { PT _ (TS "PType") }
  'Str' { PT _ (TS "Str") }
@@ -96,15 +95,17 @@ import GF.Data.ErrM          -- H
 L_ident  { PT _ (TV $$) }
 L_integ  { PT _ (TI $$) }
 L_quoted { PT _ (TL $$) }
+L_doubl  { PT _ (TD $$) }
 L_LString { PT _ (T_LString $$) }
 L_err    { _ }
 
 
 %%
 
-Ident   :: { Ident }   : L_ident  { identC $1 } -- H
+Ident   :: { Ident }   : L_ident  { Ident $1 }
 Integer :: { Integer } : L_integ  { (read $1) :: Integer }
 String  :: { String }  : L_quoted { $1 }
+Double  :: { Double }  : L_doubl  { (read $1) :: Double }
 LString    :: { LString} : L_LString { LString ($1)}
 
 Grammar :: { Grammar }
@@ -158,7 +159,7 @@ ModType : 'abstract' Ident { MTAbstract $2 }
 ModBody :: { ModBody }
 ModBody : Extend Opens '{' ListTopDef '}' { MBody $1 $2 (reverse $4) } 
   | Ident 'with' ListOpen { MWith $1 $3 }
-  | ListIdent '**' Ident 'with' ListOpen { MWithE $1 $3 $5 }
+  | ListIncluded '**' Ident 'with' ListOpen { MWithE $1 $3 $5 }
   | 'reuse' Ident { MReuse $2 }
   | 'union' ListIncluded { MUnion $2 }
 
@@ -169,7 +170,7 @@ ListTopDef : {- empty -} { [] }
 
 
 Extend :: { Extend }
-Extend : ListIdent '**' { Ext $1 } 
+Extend : ListIncluded '**' { Ext $1 } 
   | {- empty -} { NoExt }
 
 
@@ -210,6 +211,7 @@ ListIncluded : {- empty -} { [] }
 Included :: { Included }
 Included : Ident { IAll $1 } 
   | Ident '[' ListIdent ']' { ISome $1 $3 }
+  | Ident '-' '[' ListIdent ']' { IMinus $1 $4 }
 
 
 Def :: { Def }
@@ -353,13 +355,14 @@ ListLocDef : {- empty -} { [] }
   | LocDef ';' ListLocDef { (:) $1 $3 }
 
 
-Exp4 :: { Exp }
+Exp6 :: { Exp }
-Exp4 : Ident { EIdent $1 } 
+Exp6 : Ident { EIdent $1 } 
   | '{' Ident '}' { EConstr $2 }
   | '%' Ident '%' { ECons $2 }
   | Sort { ESort $1 }
   | String { EString $1 }
   | Integer { EInt $1 }
+  | Double { EFloat $1 }
   | '?' { EMeta }
   | '[' ']' { EEmpty }
   | 'data' { EData }
@@ -373,48 +376,57 @@ Exp4 : Ident { EIdent $1 }
   | LString { ELString $1 }
 
 
-Exp3 :: { Exp }
+Exp5 :: { Exp }
-Exp3 : Exp3 '.' Label { EProj $1 $3 } 
+Exp5 : Exp5 '.' Label { EProj $1 $3 } 
   | '{' Ident '.' Ident '}' { EQConstr $2 $4 }
-  | '%' Ident '.' Ident '%' { EQCons $2 $4 }
+  | '%' Ident '.' Ident { EQCons $2 $4 }
-  | Exp4 { $1 }
+  | Exp6 { $1 }
 
 
-Exp2 :: { Exp }
+Exp4 :: { Exp }
-Exp2 : Exp2 Exp3 { EApp $1 $2 } 
+Exp4 : Exp4 Exp5 { EApp $1 $2 } 
   | 'table' '{' ListCase '}' { ETable $3 }
-  | 'table' Exp4 '{' ListCase '}' { ETTable $2 $4 }
+  | 'table' Exp6 '{' ListCase '}' { ETTable $2 $4 }
-  | 'table' Exp4 '[' ListExp ']' { EVTable $2 $4 }
+  | 'table' Exp6 '[' ListExp ']' { EVTable $2 $4 }
   | 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
   | 'variants' '{' ListExp '}' { EVariants $3 }
   | 'pre' '{' Exp ';' ListAltern '}' { EPre $3 $5 }
   | 'strs' '{' ListExp '}' { EStrs $3 }
-  | Ident '@' Exp4 { EConAt $1 $3 }
+  | Ident '@' Exp6 { EConAt $1 $3 }
-  | Exp3 { $1 }
+  | Exp5 { $1 }
   | 'Lin' Ident { ELin $2 }
 
 
+Exp3 :: { Exp }
+Exp3 : Exp3 '!' Exp4 { ESelect $1 $3 } 
+  | Exp3 '*' Exp4 { ETupTyp $1 $3 }
+  | Exp3 '**' Exp4 { EExtend $1 $3 }
+  | Exp4 { $1 }
+
+
 Exp1 :: { Exp }
-Exp1 : Exp1 '!' Exp2 { ESelect $1 $3 } 
+Exp1 : Exp2 '+' Exp1 { EGlue $1 $3 } 
-  | Exp1 '*' Exp2 { ETupTyp $1 $3 }
-  | Exp1 '**' Exp2 { EExtend $1 $3 }
   | Exp2 { $1 }
 
 
 Exp :: { Exp }
-Exp : '\\' ListBind '->' Exp { EAbstr $2 $4 } 
+Exp : Exp1 '++' Exp { EConcat $1 $3 } 
+  | '\\' ListBind '->' Exp { EAbstr $2 $4 }
   | '\\' '\\' ListBind '=>' Exp { ECTable $3 $5 }
   | Decl '->' Exp { EProd $1 $3 }
-  | Exp1 '=>' Exp { ETType $1 $3 }
+  | Exp3 '=>' Exp { ETType $1 $3 }
-  | Exp1 '++' Exp { EConcat $1 $3 }
-  | Exp1 '+' Exp { EGlue $1 $3 }
   | 'let' '{' ListLocDef '}' 'in' Exp { ELet $3 $6 }
   | 'let' ListLocDef 'in' Exp { ELetb $2 $4 }
-  | Exp1 'where' '{' ListLocDef '}' { EWhere $1 $4 }
+  | Exp3 'where' '{' ListLocDef '}' { EWhere $1 $4 }
   | 'fn' '{' ListEquation '}' { EEqs $3 }
+  | 'in' Exp5 String { EExample $2 $3 }
   | Exp1 { $1 }
 
 
+Exp2 :: { Exp }
+Exp2 : Exp3 { $1 } 
+
+
 ListExp :: { [Exp] }
 ListExp : {- empty -} { [] } 
   | Exp { (:[]) $1 }
@@ -423,24 +435,33 @@ ListExp : {- empty -} { [] }
 
 Exps :: { Exps }
 Exps : {- empty -} { NilExp } 
-  | Exp4 Exps { ConsExp $1 $2 }
+  | Exp6 Exps { ConsExp $1 $2 }
 
 
-Patt1 :: { Patt }
+Patt2 :: { Patt }
-Patt1 : '_' { PW } 
+Patt2 : '_' { PW } 
   | Ident { PV $1 }
   | '{' Ident '}' { PCon $2 }
   | Ident '.' Ident { PQ $1 $3 }
   | Integer { PInt $1 }
+  | Double { PFloat $1 }
   | String { PStr $1 }
   | '{' ListPattAss '}' { PR $2 }
   | '<' ListPattTupleComp '>' { PTup $2 }
   | '(' Patt ')' { $2 }
 
 
-Patt :: { Patt }
+Patt1 :: { Patt }
-Patt : Ident ListPatt { PC $1 $2 } 
+Patt1 : Ident ListPatt { PC $1 $2 } 
   | Ident '.' Ident ListPatt { PQC $1 $3 $4 }
+  | Patt2 '*' { PRep $1 }
+  | Ident '@' Patt2 { PAs $1 $3 }
+  | Patt2 { $1 }
+
+
+Patt :: { Patt }
+Patt : Patt '|' Patt1 { PDisj $1 $3 } 
+  | Patt '+' Patt1 { PSeq $1 $3 }
   | Patt1 { $1 }
 
 
@@ -467,18 +488,9 @@ ListPattAss : {- empty -} { [] }
   | PattAss ';' ListPattAss { (:) $1 $3 }
 
 
-PattAlt :: { PattAlt }
-PattAlt : Patt { AltP $1 } 
-
-
 ListPatt :: { [Patt] }
-ListPatt : Patt1 { (:[]) $1 } 
+ListPatt : Patt2 { (:[]) $1 } 
-  | Patt1 ListPatt { (:) $1 $2 }
+  | Patt2 ListPatt { (:) $1 $2 }
-
-
-ListPattAlt :: { [PattAlt] }
-ListPattAlt : PattAlt { (:[]) $1 } 
-  | PattAlt '|' ListPattAlt { (:) $1 $3 }
 
 
 Bind :: { Bind }
@@ -494,7 +506,7 @@ ListBind : {- empty -} { [] }
 
 Decl :: { Decl }
 Decl : '(' ListBind ':' Exp ')' { DDec $2 $4 } 
-  | Exp2 { DExp $1 }
+  | Exp4 { DExp $1 }
 
 
 TupleComp :: { TupleComp }
@@ -518,7 +530,7 @@ ListPattTupleComp : {- empty -} { [] }
 
 
 Case :: { Case }
-Case : ListPattAlt '=>' Exp { Case $1 $3 } 
+Case : Patt '=>' Exp { Case $1 $3 } 
 
 
 ListCase :: { [Case] }
@@ -548,7 +560,7 @@ ListAltern : {- empty -} { [] }
 
 DDecl :: { DDecl }
 DDecl : '(' ListBind ':' Exp ')' { DDDec $2 $4 } 
-  | Exp4 { DDExp $1 }
+  | Exp6 { DDExp $1 }
 
 
 ListDDecl :: { [DDecl] }

src/GF/Source/PrintGF.hs

@@ -399,6 +399,9 @@ instance Print Patt where
    PC id patts -> prPrec i 1 (concatD [prt 0 id , prt 0 patts])
    PQC id0 id patts -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
    PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
+   PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
+   PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
+   PAs id patt -> prPrec i 1 (concatD [prt 0 id , doc (showString "@") , prt 2 patt])
 
   prtList es = case es of
    [x] -> (concatD [prt 2 x])

src/GF/Source/SourceToGrammar.hs

@@ -517,6 +517,7 @@ transSort :: Sort -> Err String
 transSort x = case x of
   _ -> return $ printTree x
 
+--- no more used 7/1/2006 AR
 transPatts :: Patt -> Err [G.Patt]
 transPatts p = case p of
   PDisj p1 p2 -> liftM2 (++) (transPatts p1) (transPatts p2)
@@ -555,7 +556,12 @@ transPatt x = case x of
   PQ id0 id  -> liftM3 G.PP (transIdent id0) (transIdent id) (return [])
   PQC id0 id patts  -> 
     liftM3 G.PP (transIdent id0) (transIdent id) (mapM transPatt patts)
-  PDisj _ _ -> Bad $ "not allowed pattern" +++ printTree x
+  PDisj p1 p2 -> liftM2 G.PAlt (transPatt p1) (transPatt p2)
+  PSeq p1 p2  -> liftM2 G.PSeq (transPatt p1) (transPatt p2)
+  PRep p      -> liftM  G.PRep (transPatt p)
+  PAs x p     -> liftM2 G.PAs (transIdent x) (transPatt p)
+
+
 
 transBind :: Bind -> Err Ident
 transBind x = case x of
@@ -571,13 +577,13 @@ transDecl x = case x of
   DExp exp  -> liftM (return . M.mkDecl) $ transExp exp
 
 transCases :: [Case] -> Err [G.Case]
-transCases = liftM concat . mapM transCase
+transCases = mapM transCase
 
-transCase :: Case -> Err [G.Case]
+transCase :: Case -> Err G.Case
 transCase (Case p exp) = do
-  patts <- transPatts p
+  patt <- transPatt p
   exp'  <- transExp exp  
-  return [(p,exp') | p <- patts]
+  return (patt,exp')
 
 transEquation :: Equation -> Err G.Equation
 transEquation x = case x of