summaryrefslogtreecommitdiff
path: root/src/full/Agda/Compiler/JS/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/full/Agda/Compiler/JS/Parser.hs')
-rw-r--r--src/full/Agda/Compiler/JS/Parser.hs185
1 files changed, 0 insertions, 185 deletions
diff --git a/src/full/Agda/Compiler/JS/Parser.hs b/src/full/Agda/Compiler/JS/Parser.hs
deleted file mode 100644
index 74d04cd..0000000
--- a/src/full/Agda/Compiler/JS/Parser.hs
+++ /dev/null
@@ -1,185 +0,0 @@
-module Agda.Compiler.JS.Parser where
-
--- This is a simple parser for the ECMAScript FFI, which parses a
--- subset of ECMAscript expressions. We do this so that we can
--- optimize code that contains FFI expressions, for example
--- {-# COMPILED_JS _+_ function (x) { return function (y) { return x+y; }; } #-}
--- will generate ECMAScript "1 + 2" from Agda "1 + 2".
-
-import Prelude hiding ( exp, lookup )
-import Data.List ( genericLength )
-import Data.Char ( isLetter, isAlphaNum, isDigit )
-import Data.Map ( Map, fromList, union, empty )
-import qualified Data.Map as M
-
-import Agda.Utils.Parser.ReadP
- ( ReadP, (+++), (<++), between, char, choice, look, many,
- munch, munch1, parse', pfail, satisfy, sepBy, string, skipSpaces )
-
-import Agda.Syntax.Common ( Nat )
-import Agda.Compiler.JS.Syntax
- ( LocalId(LocalId), GlobalId(GlobalId), MemberId(MemberId),
- Exp(Local,Global,Undefined,String,Integer,Lambda,Apply,Object,Lookup,If,BinOp,PreOp,Const) )
-
-type Parser = ReadP Char
-
-identifier :: Parser String
-identifier = do
- c <- satisfy isLetter
- cs <- munch isAlphaNum
- skipSpaces
- return (c : cs)
-
-wordBoundary :: Parser ()
-wordBoundary = do
- cs <- look
- case cs of
- (c:_) | isAlphaNum c -> pfail
- _ -> return ()
-
-token :: String -> Parser ()
-token s = string s >> wordBoundary >> skipSpaces
-
-punct :: Char -> Parser ()
-punct c = char c >> skipSpaces
-
-parened :: Parser a -> Parser a
-parened = between (punct '(') (punct ')')
-
-braced :: Parser a -> Parser a
-braced = between (punct '{') (punct '}')
-
-bracketed :: Parser a -> Parser a
-bracketed = between (punct '[') (punct ']')
-
-quoted :: Parser a -> Parser a
-quoted = between (char '"') (punct '"')
-
-stringLit :: Parser Exp
-stringLit = do s <- stringStr; return (String s)
-
-stringStr :: Parser String
-stringStr = quoted (many stringChr)
-
-stringChr :: Parser Char
-stringChr = satisfy (`notElem` "\\\"") +++ escChr
-
--- Not handling all escape sequences
-escChr :: Parser Char
-escChr = char '\\' >> (
- (char 'n' >> return '\n') +++
- (char 'r' >> return '\r') +++
- (char 't' >> return '\t') +++
- (char '"' >> return '"') +++
- (char '\\' >> return '\\')
- )
-
--- Not handling all integer constants
-intLit :: Parser Exp
-intLit = do s <- munch1 isDigit; skipSpaces; return (Integer (read s))
-
-undef :: Parser Exp
-undef = token "undefined" >> return Undefined
-
-localid :: (Map String Nat) -> Parser Exp
-localid m = do
- s <- identifier
- case M.lookup s m of
- Nothing -> return (Const s)
- Just i -> return (Local (LocalId i))
-
-globalid :: Parser Exp
-globalid = do
- token "require"
- i <- parened (quoted (sepBy (munch1 isAlphaNum) (char '.')))
- return (Global (GlobalId i))
-
-preop :: Parser String
-preop = do
- op <- choice (map string [ "+", "-", "!" ])
- skipSpaces
- return op
-
-binop :: Parser String
-binop = do
- op <- choice (map string [
- "<", ">", "<=", ">=", "==", "===", "<<", ">>",
- "<<<", ">>>", "!=", "!==", "+", "-", "*", "%", "/",
- "&", "&&", "|", "||", "^"
- ])
- skipSpaces
- return op
-
-field :: (Map String Nat) -> Parser (MemberId,Exp)
-field m = do
- l <- stringStr
- punct ':'
- e <- exp m
- return (MemberId l, e)
-
-object :: (Map String Nat) -> Parser Exp
-object m = do
- o <- braced (sepBy (field m) (punct ','))
- return (Object (fromList o))
-
-function :: (Map String Nat) -> Parser Exp
-function m = do
- token "function"
- xs <- parened (sepBy identifier (punct ','))
- n <- return (genericLength xs)
- m' <- return (union (fromList (zip xs [n-1,n-2..0])) (M.map (+n) m))
- e <- bracedBlock m'
- return (Lambda n e)
-
-bracedBlock :: (Map String Nat) -> Parser Exp
-bracedBlock m = braced (returnBlock m +++ ifBlock m +++ bracedBlock m)
-
-returnBlock :: (Map String Nat) -> Parser Exp
-returnBlock m = between (token "return") (punct ';') (exp m)
-
-ifBlock :: (Map String Nat) -> Parser Exp
-ifBlock m = do
- token "if"
- e <- parened (exp m)
- f <- bracedBlock m
- token "else"
- g <- (ifBlock m +++ bracedBlock m)
- return (If e f g)
-
-exp0 :: (Map String Nat) -> Parser Exp
-exp0 m = function m <++ undef <++ globalid <++ localid m <++
- object m <++ stringLit <++ intLit <++ parened (exp m)
-
-exp1 :: (Map String Nat) -> Parser Exp
-exp1 m =
- (do op <- preop; e <- exp1 m; return (PreOp op e)) <++
- (exp0 m)
-
-exp2 :: (Map String Nat) -> Parser Exp
-exp2 m = exp1 m >>= exp2' m
-
--- Not handling operator fixity or precedence
-exp2' :: (Map String Nat) -> Exp -> Parser Exp
-exp2' m e =
- (do es <- parened (sepBy (exp m) (punct ',')); exp2' m (Apply e es)) <++
- (do i <- bracketed stringStr; exp2' m (Lookup e (MemberId i))) <++
- (do punct '.'; i <- identifier; exp2' m (Lookup e (MemberId i))) <++
- (do op <- binop; f <- exp0 m; exp2' m (BinOp e op f)) <++
- (return e)
-
-exp3 :: (Map String Nat) -> Parser Exp
-exp3 m = exp2 m >>= exp3' m
-
-exp3' :: (Map String Nat) -> Exp -> Parser Exp
-exp3' m e =
- (do punct '?'; f <- exp2 m; punct ':'; g <- exp2 m; return (If e f g)) <++
- (return e)
-
-exp :: (Map String Nat) -> Parser Exp
-exp = exp3
-
-topLevel :: Parser Exp
-topLevel = skipSpaces >> exp empty
-
-parse :: String -> Either Exp String
-parse = parse' topLevel