diff options
| author | peb <peb@cs.chalmers.se> | 2006-03-09 12:39:11 +0000 |
|---|---|---|
| committer | peb <peb@cs.chalmers.se> | 2006-03-09 12:39:11 +0000 |
| commit | 00d3d0b27dae7279527837f2d3a1177edb014761 (patch) | |
| tree | f5e7ae7ba781b8729a8db79c6fa3fd438f0d35b9 /src | |
| parent | 641fa54ddc11b1a4fd0cfab1aaa791f4ddedd889 (diff) | |
fixing prolog printing
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Conversion/Prolog.hs | 6 | ||||
| -rw-r--r-- | src/GF/Conversion/RemoveErasing.hs | 8 |
2 files changed, 11 insertions, 3 deletions
diff --git a/src/GF/Conversion/Prolog.hs b/src/GF/Conversion/Prolog.hs index 235f31198..ebad8e587 100644 --- a/src/GF/Conversion/Prolog.hs +++ b/src/GF/Conversion/Prolog.hs @@ -36,6 +36,8 @@ import GF.Infra.Ident (Ident(..)) import Data.Maybe (maybeToList, listToMaybe) import Data.Char (isLower, isAlphaNum) +import GF.System.Tracing + ---------------------------------------------------------------------- -- | printing multiple languages at the same time @@ -172,8 +174,8 @@ prtProfile (Unify args) = foldr1 (prtOper "=") (map (show . succ) args) prtProfile (Constant forest) = prtForest forest prtForest (FMeta) = " ? " -prtForest (FNode fun [fs]) = prtFunctor (prtQ fun) (prtPList (map prtForest fs)) -prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (prtPList (map prtForest fs)) | +prtForest (FNode fun [fs]) = prtFunctor (prtQ fun) (map prtForest fs) +prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (map prtForest fs) | fs <- fss ] prtQ atom = prtQStr (prt atom) diff --git a/src/GF/Conversion/RemoveErasing.hs b/src/GF/Conversion/RemoveErasing.hs index 0062e5f36..8185e4f02 100644 --- a/src/GF/Conversion/RemoveErasing.hs +++ b/src/GF/Conversion/RemoveErasing.hs @@ -80,11 +80,17 @@ newRules grammar chart (NC newCat@(MCat cat lbls)) newProfile = snd $ mapAccumL accumProf 0 $ map (lookupAssoc argsInLin) [0 .. length args-1] accumProf nr = maybe (nr, Unify []) $ const (nr+1, Unify [nr]) - newName = Name fun (newProfile `composeProfiles` profile) + newName = -- tracePrt "newName" (prtNewName profile newProfile) $ + Name fun (profile `composeProfiles` newProfile) guard $ all (not . null) argLbls return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins)) + +prtNewName :: [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] -> Name -> String +prtNewName p p' n = prt p ++ " .o. " ++ prt p' ++ " : " ++ prt n + + initialCatsTD grammar starts = [ cat | cat@(NC (MCat (ECat start _) _)) <- initialCatsBU grammar, start `elem` starts ] |