GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

GF.Grammar.PatternMatch: relax overly restrictive type signatures

Browse Source
This commit is contained in:
hallgren
2012-11-07 17:23:08 +00:00
parent a912ad813d
commit ad74dfe527
1 changed files with 2 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Grammar/PatternMatch.hs
View File

@@ -28,7 +28,7 @@ import Control.Monad
import Text.PrettyPrint import Text.PrettyPrint
import Debug.Trace import Debug.Trace
matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution) matchPattern :: [(Patt,rhs)] -> Term -> Err (rhs, Substitution)
matchPattern pts term = matchPattern pts term =
if not (isInConstantForm term) if not (isInConstantForm term)
then Bad (render (text "variables occur in" <+> ppTerm Unqualified 0 term)) then Bad (render (text "variables occur in" <+> ppTerm Unqualified 0 term))
@@ -57,7 +57,7 @@ testOvershadow pts vs = do
ts <- mapM (liftM fst . matchPattern cases) vs ts <- mapM (liftM fst . matchPattern cases) vs
return [p | (p,i) <- numpts, notElem i [i | EInt i <- ts] ] return [p | (p,i) <- numpts, notElem i [i | EInt i <- ts] ]
findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution) findMatch :: [([Patt],rhs)] -> [Term] -> Err (rhs, Substitution)
findMatch cases terms = case cases of findMatch cases terms = case cases of
[] -> Bad (render (text "no applicable case for" <+> hsep (punctuate comma (map (ppTerm Unqualified 0) terms)))) [] -> Bad (render (text "no applicable case for" <+> hsep (punctuate comma (map (ppTerm Unqualified 0) terms))))
(patts,_):_ | length patts /= length terms -> (patts,_):_ | length patts /= length terms ->