From 4e42d73ee508715e83c8f1a160b7bc696b78571b Mon Sep 17 00:00:00 2001 From: aarne Date: Sat, 7 Jan 2006 12:26:11 +0000 Subject: regex patterns for tokens --- src/GF/Source/SourceToGrammar.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'src/GF/Source/SourceToGrammar.hs') diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs index 97f8fbc75..6465b6fc9 100644 --- a/src/GF/Source/SourceToGrammar.hs +++ b/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 -- cgit v1.2.3