diff --git a/examples/gfcc/complin.tex b/examples/gfcc/complin.tex index accad0bda..32fdb87a7 100644 --- a/examples/gfcc/complin.tex +++ b/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} diff --git a/src/GF/CF/PrLBNF.hs b/src/GF/CF/PrLBNF.hs index 701674a52..fe06cbf9e 100644 --- a/src/GF/CF/PrLBNF.hs +++ b/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 cf = unlines $ (map (prCFRule cs)) $ rulesOfCF cf --- no literal recogn function +prLBNF :: Bool -> StateGrammar -> String +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 = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF +prBNF :: Bool -> StateGrammar -> String +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 diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 643c16661..9119b8f36 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/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 "bnf", prBNF . stateCF) + ,(strCI "plbnf", prLBNF True) + ,(strCI "lbnf", prLBNF False) + ,(strCI "bnf", prBNF False) ,(strCI "haskell", grammar2haskell . stateGrammarST) ,(strCI "morpho", prMorpho . stateMorpho) ,(strCI "fullform",prFullForm . stateMorpho)