From 9d408658de28d6416bbda3828e90f2e450e4b84d Mon Sep 17 00:00:00 2001 From: peb Date: Thu, 24 Nov 2005 10:02:53 +0000 Subject: [PATCH] solved: path problem in SimpleGFC --- src/GF/Formalism/SimpleGFC.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/GF/Formalism/SimpleGFC.hs b/src/GF/Formalism/SimpleGFC.hs index 1dcc07be4..04a5832c8 100644 --- a/src/GF/Formalism/SimpleGFC.hs +++ b/src/GF/Formalism/SimpleGFC.hs @@ -166,6 +166,7 @@ enumeratePatterns t = enumerateTerms Nothing t ---------------------------------------------------------------------- -- * 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) emptyPath :: Path c t @@ -180,20 +181,20 @@ Path path ++. lbl = Path (Left lbl : path) Path path ++! sel = Path (Right sel : path) 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 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" - ++ "\nLabel: " ++ prt lbl - ++ "\nPath: " ++ prt (Path path0) - ++ "\nCType: " ++ prt ctype0 - ++ "\nRType: " ++ prt (RecT rec) + ++ "\nOriginal Path: " ++ prt (Path path0) + ++ "\nOriginal CType: " ++ prt ctype0 + ++ "\nCurrent Label: " ++ prt lbl + ++ "\nCurrent RType: " ++ prt (RecT rec) --- by AR for debugging 23/11/2005 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 follow (Right pat : path) term = follow path (term +! pat) follow (Left lbl : path) term = follow path (term +. lbl)