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

solved: path problem in SimpleGFC

Browse Source
This commit is contained in:
peb
2005-11-24 10:02:53 +00:00
parent 506dd0809c
commit 9d408658de
1 changed files with 7 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
src/GF/Formalism/SimpleGFC.hs
View File

@@ -166,6 +166,7 @@ enumeratePatterns t = enumerateTerms Nothing t
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- * paths of record projections and table selections -- * paths of record projections and table selections
-- | Note that the list of labels/selection terms is /reversed/
newtype Path c t = Path [Either Label (Term c t)] deriving (Eq, Ord, Show) newtype Path c t = Path [Either Label (Term c t)] deriving (Eq, Ord, Show)
emptyPath :: Path c t emptyPath :: Path c t
@@ -180,20 +181,20 @@ Path path ++. lbl = Path (Left lbl : path)
Path path ++! sel = Path (Right sel : path) Path path ++! sel = Path (Right sel : path)
lintypeFollowPath :: (Print c,Print t) => Path c t -> LinType c t -> LinType c t lintypeFollowPath :: (Print c,Print t) => Path c t -> LinType c t -> LinType c t
lintypeFollowPath (Path path0) ctype0 = follow path0 ctype0 lintypeFollowPath (Path path0) ctype0 = follow (reverse path0) ctype0
where follow [] ctype = ctype where follow [] ctype = ctype
follow (Right pat : path) (TblT _ ctype) = follow path ctype follow (Right pat : path) (TblT _ ctype) = follow path ctype
follow (Left lbl : path) (RecT rec) follow (Left lbl : path) (RecT rec)
= maybe err (follow path) $ lookup lbl rec = maybe err (follow path) $ lookup lbl rec
where err = error $ "lintypeFollowPath: label not in record type" where err = error $ "lintypeFollowPath: label not in record type"
++ "\nLabel: " ++ prt lbl ++ "\nOriginal Path: " ++ prt (Path path0)
++ "\nPath: " ++ prt (Path path0) ++ "\nOriginal CType: " ++ prt ctype0
++ "\nCType: " ++ prt ctype0 ++ "\nCurrent Label: " ++ prt lbl
++ "\nRType: " ++ prt (RecT rec) ++ "\nCurrent RType: " ++ prt (RecT rec)
--- by AR for debugging 23/11/2005 --- by AR for debugging 23/11/2005
termFollowPath :: (Eq c, Eq t) => Path c t -> Term c t -> Term c t termFollowPath :: (Eq c, Eq t) => Path c t -> Term c t -> Term c t
termFollowPath (Path path) = follow (reverse path) termFollowPath (Path path0) = follow (reverse path0)
where follow [] term = term where follow [] term = term
follow (Right pat : path) term = follow path (term +! pat) follow (Right pat : path) term = follow path (term +! pat)
follow (Left lbl : path) term = follow path (term +. lbl) follow (Left lbl : path) term = follow path (term +. lbl)