msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

simple problem tracing

Browse Source
This commit is contained in:
aarne
2005-11-24 09:25:39 +00:00
parent 2f8514e54a
commit 9a9d057a34
1 changed files with 6 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -179,15 +179,17 @@ Path path ++. lbl = Path (Left lbl : path)
(++!) :: Path c t -> Term c t -> Path c t
Path path ++! sel = Path (Right sel : path)
lintypeFollowPath :: (Show c,Show t) => Path c t -> LinType c t -> LinType c t
lintypeFollowPath (Path path) = follow path
lintypeFollowPath :: (Print c,Print t) => Path c t -> LinType c t -> LinType c t
lintypeFollowPath (Path path0) ctype0 = follow path0 ctype0
where follow [] ctype = ctype
follow (Right pat : path) (TblT _ ctype) = follow path ctype
follow (Left lbl : path) (RecT rec)
= maybe err (follow path) $ lookup lbl rec
where err = error $ "lintypeFollowPath: label not in record type"
++ "\n" ++ show lbl
++ "\n" ++ show rec
++ "\nLabel: " ++ prt lbl
++ "\nPath: " ++ prt (Path path0)
++ "\nCType: " ++ prt ctype0
++ "\nRType: " ++ prt (RecT rec)
--- by AR for debugging 23/11/2005
termFollowPath :: (Eq c, Eq t) => Path c t -> Term c t -> Term c t