forked from GitHub/gf-core
fix the handling of wildcards
This commit is contained in:
@@ -109,7 +109,7 @@ tryMatch (p,t) = do
|
|||||||
|
|
||||||
trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ----
|
trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ----
|
||||||
case (p,t') of
|
case (p,t') of
|
||||||
(PV IW, _) | notMeta t -> return [] -- optimization with wildcard
|
(PW, _) | notMeta t -> return [] -- optimization with wildcard
|
||||||
(PV x, _) | notMeta t -> return [(x,t)]
|
(PV x, _) | notMeta t -> return [(x,t)]
|
||||||
(PString s, ([],K i,[])) | s==i -> return []
|
(PString s, ([],K i,[])) | s==i -> return []
|
||||||
(PInt s, ([],EInt i,[])) | s==i -> return []
|
(PInt s, ([],EInt i,[])) | s==i -> return []
|
||||||
|
|||||||
@@ -897,7 +897,7 @@ checkLType env trm typ0 = do
|
|||||||
|
|
||||||
pattContext :: LTEnv -> Type -> Patt -> Check Context
|
pattContext :: LTEnv -> Type -> Patt -> Check Context
|
||||||
pattContext env typ p = case p of
|
pattContext env typ p = case p of
|
||||||
PV x | not (isWildIdent x) -> return [(x,typ)]
|
PV x -> return [(x,typ)]
|
||||||
PP q c ps | q /= cPredef -> 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
|
t <- checkErr $ lookupResType cnc q c
|
||||||
(cont,v) <- checkErr $ typeFormCnc t
|
(cont,v) <- checkErr $ typeFormCnc t
|
||||||
|
|||||||
@@ -300,8 +300,8 @@ computeTermOpt rec gr = comput True where
|
|||||||
_ -> case t' of
|
_ -> case t' of
|
||||||
FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
|
FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
|
||||||
|
|
||||||
T _ [(PV IW,c)] -> comp g c --- an optimization
|
T _ [(PW,c)] -> comp g c --- an optimization
|
||||||
T _ [(PT _ (PV IW),c)] -> comp g c
|
T _ [(PT _ PW,c)] -> comp g c
|
||||||
|
|
||||||
T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization
|
T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization
|
||||||
T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c
|
T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c
|
||||||
|
|||||||
@@ -82,7 +82,7 @@ tryMatch (p,t) = do
|
|||||||
(PVal pa _ _,_) -> trym pa t'
|
(PVal pa _ _,_) -> trym pa t'
|
||||||
(_, (_,Val te _ _,_)) -> tryMatch (p, te)
|
(_, (_,Val te _ _,_)) -> tryMatch (p, te)
|
||||||
(_,(x,Empty,y)) -> trym p (x,K [],y) -- because "" = [""] = []
|
(_,(x,Empty,y)) -> trym p (x,K [],y) -- because "" = [""] = []
|
||||||
(PV IW, _) | isInConstantFormt -> return [] -- optimization with wildcard
|
(PW, _) | isInConstantFormt -> return [] -- optimization with wildcard
|
||||||
(PV x, _) | isInConstantFormt -> return [(x,t)]
|
(PV x, _) | isInConstantFormt -> return [(x,t)]
|
||||||
(PString s, ([],K i,[])) | s==i -> return []
|
(PString s, ([],K i,[])) | s==i -> return []
|
||||||
(PInt s, ([],EInt i,[])) | s==i -> return []
|
(PInt s, ([],EInt i,[])) | s==i -> return []
|
||||||
@@ -159,7 +159,7 @@ isInConstantForm trm = case trm of
|
|||||||
|
|
||||||
varsOfPatt :: Patt -> [Ident]
|
varsOfPatt :: Patt -> [Ident]
|
||||||
varsOfPatt p = case p of
|
varsOfPatt p = case p of
|
||||||
PV x -> [x | not (isWildIdent x)]
|
PV x -> [x]
|
||||||
PC _ ps -> concat $ map varsOfPatt ps
|
PC _ ps -> concat $ map varsOfPatt ps
|
||||||
PP _ _ ps -> concat $ map varsOfPatt ps
|
PP _ _ ps -> concat $ map varsOfPatt ps
|
||||||
PR r -> concat $ map (varsOfPatt . snd) r
|
PR r -> concat $ map (varsOfPatt . snd) r
|
||||||
|
|||||||
@@ -218,6 +218,7 @@ ppPatt q d (PChar) = char '?'
|
|||||||
ppPatt q d (PChars s) = brackets (text (show s))
|
ppPatt q d (PChars s) = brackets (text (show s))
|
||||||
ppPatt q d (PMacro id) = char '#' <> ppIdent id
|
ppPatt q d (PMacro id) = char '#' <> ppIdent id
|
||||||
ppPatt q d (PM m id) = char '#' <> ppIdent m <> char '.' <> ppIdent id
|
ppPatt q d (PM m id) = char '#' <> ppIdent m <> char '.' <> ppIdent id
|
||||||
|
ppPatt q d PW = char '_'
|
||||||
ppPatt q d (PV id) = ppIdent id
|
ppPatt q d (PV id) = ppIdent id
|
||||||
ppPatt q d (PInt n) = integer n
|
ppPatt q d (PInt n) = integer n
|
||||||
ppPatt q d (PFloat f) = double f
|
ppPatt q d (PFloat f) = double f
|
||||||
@@ -269,6 +270,8 @@ getAbs e = ([],e)
|
|||||||
getCTable :: Term -> ([Ident], Term)
|
getCTable :: Term -> ([Ident], Term)
|
||||||
getCTable (T TRaw [(PV v,e)]) = let (vs,e') = getCTable e
|
getCTable (T TRaw [(PV v,e)]) = let (vs,e') = getCTable e
|
||||||
in (v:vs,e')
|
in (v:vs,e')
|
||||||
|
getCTable (T TRaw [(PW, e)]) = let (vs,e') = getCTable e
|
||||||
|
in (identW:vs,e')
|
||||||
getCTable e = ([],e)
|
getCTable e = ([],e)
|
||||||
|
|
||||||
getLet :: Term -> ([LocalDef], Term)
|
getLet :: Term -> ([LocalDef], Term)
|
||||||
|
|||||||
@@ -182,7 +182,6 @@ trt trm = case trm of
|
|||||||
trp :: Patt -> P.Patt
|
trp :: Patt -> P.Patt
|
||||||
trp p = case p of
|
trp p = case p of
|
||||||
PW -> P.PW
|
PW -> P.PW
|
||||||
PV s | isWildIdent s -> P.PW
|
|
||||||
PV s -> P.PV $ tri s
|
PV s -> P.PV $ tri s
|
||||||
PC c [] -> P.PCon $ tri c
|
PC c [] -> P.PCon $ tri c
|
||||||
PC c a -> P.PC (tri c) (map trp a)
|
PC c a -> P.PC (tri c) (map trp a)
|
||||||
|
|||||||
Reference in New Issue
Block a user