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

fixing prolog printing

Browse Source
This commit is contained in:
peb
2006-03-09 12:39:11 +00:00
parent e677a613fc
commit f70d4e592c
2 changed files with 11 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/GF/Conversion/Prolog.hs
View File

@@ -36,6 +36,8 @@ import GF.Infra.Ident (Ident(..))
import Data.Maybe (maybeToList, listToMaybe) import Data.Maybe (maybeToList, listToMaybe)
import Data.Char (isLower, isAlphaNum) import Data.Char (isLower, isAlphaNum)
import GF.System.Tracing
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | printing multiple languages at the same time -- | 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 prtProfile (Constant forest) = prtForest forest
prtForest (FMeta) = " ? " prtForest (FMeta) = " ? "
prtForest (FNode fun [fs]) = 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) (prtPList (map prtForest fs)) | prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (map prtForest fs) |
fs <- fss ] fs <- fss ]
prtQ atom = prtQStr (prt atom) prtQ atom = prtQStr (prt atom)

8
src/GF/Conversion/RemoveErasing.hs
View File

@@ -80,11 +80,17 @@ newRules grammar chart (NC newCat@(MCat cat lbls))
newProfile = snd $ mapAccumL accumProf 0 $ newProfile = snd $ mapAccumL accumProf 0 $
map (lookupAssoc argsInLin) [0 .. length args-1] map (lookupAssoc argsInLin) [0 .. length args-1]
accumProf nr = maybe (nr, Unify []) $ const (nr+1, Unify [nr]) 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 guard $ all (not . null) argLbls
return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins)) 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 = initialCatsTD grammar starts =
[ cat | cat@(NC (MCat (ECat start _) _)) <- initialCatsBU grammar, [ cat | cat@(NC (MCat (ECat start _) _)) <- initialCatsBU grammar,
start `elem` starts ] start `elem` starts ]