"Committed_by_peb"

3 files changed, 56 insertions, 53 deletions

diff --git a/grammars/ljung/thesis/FragmentAbstract.gf b/grammars/ljung/thesis/FragmentAbstract.gf
index 5141180ca..43653a933 100644
--- a/grammars/ljung/thesis/FragmentAbstract.gf
+++ b/grammars/ljung/thesis/FragmentAbstract.gf
@@ -1,6 +1,8 @@
 
 abstract FragmentAbstract = {
 
+flags startcat=NP;
+
 cat S; NP; VP; D; N; V;
 
 fun
diff --git a/src/GF/Conversion/Prolog.hs b/src/GF/Conversion/Prolog.hs
index c6b2e376b..281960048 100644
--- a/src/GF/Conversion/Prolog.hs
+++ b/src/GF/Conversion/Prolog.hs
@@ -4,16 +4,15 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/08/11 14:11:46 $ 
+-- > CVS $Date: 2005/08/18 13:18:10 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Converting/Printing different grammar formalisms in Prolog-readable format
 -----------------------------------------------------------------------------
 
 
-module GF.Conversion.Prolog (prtSM_Multi,
-                             prtSGrammar, prtSMulti, prtSHeader, prtSRule,
+module GF.Conversion.Prolog (prtSGrammar, prtSMulti, prtSHeader, prtSRule,
                              prtMGrammar, prtMMulti, prtMHeader, prtMRule,
                              prtCGrammar, prtCMulti, prtCHeader, prtCRule) where
 
@@ -39,16 +38,14 @@ import Data.Maybe (maybeToList, listToMaybe)
 ----------------------------------------------------------------------
 -- | printing multiple languages at the same time
 
-prtSM_Multi, prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
-prtSMulti = prtMulti prtSHeader prtSRule (const Cnv.gfc2simple) ""
-prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg "{}[.s]"
-prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg "{}.s"
-
-prtSM_Multi opts gr = prtSMulti opts gr +++++ prtMMulti opts gr
+prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
+prtSMulti = prtMulti prtSHeader prtSRule (const Cnv.gfc2simple)
+prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg
+prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg
 
 -- code and ideas stolen from GF.CFGM.PrintCFGrammar
 
-prtMulti prtHeader prtRule conversion startsuffix opts gr
+prtMulti prtHeader prtRule conversion opts gr
     = prtHeader ++++ unlines
       [ "\n\n" ++ prtLine ++++
         "%% Language module: " ++ prtQ langmod +++++
@@ -73,35 +70,33 @@ prtSHeader :: String
 prtSHeader = prtLine ++++
              "%% Simple GFC grammar in Prolog-readable format" ++++
              "%% Autogenerated from the Grammatical Framework" +++++
-             "%% Operators used in LinTerms:" ++++
-             ":- op(200, xfx, [':.', ':/', ':++', ':^'])." +++++
              "%% The following predicate is defined:" ++++
-             "%% \t gfcrule(Fun, Cat, [Cat,...], LinTerm)"
+             "%% \t gfcrule(Fun, Cat, c(Cat,...), LinTerm)"
 
 prtSRule :: String -> SRule -> String
 prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm)) 
     = (if null lang then "" else prtQ lang ++ " : ") ++ 
-      "gfcrule(" ++ plname ++ ", " ++ plcat ++ ", " ++ plcats ++ ", " ++ plcnc ++ ")."
-    where plcat  = prtQ cat
-          plcats = "[" ++ prtSep ", " (map prtQ cats) ++ "]"
-	  plname = prtQ fun
-          plcnc  = "\n\t" ++ prtSTerm (maybe (Variants []) id mterm)
+      prtFunctor "gfcrule" [plfun, plcat, plcats, plcnc] ++ "."
+    where plfun  = prtQ fun
+          plcat  = prtQ cat
+          plcats = prtFunctor "c" (map prtQ cats) 
+	  plcnc  = "\n\t" ++ prtSTerm (maybe (Variants []) id mterm)
 
-prtSTerm (Arg n c p)    = "arg(" ++ prtQ c ++ "," ++ prtSPath p ++ "," ++ prt n ++ ")"
+prtSTerm (Arg n c p)    = prtFunctor "arg" [prtQ c, prtSPath p, prt (n+1)]
 -- prtSTerm (c :^ [])   = prtQ c
-prtSTerm (c :^ ts)      = "(" ++ prtQ c ++ " :^ [" ++ prtSep ", " (map prtSTerm ts) ++ "])"
-prtSTerm (Rec rec)      = "rec([" ++ prtSep ", " [ prtQ l ++ "=" ++ prtSTerm t | (l, t) <- rec ] ++ "])"
-prtSTerm (Tbl tbl)      = "tbl([" ++ prtSep ", " [ prtSTerm p ++ "=" ++ prtSTerm t | (p, t) <- tbl ] ++ "])"
-prtSTerm (Variants ts)  = "variants([" ++ prtSep ", " (map prtSTerm ts) ++ "])"
-prtSTerm (t1 :++ t2)    = "(" ++ prtSTerm t1 ++ " :++ " ++ prtSTerm t2 ++ ")"
-prtSTerm (Token t)      = "token(" ++ prtQ t ++ ")"
+prtSTerm (c :^ ts)      = prtOper "^" (prtQ c) (prtPList (map prtSTerm ts))
+prtSTerm (Rec rec)      = prtFunctor "rec" [prtPList [ prtOper "=" (prtQ l) (prtSTerm t) | (l, t) <- rec ]]
+prtSTerm (Tbl tbl)      = prtFunctor "tbl" [prtPList [ prtOper "=" (prtSTerm p) (prtSTerm t) | (p, t) <- tbl ]]
+prtSTerm (Variants ts)  = prtFunctor "variants" [prtPList (map prtSTerm ts)]
+prtSTerm (t1 :++ t2)    = prtOper "+" (prtSTerm t1) (prtSTerm t2)
+prtSTerm (Token t)      = prtFunctor "token" [prtQ t]
 prtSTerm (Empty)        = "empty"
-prtSTerm (term :. lbl)  = "(" ++ prtSTerm term ++ " :. " ++ prtQ lbl ++ ")"
-prtSTerm (term :! sel)  = "(" ++ prtSTerm term ++ " :/ " ++ prtSTerm sel ++ ")"
+prtSTerm (term :. lbl)  = prtOper "*" (prtSTerm term) (prtQ lbl)
+prtSTerm (term :! sel)  = prtOper "/" (prtSTerm term) (prtSTerm sel)
 -- prtSTerm (Wildcard)  = "wildcard"
--- prtSTerm (Var var)   = "var(" ++ prtQ var ++ ")"
+-- prtSTerm (Var var)   = prtFunctor "var" [prtQ var]
 
-prtSPath (Path path) = "[" ++ prtSep "," (map (either prtQ prtSTerm) path) ++ "]"
+prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path)
 
 ----------------------------------------------------------------------
 -- | MCFG to Prolog
