forked from GitHub/gf-core
reorganize the directories under src, and rescue the JavaScript interpreter from deprecated
This commit is contained in:
krasimir
169
src/compiler/GF/JavaScript/PrintJS.hs
Normal file
169
src/compiler/GF/JavaScript/PrintJS.hs
Normal file
@@ -0,0 +1,169 @@
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||
module GF.JavaScript.PrintJS (printTree, Doc, Print(..)) where
|
||||
|
||||
-- pretty-printer generated by the BNF converter
|
||||
|
||||
import GF.JavaScript.AbsJS
|
||||
import Data.Char
|
||||
|
||||
-- the top-level printing method
|
||||
printTree :: Print a => a -> String
|
||||
printTree = render . prt 0
|
||||
|
||||
type Doc = [ShowS] -> [ShowS]
|
||||
|
||||
doc :: ShowS -> Doc
|
||||
doc = (:)
|
||||
|
||||
render :: Doc -> String
|
||||
render d = rend 0 (map ($ "") $ d []) "" where
|
||||
rend i ss = case ss of
|
||||
t:ts | not (spaceAfter t) -> showString t . rend i ts
|
||||
t:ts@(t':_) | not (spaceBefore t') -> showString t . rend i ts
|
||||
t:ts -> space t . rend i ts
|
||||
[] -> id
|
||||
new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
|
||||
space t = showString t . (\s -> if null s then "" else (' ':s))
|
||||
|
||||
spaceAfter :: String -> Bool
|
||||
spaceAfter = (`notElem` [".","(","[","{","\n"])
|
||||
|
||||
spaceBefore :: String -> Bool
|
||||
spaceBefore = (`notElem` [",",".",":",";","(",")","[","]","{","}","\n"])
|
||||
|
||||
parenth :: Doc -> Doc
|
||||
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
|
||||
|
||||
concatS :: [ShowS] -> ShowS
|
||||
concatS = foldr (.) id
|
||||
|
||||
concatD :: [Doc] -> Doc
|
||||
concatD = foldr (.) id
|
||||
|
||||
replicateS :: Int -> ShowS -> ShowS
|
||||
replicateS n f = concatS (replicate n f)
|
||||
|
||||
-- the printer class does the job
|
||||
class Print a where
|
||||
prt :: Int -> a -> Doc
|
||||
prtList :: [a] -> Doc
|
||||
prtList = concatD . map (prt 0)
|
||||
|
||||
instance Print a => Print [a] where
|
||||
prt _ = prtList
|
||||
|
||||
instance Print Char where
|
||||
prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
|
||||
prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
|
||||
|
||||
mkEsc :: Char -> Char -> ShowS
|
||||
mkEsc q s = case s of
|
||||
_ | s == q -> showChar '\\' . showChar s
|
||||
'\\'-> showString "\\\\"
|
||||
'\n' -> showString "\\n"
|
||||
'\t' -> showString "\\t"
|
||||
_ -> showChar s
|
||||
|
||||
prPrec :: Int -> Int -> Doc -> Doc
|
||||
prPrec i j = if j<i then parenth else id
|
||||
|
||||
|
||||
instance Print Int where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
|
||||
instance Print Double where
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
|
||||
instance Print Ident where
|
||||
prt _ (Ident i) = doc (showString i)
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
|
||||
|
||||
instance Print Program where
|
||||
prt i e = case e of
|
||||
Program elements -> prPrec i 0 (concatD [prt 0 elements])
|
||||
|
||||
|
||||
instance Print Element where
|
||||
prt i e = case e of
|
||||
FunDef id ids stmts -> prPrec i 0 (concatD [doc (showString "function") , prt 0 id , doc (showString "(") , prt 0 ids , doc (showString ")") , doc (showString "{") , prt 0 stmts , doc (showString "}")])
|
||||
ElStmt stmt -> prPrec i 0 (concatD [prt 0 stmt])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "\n"), prt 0 xs]) -- HACKED!
|
||||
|
||||
instance Print Stmt where
|
||||
prt i e = case e of
|
||||
SCompound stmts -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stmts , doc (showString "}")])
|
||||
SReturnVoid -> prPrec i 0 (concatD [doc (showString "return") , doc (showString ";")])
|
||||
SReturn expr -> prPrec i 0 (concatD [doc (showString "return") , prt 0 expr , doc (showString ";")])
|
||||
SDeclOrExpr declorexpr -> prPrec i 0 (concatD [prt 0 declorexpr , doc (showString ";")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print DeclOrExpr where
|
||||
prt i e = case e of
|
||||
Decl declvars -> prPrec i 0 (concatD [doc (showString "var") , prt 0 declvars])
|
||||
DExpr expr -> prPrec i 0 (concatD [prt 1 expr])
|
||||
|
||||
|
||||
instance Print DeclVar where
|
||||
prt i e = case e of
|
||||
DVar id -> prPrec i 0 (concatD [prt 0 id])
|
||||
DInit id expr -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 expr])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Expr where
|
||||
prt i e = case e of
|
||||
EAssign expr0 expr -> prPrec i 13 (concatD [prt 14 expr0 , doc (showString "=") , prt 13 expr])
|
||||
ENew id exprs -> prPrec i 14 (concatD [doc (showString "new") , prt 0 id , doc (showString "(") , prt 0 exprs , doc (showString ")")])
|
||||
EMember expr id -> prPrec i 15 (concatD [prt 15 expr , doc (showString ".") , prt 0 id])
|
||||
EIndex expr0 expr -> prPrec i 15 (concatD [prt 15 expr0 , doc (showString "[") , prt 0 expr , doc (showString "]")])
|
||||
ECall expr exprs -> prPrec i 15 (concatD [prt 15 expr , doc (showString "(") , prt 0 exprs , doc (showString ")")])
|
||||
EVar id -> prPrec i 16 (concatD [prt 0 id])
|
||||
EInt n -> prPrec i 16 (concatD [prt 0 n])
|
||||
EDbl d -> prPrec i 16 (concatD [prt 0 d])
|
||||
EStr str -> prPrec i 16 (concatD [prt 0 str])
|
||||
ETrue -> prPrec i 16 (concatD [doc (showString "true")])
|
||||
EFalse -> prPrec i 16 (concatD [doc (showString "false")])
|
||||
ENull -> prPrec i 16 (concatD [doc (showString "null")])
|
||||
EThis -> prPrec i 16 (concatD [doc (showString "this")])
|
||||
EFun ids stmts -> prPrec i 16 (concatD [doc (showString "function") , doc (showString "(") , prt 0 ids , doc (showString ")") , doc (showString "{") , prt 0 stmts , doc (showString "}")])
|
||||
EArray exprs -> prPrec i 16 (concatD [doc (showString "[") , prt 0 exprs , doc (showString "]")])
|
||||
EObj propertys -> prPrec i 16 (concatD [doc (showString "{") , prt 0 propertys , doc (showString "}")])
|
||||
ESeq exprs -> prPrec i 16 (concatD [doc (showString "(") , prt 0 exprs , doc (showString ")")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Property where
|
||||
prt i e = case e of
|
||||
Prop propertyname expr -> prPrec i 0 (concatD [prt 0 propertyname , doc (showString ":") , prt 0 expr])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print PropertyName where
|
||||
prt i e = case e of
|
||||
IdentPropName id -> prPrec i 0 (concatD [prt 0 id])
|
||||
StringPropName str -> prPrec i 0 (concatD [prt 0 str])
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user