mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-27 21:42:50 -06:00
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
This commit is contained in:
36
src-3.0/GF/GFCC/Raw/PrintGFCCRaw.hs
Normal file
36
src-3.0/GF/GFCC/Raw/PrintGFCCRaw.hs
Normal file
@@ -0,0 +1,36 @@
|
||||
module GF.GFCC.Raw.PrintGFCCRaw (printTree) where
|
||||
|
||||
import GF.GFCC.Raw.AbsGFCCRaw
|
||||
|
||||
import Data.List (intersperse)
|
||||
import Numeric (showFFloat)
|
||||
|
||||
printTree :: Grammar -> String
|
||||
printTree g = prGrammar g ""
|
||||
|
||||
prGrammar :: Grammar -> ShowS
|
||||
prGrammar (Grm xs) = prRExpList xs
|
||||
|
||||
prRExp :: Int -> RExp -> ShowS
|
||||
prRExp _ (App x []) = prCId x
|
||||
prRExp n (App x xs) = p (prCId x . showChar ' ' . prRExpList xs)
|
||||
where p s = if n == 0 then s else showChar '(' . s . showChar ')'
|
||||
prRExp _ (AInt x) = shows x
|
||||
prRExp _ (AStr x) = showChar '"' . concatS (map mkEsc x) . showChar '"'
|
||||
prRExp _ (AFlt x) = showFFloat Nothing x
|
||||
prRExp _ AMet = showChar '?'
|
||||
|
||||
mkEsc :: Char -> ShowS
|
||||
mkEsc s = case s of
|
||||
'"' -> showString "\\\""
|
||||
'\\' -> showString "\\\\"
|
||||
_ -> showChar s
|
||||
|
||||
prRExpList :: [RExp] -> ShowS
|
||||
prRExpList = concatS . intersperse (showChar ' ') . map (prRExp 1)
|
||||
|
||||
prCId :: CId -> ShowS
|
||||
prCId (CId x) = showString x
|
||||
|
||||
concatS :: [ShowS] -> ShowS
|
||||
concatS = foldr (.) id
|
||||
Reference in New Issue
Block a user