@@ -113,21 +108,22 @@ prtMHeader = prtLine ++++
              "%% Multiple context-free grammar in Prolog-readable format" ++++
              "%% Autogenerated from the Grammatical Framework" +++++
              "%% The following predicate is defined:" ++++
-             "%% \t mcfgrule(Fun/ProfileList, Cat, [Cat,...], [Lbl=Symbols,...])" 
+             "%% \t mcfgrule(Fun, p(Profile,...), Cat, c(Cat,...), [Lbl=Symbols,...])" 
 
 prtMRule :: String -> MRule -> String
 prtMRule lang (Rule (Abs cat cats (Name fun profiles)) (Cnc _lcat _lcats lins)) 
     = (if null lang then "" else prtQ lang ++ " : ") ++ 
-      "mcfgrule(" ++ plname ++ ", " ++ plcat ++ ", " ++ plcats ++ ", " ++ pllins ++ ")."
-    where plcat  = prtQ cat
-          plcats = "[" ++ prtSep ", " (map prtQ cats) ++ "]"
-	  plname = prtQ fun ++ "/[" ++ prtSep "," (map prtProfile profiles) ++ "]"
+      prtFunctor "mcfgrule" [plfun, plprof, plcat, plcats, pllins] ++ "."
+    where plfun  = prtQ fun
+          plprof = prtFunctor "p" (map prtProfile profiles) 
+          plcat  = prtQ cat
+          plcats = prtFunctor "c" (map prtQ cats) 
           pllins = "\n\t[ " ++ prtSep "\n\t, " (map prtMLin lins) ++ " ]"
 
