The SLinType type is changed so that you don't have to use enumerateTerms each time when you want to know the possible table arguments

This commit is contained in:
kr.angelov
2006-06-01 10:26:49 +00:00
parent a73aa39dcc
commit 0c0c82603c
4 changed files with 23 additions and 25 deletions

View File

@@ -119,8 +119,8 @@ expandTerm gram term = -- tracePrt "expanded term" prt $
convertCType :: Env -> A.CType -> SLinType
convertCType gram (A.RecType rec) = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
convertCType gram (A.Table pt vt) = TblT (convertCType gram pt) (convertCType gram vt)
convertCType gram ct@(A.Cn con) = ConT con $ map (convertTerm gram) $ groundTerms gram ct
convertCType gram (A.Table pt vt) = TblT (enumerateTerms Nothing (convertCType gram pt)) (convertCType gram vt)
convertCType gram ct@(A.Cn con) = ConT $ map (convertTerm gram) $ groundTerms gram ct
convertCType gram (A.TStr) = StrT
convertCType gram (A.TInts n) = error "GFCtoSimple.convertCType: cannot handle 'TInts' constructor"

View File

@@ -136,15 +136,13 @@ simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
reduceTerm :: SLinType -> SPath -> STerm -> CnvMonad ()
--reduceTerm ctype path (Variants terms)
-- = member terms >>= reduceTerm ctype path
reduceTerm (StrT) path term = updateLin (path, term)
reduceTerm (ConT _ _) path term = do pat <- expandTerm term
updateHead (path, pat)
reduceTerm (StrT) path term = updateLin (path, term)
reduceTerm (ConT _) path term = do pat <- expandTerm term
updateHead (path, pat)
reduceTerm (RecT rtype) path term
= sequence_ [ reduceTerm ctype (path ++. lbl) (term +. lbl) |
(lbl, ctype) <- rtype ]
reduceTerm (TblT ptype vtype) path table
= sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) |
pat <- enumeratePatterns ptype ]
= sequence_ [ reduceTerm ctype (path ++. lbl) (term +. lbl) | (lbl, ctype) <- rtype ]
reduceTerm (TblT pats vtype) path table
= sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) | pat <- pats ]
------------------------------------------------------------
@@ -174,7 +172,7 @@ unifyPType arg (RecT prec) =
sequence [ liftM ((,) lbl) $
unifyPType (arg +. lbl) ptype |
(lbl, ptype) <- prec ]
unifyPType (Arg nr _ path) (ConT con terms) =
unifyPType (Arg nr _ path) (ConT terms) =
do (_, args, _, _) <- readState
case lookup path (ecatConstraints (args !! nr)) of
Just term -> return term

View File

@@ -109,7 +109,7 @@ termPaths ctype term | isBaseType ctype = [ (emptyPath, (ctype, term)) ]
parPaths :: SLinType -> STerm -> [[(SPath, STerm)]]
parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
nubsort [ (path, value) |
(path, (ConT _ _, value)) <- termPaths ctype term ]
(path, (ConT _, value)) <- termPaths ctype term ]
strPaths :: SLinType -> STerm -> [(SPath, STerm)]
strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs paths ]

View File

@@ -79,15 +79,15 @@ term2tterm term = error $ "term2tterm: illegal term"
-- ** linearization types and terms
data LinType c t = RecT [(Label, LinType c t)]
| TblT (LinType c t) (LinType c t)
| ConT Constr [Term c t]
| TblT [Term c t] (LinType c t)
| ConT [Term c t]
| StrT
deriving (Eq, Ord, Show)
isBaseType :: LinType c t -> Bool
isBaseType (ConT _ _) = True
isBaseType (StrT) = True
isBaseType _ = False
isBaseType (ConT _) = True
isBaseType (StrT) = True
isBaseType _ = False
data Term c t
= Arg Int c (Path c t) -- ^ argument variable, the 'Path' is a path
@@ -166,12 +166,12 @@ variants terms0 = case concatMap flatten terms0 of
enumerateTerms :: (Eq c, Eq t) => Maybe (Term c t) -> LinType c t -> [Term c t]
enumerateTerms arg (StrT) = maybe err return arg
where err = error "enumeratePatterns: parameter type should not be string"
enumerateTerms arg (ConT _ terms) = terms
enumerateTerms arg (ConT terms) = terms
enumerateTerms arg (RecT rtype)
= liftM Rec $ mapM enumAssign rtype
where enumAssign (lbl, ctype) = liftM ((,) lbl) $ enumerateTerms arg ctype
enumerateTerms arg (TblT ptype ctype)
= liftM Tbl $ mapM enumCase $ enumeratePatterns ptype
enumerateTerms arg (TblT terms ctype)
= liftM Tbl $ mapM enumCase terms
where enumCase pat = liftM ((,) pat) $ enumerateTerms (fmap (+! pat) arg) ctype
enumeratePatterns :: (Eq c, Eq t) => LinType c t -> [Term c t]
@@ -214,12 +214,12 @@ termFollowPath (Path path0) = follow (reverse path0)
follow (Left lbl : path) term = follow path (term +. lbl)
lintype2paths :: (Eq c, Eq t) => Path c t -> LinType c t -> [Path c t]
lintype2paths path (ConT _ _) = []
lintype2paths path (ConT _) = []
lintype2paths path (StrT) = [ path ]
lintype2paths path (RecT rec) = concat [ lintype2paths (path ++. lbl) ctype |
(lbl, ctype) <- rec ]
lintype2paths path (TblT pt vt) = concat [ lintype2paths (path ++! pat) vt |
pat <- enumeratePatterns pt ]
lintype2paths path (TblT pts vt)= concat [ lintype2paths (path ++! pat) vt |
pat <- pts ]
----------------------------------------------------------------------
-- * pretty-printing
@@ -243,8 +243,8 @@ instance Print TTerm where
instance (Print c, Print t) => Print (LinType c t) where
prt (RecT rec) = "{" ++ prtPairList ":" "; " rec ++ "}"
prt (TblT t1 t2) = "(" ++ prt t1 ++ " => " ++ prt t2 ++ ")"
prt (ConT t ts) = prt t ++ "[" ++ prtSep "|" ts ++ "]"
prt (TblT ts t2) = "([" ++ prtSep "|" ts ++ "] => " ++ prt t2 ++ ")"
prt (ConT ts) = "[" ++ prtSep "|" ts ++ "]"
prt (StrT) = "Str"
instance (Print c, Print t) => Print (Term c t) where