revising tex

examples/gfcc/complin.tex

@@ -22,12 +22,13 @@
 \newcommand{\heading}[1]{\subsection{#1}}
 \newcommand{\explanation}[1]{{\small #1}}
 \newcommand{\empha}[1]{{\em #1}}
+\newcommand{\commentOut}[1]{}
 \newcommand{\rarrow}{\; \rightarrow\;}
 
 \newcommand{\nocolor}{} %% {\color[rgb]{0,0,0}}
 
 
-\title{{\bf Single-Source Language Definitions and Code Generation as Linearization}}
+\title{{\bf Declarative Language Definitions and Code Generation as Linearization}}
 
 \author{Aarne Ranta \\
   Department of Computing Science \\
@@ -994,10 +995,11 @@ editor can work simultaneously on all languages involved.
 In our case, this means that changes can be done both to
 the C code and to the JVM code, and they are automatically
 carried over from one language to the other.
+\commentOut{
 A screen dump of the editor is shown in Fig~\ref{demo}.
 
 \begin{figure}
-\centerline{\psfig{figure=demo2.ps}} \caption{
+\centerline{\psfig{figure=demo2.epsi}} \caption{
 GF editor session where an integer
 expression is expected to be given. The left window shows the
 abstract syntax tree, and the right window the evolving C and
@@ -1006,7 +1008,7 @@ are shown in a pop-up window.
 }
 \label{demo}
 \end{figure}
-
+}
 
 
 \section{Related work}

src/GF/CF/PrLBNF.hs

@@ -5,22 +5,32 @@ import CFIdent
 import AbsGFC
 import Ident
 import PrGrammar
+import ShellState
+import GFC
+import Look
 
 import Operations
+import Modules
+
 import Char
+import List (nub)
 
 -- Printing CF grammars generated from GF as LBNF grammar for BNFC.
--- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003
+-- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003 -- 27/9/2004
 -- With primitive error messaging, by rules and rule tails commented out
 
-prLBNF :: CF -> String
+prLBNF :: Bool -> StateGrammar -> String
-prLBNF cf = unlines $ (map (prCFRule cs)) $ rulesOfCF cf --- no literal recogn function
+prLBNF new gr = unlines $ pragmas ++ (map (prCFRule cs) rules)
   where    
-    cs = map IC ["Int","String"] ++ [catId c | (_,(c,_)) <- rulesOfCF cf]
+    cs = map IC ["Int","String"] ++ [catId c | (_,(c,_)) <- rules]
+    cf = stateCF gr
+    (pragmas,rules) = if new  -- tries to treat precedence levels
+                         then mkLBNF (stateGrammarST gr) $ rulesOfCF cf
+                         else ([],rulesOfCF cf) -- "normal" behaviour
 
 -- a hack to hide the LBNF details
-prBNF :: CF -> String
+prBNF :: Bool -> StateGrammar -> String
-prBNF = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF
+prBNF b = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF b
   where
     unLBNF r = case r of
       "---":ts -> ts
@@ -28,6 +38,48 @@ prBNF = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF
       c:ts -> c : unLBNF ts
       _ -> r
 
+--- awful low level code without abstraction over label names etc
+mkLBNF :: CanonGrammar -> [CFRule] -> ([String],[CFRule])
+mkLBNF gr rules = (coercions, nub $ concatMap mkRule rules) where
+  coercions = ["coercions" +++ prt_ c +++ show n +++ ";"  | 
+    (_,ModMod m) <- modules gr,
+    (c,CncCat (RecType ls) _ _) <- tree2list $ jments m,
+    Lbg (L (IC "p")) (TInts n) <- ls
+    ]
+  precedences = [(f,(prec,assoc))  | 
+    (_,ModMod m) <- modules gr,
+    (f,CncFun _ _ (R lin) _) <- tree2list $ jments m,
+    (Just prec, Just assoc) <- [(
+       lookup "p" [(lab,p) | Ass (L (IC lab)) (EInt p) <- lin],
+       lookup "a" [(lab,a) | Ass (L (IC lab)) (Con (CIQ _ (IC a)) []) <- lin]
+       )]
+    ]
+  precfuns = map fst precedences
+  mkRule r@(fun@(CFFun (t, p)),(cat,its)) = case t of
+    AC (CIQ _ c) -> case lookup c precedences of
+      Just (prec,assoc) -> [(fun,(mkCat prec cat,mkIts cat prec assoc 0 its))]
+      _ -> return r
+    AD (CIQ _ c) -> case lookup c precedences of
+      Just (prec,assoc) -> [(fun,(mkCat prec cat,mkIts cat prec assoc 0 its))]
+      _ -> return r
+    _ -> return r
+  mkIts cat prec assoc i its = case its of
+    CFTerm (RegAlts ["("]):n@(CFNonterm k):CFTerm (RegAlts [")"]):rest | k==cat -> 
+      mkIts cat prec assoc i $ n:rest  -- remove variants with parentheses 
+    CFNonterm k:rest | k==cat -> 
+      CFNonterm (mkNonterm prec assoc i k) : mkIts cat prec assoc (i+1) rest
+    it:rest -> it:mkIts cat prec assoc i rest
+    [] -> []
+
+  mkCat prec (CFCat ((CIQ m (IC c)),l)) = CFCat ((CIQ m (IC (c ++ show prec ++ "+"))),l)
+  mkNonterm prec assoc i cat = mkCat prec' cat 
+    where 
+      prec' = case (assoc,i) of
+        ("PL",0) -> prec
+        ("PR",0) -> prec + 1
+        ("PR",_) -> prec
+        _        -> prec + 1
+
 catId ((CFCat ((CIQ _ c),l))) = c
 
 prCFRule :: [Ident] -> CFRule -> String
@@ -50,6 +102,7 @@ prId b i = case i of
      IC "#Var" -> "Ident"
      IC "Var"  -> "Ident"
      IC "id_"  -> "_"
+     IC s@(c:_) | last s == '+' -> init s  -- hack to save precedence information
      IC s@(c:_) | isUpper c -> s ++ if isDigit (last s) then "_" else ""
      _ -> prErr b $ prt i
 

src/GF/UseGrammar/Custom.hs

@@ -194,8 +194,9 @@ customGrammarPrinter =
   ,(strCI "gsl",     \s -> let opts = stateOptions s
                                name = cncId s
                             in gslPrinter name opts $ Cnv.cfg $ statePInfo s)
-  ,(strCI "lbnf",    prLBNF . stateCF)
+  ,(strCI "plbnf",   prLBNF True)
-  ,(strCI "bnf",     prBNF . stateCF)
+  ,(strCI "lbnf",    prLBNF False)
+  ,(strCI "bnf",     prBNF False)
   ,(strCI "haskell", grammar2haskell . stateGrammarST)
   ,(strCI "morpho",  prMorpho . stateMorpho)
   ,(strCI "fullform",prFullForm . stateMorpho)