mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
fixing prolog printing
This commit is contained in:
@@ -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)
|
||||
|
||||
@@ -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 ]
|
||||
|
||||
Reference in New Issue
Block a user