mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-11 05:49:31 -06:00
changed names of resource-1.3; added a note on homepage on release
This commit is contained in:
aarne
60
src/GF/JavaScript/AbsJS.hs
Normal file
60
src/GF/JavaScript/AbsJS.hs
Normal file
@@ -0,0 +1,60 @@
|
||||
module GF.JavaScript.AbsJS where
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
newtype Ident = Ident String deriving (Eq,Ord,Show)
|
||||
data Program =
|
||||
Program [Element]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Element =
|
||||
FunDef Ident [Ident] [Stmt]
|
||||
| ElStmt Stmt
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Stmt =
|
||||
SCompound [Stmt]
|
||||
| SReturnVoid
|
||||
| SReturn Expr
|
||||
| SDeclOrExpr DeclOrExpr
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DeclOrExpr =
|
||||
Decl [DeclVar]
|
||||
| DExpr Expr
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DeclVar =
|
||||
DVar Ident
|
||||
| DInit Ident Expr
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Expr =
|
||||
EAssign Expr Expr
|
||||
| ENew Ident [Expr]
|
||||
| EMember Expr Ident
|
||||
| EIndex Expr Expr
|
||||
| ECall Expr [Expr]
|
||||
| EVar Ident
|
||||
| EInt Int
|
||||
| EDbl Double
|
||||
| EStr String
|
||||
| ETrue
|
||||
| EFalse
|
||||
| ENull
|
||||
| EThis
|
||||
| EFun [Ident] [Stmt]
|
||||
| EArray [Expr]
|
||||
| EObj [Property]
|
||||
| ESeq [Expr]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Property =
|
||||
Prop PropertyName Expr
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data PropertyName =
|
||||
IdentPropName Ident
|
||||
| StringPropName String
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
55
src/GF/JavaScript/JS.cf
Normal file
55
src/GF/JavaScript/JS.cf
Normal file
@@ -0,0 +1,55 @@
|
||||
entrypoints Program;
|
||||
|
||||
Program. Program ::= [Element];
|
||||
|
||||
FunDef. Element ::= "function" Ident "(" [Ident] ")" "{" [Stmt] "}" ;
|
||||
ElStmt. Element ::= Stmt;
|
||||
separator Element "" ;
|
||||
|
||||
separator Ident "," ;
|
||||
|
||||
SCompound. Stmt ::= "{" [Stmt] "}" ;
|
||||
SReturnVoid. Stmt ::= "return" ";" ;
|
||||
SReturn. Stmt ::= "return" Expr ";" ;
|
||||
SDeclOrExpr. Stmt ::= DeclOrExpr ";" ;
|
||||
separator Stmt "" ;
|
||||
|
||||
Decl. DeclOrExpr ::= "var" [DeclVar];
|
||||
DExpr. DeclOrExpr ::= Expr1 ;
|
||||
|
||||
DVar. DeclVar ::= Ident ;
|
||||
DInit. DeclVar ::= Ident "=" Expr ;
|
||||
separator DeclVar "," ;
|
||||
|
||||
EAssign. Expr13 ::= Expr14 "=" Expr13 ;
|
||||
|
||||
ENew. Expr14 ::= "new" Ident "(" [Expr] ")" ;
|
||||
|
||||
EMember. Expr15 ::= Expr15 "." Ident ;
|
||||
EIndex. Expr15 ::= Expr15 "[" Expr "]" ;
|
||||
ECall. Expr15 ::= Expr15 "(" [Expr] ")" ;
|
||||
|
||||
EVar. Expr16 ::= Ident ;
|
||||
EInt. Expr16 ::= Integer ;
|
||||
EDbl. Expr16 ::= Double ;
|
||||
EStr. Expr16 ::= String ;
|
||||
ETrue. Expr16 ::= "true" ;
|
||||
EFalse. Expr16 ::= "false" ;
|
||||
ENull. Expr16 ::= "null" ;
|
||||
EThis. Expr16 ::= "this" ;
|
||||
EFun. Expr16 ::= "function" "(" [Ident] ")" "{" [Stmt] "}" ;
|
||||
EArray. Expr16 ::= "[" [Expr] "]" ;
|
||||
EObj. Expr16 ::= "{" [Property] "}" ;
|
||||
|
||||
eseq1. Expr16 ::= "(" Expr "," [Expr] ")";
|
||||
internal ESeq. Expr16 ::= "(" [Expr] ")" ;
|
||||
define eseq1 x xs = ESeq (x:xs);
|
||||
|
||||
separator Expr "," ;
|
||||
coercions Expr 16 ;
|
||||
|
||||
Prop. Property ::= PropertyName ":" Expr ;
|
||||
separator Property "," ;
|
||||
|
||||
IdentPropName. PropertyName ::= Ident ;
|
||||
StringPropName. PropertyName ::= String ;
|
||||
132
src/GF/JavaScript/LexJS.x
Normal file
132
src/GF/JavaScript/LexJS.x
Normal file
@@ -0,0 +1,132 @@
|
||||
-- -*- haskell -*-
|
||||
-- This Alex file was machine-generated by the BNF converter
|
||||
{
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns #-}
|
||||
module GF.JavaScript.LexJS where
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
|
||||
$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
|
||||
$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
|
||||
$d = [0-9] -- digit
|
||||
$i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- symbols and non-identifier-like reserved words
|
||||
\( | \) | \{ | \} | \, | \; | \= | \. | \[ | \] | \:
|
||||
|
||||
:-
|
||||
|
||||
$white+ ;
|
||||
@rsyms { tok (\p s -> PT p (TS $ share s)) }
|
||||
|
||||
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||
|
||||
{
|
||||
|
||||
tok f p s = f p s
|
||||
|
||||
share :: String -> String
|
||||
share = id
|
||||
|
||||
data Tok =
|
||||
TS !String -- reserved words and symbols
|
||||
| TL !String -- string literals
|
||||
| TI !String -- integer literals
|
||||
| TV !String -- identifiers
|
||||
| TD !String -- double precision float literals
|
||||
| TC !String -- character literals
|
||||
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
data Token =
|
||||
PT Posn Tok
|
||||
| Err Posn
|
||||
deriving (Eq,Show,Ord)
|
||||
|
||||
tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
|
||||
tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
|
||||
tokenPos _ = "end of file"
|
||||
|
||||
posLineCol (Pn _ l c) = (l,c)
|
||||
mkPosToken t@(PT p _) = (posLineCol p, prToken t)
|
||||
|
||||
prToken t = case t of
|
||||
PT _ (TS s) -> s
|
||||
PT _ (TI s) -> s
|
||||
PT _ (TV s) -> s
|
||||
PT _ (TD s) -> s
|
||||
PT _ (TC s) -> s
|
||||
|
||||
_ -> show t
|
||||
|
||||
data BTree = N | B String Tok BTree BTree deriving (Show)
|
||||
|
||||
eitherResIdent :: (String -> Tok) -> String -> Tok
|
||||
eitherResIdent tv s = treeFind resWords
|
||||
where
|
||||
treeFind N = tv s
|
||||
treeFind (B a t left right) | s < a = treeFind left
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
resWords = b "return" (b "new" (b "function" (b "false" N N) N) (b "null" N N)) (b "true" (b "this" N N) (b "var" N N))
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
unescapeInitTail = unesc . tail where
|
||||
unesc s = case s of
|
||||
'\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
|
||||
'\\':'n':cs -> '\n' : unesc cs
|
||||
'\\':'t':cs -> '\t' : unesc cs
|
||||
'"':[] -> []
|
||||
c:cs -> c : unesc cs
|
||||
_ -> []
|
||||
|
||||
-------------------------------------------------------------------
|
||||
-- Alex wrapper code.
|
||||
-- A modified "posn" wrapper.
|
||||
-------------------------------------------------------------------
|
||||
|
||||
data Posn = Pn !Int !Int !Int
|
||||
deriving (Eq, Show,Ord)
|
||||
|
||||
alexStartPos :: Posn
|
||||
alexStartPos = Pn 0 1 1
|
||||
|
||||
alexMove :: Posn -> Char -> Posn
|
||||
alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
|
||||
alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
|
||||
alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
|
||||
|
||||
type AlexInput = (Posn, -- current position,
|
||||
Char, -- previous char
|
||||
String) -- current input string
|
||||
|
||||
tokens :: String -> [Token]
|
||||
tokens str = go (alexStartPos, '\n', str)
|
||||
where
|
||||
go :: (Posn, Char, String) -> [Token]
|
||||
go inp@(pos, _, str) =
|
||||
case alexScan inp 0 of
|
||||
AlexEOF -> []
|
||||
AlexError (pos, _, _) -> [Err pos]
|
||||
AlexSkip inp' len -> go inp'
|
||||
AlexToken inp' len act -> act pos (take len str) : (go inp')
|
||||
|
||||
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
|
||||
alexGetChar (p, c, []) = Nothing
|
||||
alexGetChar (p, _, (c:s)) =
|
||||
let p' = alexMove p c
|
||||
in p' `seq` Just (c, (p', c, s))
|
||||
|
||||
alexInputPrevChar :: AlexInput -> Char
|
||||
alexInputPrevChar (p, c, s) = c
|
||||
}
|
||||
14
src/GF/JavaScript/Makefile
Normal file
14
src/GF/JavaScript/Makefile
Normal file
@@ -0,0 +1,14 @@
|
||||
all:
|
||||
happy -gca ParJS.y
|
||||
alex -g LexJS.x
|
||||
|
||||
bnfc:
|
||||
(cd ../.. && bnfc -p GF.JavaScript GF/JavaScript/JS.cf)
|
||||
-rm -f *.bak
|
||||
|
||||
clean:
|
||||
-rm -f *.log *.aux *.hi *.o *.dvi
|
||||
-rm -f DocJS.ps
|
||||
distclean: clean
|
||||
-rm -f DocJS.* LexJS.* ParJS.* LayoutJS.* SkelJS.* PrintJS.* TestJS.* AbsJS.* TestJS ErrM.* SharedString.* JS.dtd XMLJS.* Makefile*
|
||||
|
||||
225
src/GF/JavaScript/ParJS.y
Normal file
225
src/GF/JavaScript/ParJS.y
Normal file
@@ -0,0 +1,225 @@
|
||||
-- This Happy file was machine-generated by the BNF converter
|
||||
{
|
||||
{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
|
||||
module GF.JavaScript.ParJS where
|
||||
import GF.JavaScript.AbsJS
|
||||
import GF.JavaScript.LexJS
|
||||
import GF.Data.ErrM
|
||||
}
|
||||
|
||||
%name pProgram Program
|
||||
|
||||
-- no lexer declaration
|
||||
%monad { Err } { thenM } { returnM }
|
||||
%tokentype { Token }
|
||||
|
||||
%token
|
||||
'(' { PT _ (TS "(") }
|
||||
')' { PT _ (TS ")") }
|
||||
'{' { PT _ (TS "{") }
|
||||
'}' { PT _ (TS "}") }
|
||||
',' { PT _ (TS ",") }
|
||||
';' { PT _ (TS ";") }
|
||||
'=' { PT _ (TS "=") }
|
||||
'.' { PT _ (TS ".") }
|
||||
'[' { PT _ (TS "[") }
|
||||
']' { PT _ (TS "]") }
|
||||
':' { PT _ (TS ":") }
|
||||
'false' { PT _ (TS "false") }
|
||||
'function' { PT _ (TS "function") }
|
||||
'new' { PT _ (TS "new") }
|
||||
'null' { PT _ (TS "null") }
|
||||
'return' { PT _ (TS "return") }
|
||||
'this' { PT _ (TS "this") }
|
||||
'true' { PT _ (TS "true") }
|
||||
'var' { PT _ (TS "var") }
|
||||
|
||||
L_ident { PT _ (TV $$) }
|
||||
L_integ { PT _ (TI $$) }
|
||||
L_doubl { PT _ (TD $$) }
|
||||
L_quoted { PT _ (TL $$) }
|
||||
L_err { _ }
|
||||
|
||||
|
||||
%%
|
||||
|
||||
Ident :: { Ident } : L_ident { Ident $1 }
|
||||
Integer :: { Integer } : L_integ { (read $1) :: Integer }
|
||||
Double :: { Double } : L_doubl { (read $1) :: Double }
|
||||
String :: { String } : L_quoted { $1 }
|
||||
|
||||
Program :: { Program }
|
||||
Program : ListElement { Program (reverse $1) }
|
||||
|
||||
|
||||
Element :: { Element }
|
||||
Element : 'function' Ident '(' ListIdent ')' '{' ListStmt '}' { FunDef $2 $4 (reverse $7) }
|
||||
| Stmt { ElStmt $1 }
|
||||
|
||||
|
||||
ListElement :: { [Element] }
|
||||
ListElement : {- empty -} { [] }
|
||||
| ListElement Element { flip (:) $1 $2 }
|
||||
|
||||
|
||||
ListIdent :: { [Ident] }
|
||||
ListIdent : {- empty -} { [] }
|
||||
| Ident { (:[]) $1 }
|
||||
| Ident ',' ListIdent { (:) $1 $3 }
|
||||
|
||||
|
||||
Stmt :: { Stmt }
|
||||
Stmt : '{' ListStmt '}' { SCompound (reverse $2) }
|
||||
| 'return' ';' { SReturnVoid }
|
||||
| 'return' Expr ';' { SReturn $2 }
|
||||
| DeclOrExpr ';' { SDeclOrExpr $1 }
|
||||
|
||||
|
||||
ListStmt :: { [Stmt] }
|
||||
ListStmt : {- empty -} { [] }
|
||||
| ListStmt Stmt { flip (:) $1 $2 }
|
||||
|
||||
|
||||
DeclOrExpr :: { DeclOrExpr }
|
||||
DeclOrExpr : 'var' ListDeclVar { Decl $2 }
|
||||
| Expr1 { DExpr $1 }
|
||||
|
||||
|
||||
DeclVar :: { DeclVar }
|
||||
DeclVar : Ident { DVar $1 }
|
||||
| Ident '=' Expr { DInit $1 $3 }
|
||||
|
||||
|
||||
ListDeclVar :: { [DeclVar] }
|
||||
ListDeclVar : {- empty -} { [] }
|
||||
| DeclVar { (:[]) $1 }
|
||||
| DeclVar ',' ListDeclVar { (:) $1 $3 }
|
||||
|
||||
|
||||
Expr13 :: { Expr }
|
||||
Expr13 : Expr14 '=' Expr13 { EAssign $1 $3 }
|
||||
| Expr14 { $1 }
|
||||
|
||||
|
||||
Expr14 :: { Expr }
|
||||
Expr14 : 'new' Ident '(' ListExpr ')' { ENew $2 $4 }
|
||||
| Expr15 { $1 }
|
||||
|
||||
|
||||
Expr15 :: { Expr }
|
||||
Expr15 : Expr15 '.' Ident { EMember $1 $3 }
|
||||
| Expr15 '[' Expr ']' { EIndex $1 $3 }
|
||||
| Expr15 '(' ListExpr ')' { ECall $1 $3 }
|
||||
| Expr16 { $1 }
|
||||
|
||||
|
||||
Expr16 :: { Expr }
|
||||
Expr16 : Ident { EVar $1 }
|
||||
| Integer { EInt $1 }
|
||||
| Double { EDbl $1 }
|
||||
| String { EStr $1 }
|
||||
| 'true' { ETrue }
|
||||
| 'false' { EFalse }
|
||||
| 'null' { ENull }
|
||||
| 'this' { EThis }
|
||||
| 'function' '(' ListIdent ')' '{' ListStmt '}' { EFun $3 (reverse $6) }
|
||||
| '[' ListExpr ']' { EArray $2 }
|
||||
| '{' ListProperty '}' { EObj $2 }
|
||||
| '(' Expr ',' ListExpr ')' { eseq1_ $2 $4 }
|
||||
| '(' Expr ')' { $2 }
|
||||
|
||||
|
||||
ListExpr :: { [Expr] }
|
||||
ListExpr : {- empty -} { [] }
|
||||
| Expr { (:[]) $1 }
|
||||
| Expr ',' ListExpr { (:) $1 $3 }
|
||||
|
||||
|
||||
Expr :: { Expr }
|
||||
Expr : Expr1 { $1 }
|
||||
|
||||
|
||||
Expr1 :: { Expr }
|
||||
Expr1 : Expr2 { $1 }
|
||||
|
||||
|
||||
Expr2 :: { Expr }
|
||||
Expr2 : Expr3 { $1 }
|
||||
|
||||
|
||||
Expr3 :: { Expr }
|
||||
Expr3 : Expr4 { $1 }
|
||||
|
||||
|
||||
Expr4 :: { Expr }
|
||||
Expr4 : Expr5 { $1 }
|
||||
|
||||
|
||||
Expr5 :: { Expr }
|
||||
Expr5 : Expr6 { $1 }
|
||||
|
||||
|
||||
Expr6 :: { Expr }
|
||||
Expr6 : Expr7 { $1 }
|
||||
|
||||
|
||||
Expr7 :: { Expr }
|
||||
Expr7 : Expr8 { $1 }
|
||||
|
||||
|
||||
Expr8 :: { Expr }
|
||||
Expr8 : Expr9 { $1 }
|
||||
|
||||
|
||||
Expr9 :: { Expr }
|
||||
Expr9 : Expr10 { $1 }
|
||||
|
||||
|
||||
Expr10 :: { Expr }
|
||||
Expr10 : Expr11 { $1 }
|
||||
|
||||
|
||||
Expr11 :: { Expr }
|
||||
Expr11 : Expr12 { $1 }
|
||||
|
||||
|
||||
Expr12 :: { Expr }
|
||||
Expr12 : Expr13 { $1 }
|
||||
|
||||
|
||||
Property :: { Property }
|
||||
Property : PropertyName ':' Expr { Prop $1 $3 }
|
||||
|
||||
|
||||
ListProperty :: { [Property] }
|
||||
ListProperty : {- empty -} { [] }
|
||||
| Property { (:[]) $1 }
|
||||
| Property ',' ListProperty { (:) $1 $3 }
|
||||
|
||||
|
||||
PropertyName :: { PropertyName }
|
||||
PropertyName : Ident { IdentPropName $1 }
|
||||
| String { StringPropName $1 }
|
||||
|
||||
|
||||
|
||||
{
|
||||
|
||||
returnM :: a -> Err a
|
||||
returnM = return
|
||||
|
||||
thenM :: Err a -> (a -> Err b) -> Err b
|
||||
thenM = (>>=)
|
||||
|
||||
happyError :: [Token] -> Err a
|
||||
happyError ts =
|
||||
Bad $ "syntax error at " ++ tokenPos ts ++
|
||||
case ts of
|
||||
[] -> []
|
||||
[Err _] -> " due to lexer error"
|
||||
_ -> " before " ++ unwords (map prToken (take 4 ts))
|
||||
|
||||
myLexer = tokens
|
||||
eseq1_ x_ xs_ = ESeq (x_ : xs_)
|
||||
}
|
||||
|
||||
169
src/GF/JavaScript/PrintJS.hs
Normal file
169
src/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