-prtMLin (Lin lbl lin) = prtQ lbl ++ " = [" ++ prtSep ", " (map prtMSymbol lin) ++ "]"
+prtMLin (Lin lbl lin) = prtOper "=" (prtQ lbl) (prtPList (map prtMSymbol lin))
 
-prtMSymbol (Cat (cat, lbl, nr)) = "cat(" ++ prtQ cat ++ "," ++ prtQ lbl ++ "," ++ show nr ++ ")"
-prtMSymbol (Tok tok) = "tok(" ++ prtQ tok ++ ")"
+prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "cat" [prtQ cat, prtQ lbl, show (nr+1)]
+prtMSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
 
 ----------------------------------------------------------------------
 -- | CFG to Prolog
@@ -139,29 +135,35 @@ prtCHeader = prtLine ++++
              "%% Context-free grammar in Prolog-readable format" ++++
              "%% Autogenerated from the Grammatical Framework" +++++
              "%% The following predicate is defined:" ++++
-             "%% \t cfgrule(Fun/ProfileList, Cat, [Symbol,...])"
+             "%% \t cfgrule(Fun, p(Profile,...), Cat, [Symbol,...])"
 
 prtCRule :: String -> CRule -> String
 prtCRule lang (CFRule cat syms (Name fun profiles)) 
     = (if null lang then "" else prtQ lang ++ " : ") ++ 
-      "cfgrule(" ++ plname ++ ", " ++ plcat ++ ", " ++ plsyms ++ ")."
-    where plcat  = prtQ cat
-          plsyms = "[" ++ prtSep ", " (map prtCSymbol syms) ++ "]"
-          plname = prtQ fun ++ "/[" ++ prtSep "," (map prtProfile profiles) ++ "]" 
+      prtFunctor "cfgrule" [plfun, plprof, plcat, plsyms] ++ "."
+    where plfun  = prtQ fun
+          plprof = prtFunctor "p" (map prtProfile profiles) 
+          plcat  = prtQ cat
+          plsyms = prtPList (map prtCSymbol syms) 
 
-prtCSymbol (Cat cat) = "cat(" ++ prtQ cat ++ ")"
-prtCSymbol (Tok tok) = "tok(" ++ prtQ tok ++ ")"
+prtCSymbol (Cat cat) = prtFunctor "cat" [prtQ cat]
+prtCSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
 
 ----------------------------------------------------------------------
 -- profiles, quoted strings and more
 
-prtProfile (Unify args) = show args
+prtFunctor f xs = f ++ if null xs then "" else "(" ++ prtSep ", " xs ++ ")"
+prtPList     xs = "[" ++ prtSep ", " xs ++ "]"
+prtOper   f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")"
+
+prtProfile (Unify [arg]) = show (succ arg)
+prtProfile (Unify args)  = show (map succ args)
 prtProfile (Constant forest) = prtForest forest
 
-prtForest (FMeta) = "_META_"
-prtForest (FNode fun fss) = prtQ fun ++ "^" ++ prtFss fss
-    where prtFss fss = "[" ++ prtSep "," (map prtFs fss) ++ "]"
-	  prtFs fs = "[" ++ prtSep "," (map prtForest fs) ++ "]"
+prtForest (FMeta) = "fmeta"
+prtForest (FNode fun fss) = prtFunctor "fnode" [prtQ fun, prtFss fss]
+    where prtFss fss = prtPList (map prtFs fss) 
+	  prtFs  fs  = prtPList (map prtForest fs) 
 
 prtQ x = "'" ++ concatMap esc (prt x) ++ "'"
     where esc '\'' = "\\'"
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 3ceeb4009..340db4187 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/08/11 14:11:46 $ 
+-- > CVS $Date: 2005/08/18 13:18:10 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.67 $
+-- > CVS $Revision: 1.68 $
 --
 -- A database for customizable GF shell commands. 
 --
@@ -295,7 +295,6 @@ customMultiGrammarPrinter =
   ,(strCI "gfc-prolog", CnvProlog.prtSMulti)
   ,(strCI "mcfg-prolog", CnvProlog.prtMMulti)
   ,(strCI "cfg-prolog", CnvProlog.prtCMulti)
-  ,(strCI "prolog", CnvProlog.prtSM_Multi)
   ]