--- a/tools/pas2c/PascalParser.hs Thu Feb 06 23:02:35 2014 +0400
+++ b/tools/pas2c/PascalParser.hs Fri Feb 07 00:46:49 2014 +0400
@@ -1,13 +1,11 @@
-module PascalParser where
+module PascalParser (
+ pascalUnit
+ )
+ where
import Text.Parsec
-import Text.Parsec.Char
import Text.Parsec.Token
-import Text.Parsec.Language
import Text.Parsec.Expr
-import Text.Parsec.Prim
-import Text.Parsec.Combinator
-import Text.Parsec.String
import Control.Monad
import Data.Maybe
import Data.Char
@@ -15,24 +13,28 @@
import PascalBasics
import PascalUnitSyntaxTree
+knownTypes :: [String]
knownTypes = ["shortstring", "ansistring", "char", "byte"]
+pascalUnit :: Parsec String u PascalUnit
pascalUnit = do
comments
u <- choice [program, unit, systemUnit, redoUnit]
comments
return u
+iD :: Parsec String u Identifier
iD = do
i <- identifier pas
comments
when (i == "not") $ unexpected "'not' used as an identifier"
return $ Identifier i BTUnknown
+unit :: Parsec String u PascalUnit
unit = do
- string "unit" >> comments
+ string' "unit" >> comments
name <- iD
- semi pas
+ void $ semi pas
comments
int <- interface
impl <- implementation
@@ -40,12 +42,13 @@
return $ Unit name int impl Nothing Nothing
+reference :: Parsec String u Reference
reference = buildExpressionParser table term <?> "reference"
where
term = comments >> choice [
parens pas (liftM RefExpression expression >>= postfixes) >>= postfixes
, try $ typeCast >>= postfixes
- , char '@' >> liftM Address reference >>= postfixes
+ , char' '@' >> liftM Address reference >>= postfixes
, liftM SimpleReference iD >>= postfixes
] <?> "simple reference"
@@ -55,9 +58,9 @@
postfixes r = many postfix >>= return . foldl (flip ($)) r
postfix = choice [
parens pas (option [] parameters) >>= return . FunCall
- , char '^' >> return Dereference
+ , char' '^' >> return Dereference
, (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement
- , (char '.' >> notFollowedBy (char '.')) >> liftM (flip RecordField) reference
+ , (char' '.' >> notFollowedBy (char' '.')) >> liftM (flip RecordField) reference
]
typeCast = do
@@ -66,12 +69,23 @@
comments
return $ TypeCast (Identifier t BTUnknown) e
+varsDecl1, varsDecl :: Bool -> Parsec String u [TypeVarDeclaration]
varsDecl1 = varsParser sepEndBy1
varsDecl = varsParser sepEndBy
+
+varsParser ::
+ (Parsec String u TypeVarDeclaration
+ -> Parsec String u String
+ -> Parsec
+ String u [TypeVarDeclaration])
+ -> Bool
+ -> Parsec
+ String u [TypeVarDeclaration]
varsParser m endsWithSemi = do
vs <- m (aVarDecl endsWithSemi) (semi pas)
return vs
+aVarDecl :: Bool -> Parsec String u TypeVarDeclaration
aVarDecl endsWithSemi = do
isVar <- liftM (== Just "var") $
if not endsWithSemi then
@@ -85,20 +99,20 @@
comments
ids <- do
i <- (commaSep1 pas) $ (try iD <?> "variable declaration")
- char ':'
+ char' ':'
return i
comments
t <- typeDecl <?> "variable type declaration"
comments
- init <- option Nothing $ do
- char '='
+ initialization <- option Nothing $ do
+ char' '='
comments
e <- initExpression
comments
return (Just e)
- return $ VarDeclaration isVar False (ids, t) init
+ return $ VarDeclaration isVar False (ids, t) initialization
-
+constsDecl :: Parsec String u [TypeVarDeclaration]
constsDecl = do
vs <- many1 (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i)
comments
@@ -108,22 +122,23 @@
comments
i <- iD
t <- optionMaybe $ do
- char ':'
+ char' ':'
comments
t <- typeDecl
comments
return t
- char '='
+ char' '='
comments
e <- initExpression
comments
return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e)
+typeDecl :: Parsec String u TypeDecl
typeDecl = choice [
- char '^' >> typeDecl >>= return . PointerTo
- , try (string "shortstring") >> return String
- , try (string "string") >> optionMaybe (brackets pas $ integer pas) >> return String
- , try (string "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return String
+ char' '^' >> typeDecl >>= return . PointerTo
+ , try (string' "shortstring") >> return String
+ , try (string' "string") >> optionMaybe (brackets pas $ integer pas) >> return String
+ , try (string' "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return String
, arrayDecl
, recordDecl
, setDecl
@@ -135,16 +150,16 @@
where
arrayDecl = do
try $ do
- optional $ (try $ string "packed") >> comments
- string "array"
+ optional $ (try $ string' "packed") >> comments
+ string' "array"
comments
r <- option [] $ do
- char '['
+ char' '['
r <- commaSep pas rangeDecl
- char ']'
+ char' ']'
comments
return r
- string "of"
+ string' "of"
comments
t <- typeDecl
if null r then
@@ -153,67 +168,69 @@
return $ foldr (\a b -> ArrayDecl (Just a) b) (ArrayDecl (Just $ head r) t) (tail r)
recordDecl = do
try $ do
- optional $ (try $ string "packed") >> comments
- string "record"
+ optional $ (try $ string' "packed") >> comments
+ string' "record"
comments
vs <- varsDecl True
union <- optionMaybe $ do
- string "case"
+ string' "case"
comments
- iD
+ void $ iD
comments
- string "of"
+ string' "of"
comments
many unionCase
- string "end"
+ string' "end"
return $ RecordType vs union
setDecl = do
- try $ string "set" >> space
+ try $ string' "set" >> void space
comments
- string "of"
+ string' "of"
comments
liftM Set typeDecl
unionCase = do
- try $ commaSep pas $ (iD >> return ()) <|> (integer pas >> return ())
- char ':'
+ void $ try $ commaSep pas $ (void $ iD) <|> (void $ integer pas)
+ char' ':'
comments
u <- parens pas $ varsDecl True
- char ';'
+ char' ';'
comments
return u
- sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char '=' >> spaces >> integer pas) >> return i)
+ sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char' '=' >> spaces >> integer pas) >> return i)
functionType = do
fp <- try (string "function") <|> try (string "procedure")
comments
vs <- option [] $ parens pas $ varsDecl False
comments
ret <- if (fp == "function") then do
- char ':'
+ char' ':'
comments
ret <- typeDecl
comments
return ret
else
return VoidType
- optional $ try $ char ';' >> comments >> string "cdecl"
+ optional $ try $ char' ';' >> comments >> string' "cdecl"
comments
return $ FunctionType ret vs
+typesDecl :: Parsec String u [TypeVarDeclaration]
typesDecl = many (aTypeDecl >>= \t -> comments >> return t)
where
aTypeDecl = do
i <- try $ do
i <- iD <?> "type declaration"
comments
- char '='
+ char' '='
return i
comments
t <- typeDecl
comments
- semi pas
+ void $ semi pas
comments
return $ TypeDeclaration i t
+rangeDecl :: Parsec String u Range
rangeDecl = choice [
try $ rangeft
, iD >>= return . Range
@@ -221,10 +238,11 @@
where
rangeft = do
e1 <- initExpression
- string ".."
+ string' ".."
e2 <- initExpression
return $ RangeFromTo e1 e2
+typeVarDeclaration :: Bool -> Parsec String u [TypeVarDeclaration]
typeVarDeclaration isImpl = (liftM concat . many . choice) [
varSection,
constSection,
@@ -245,28 +263,28 @@
_ -> error ("checkInit:\n" ++ (show v))) v
varSection = do
- try $ string "var"
+ try $ string' "var"
comments
v <- varsDecl1 True <?> "variable declaration"
comments
return $ fixInit v
constSection = do
- try $ string "const"
+ try $ string' "const"
comments
c <- constsDecl <?> "const declaration"
comments
return $ fixInit c
typeSection = do
- try $ string "type"
+ try $ string' "type"
comments
t <- typesDecl <?> "type declaration"
comments
return t
operatorDecl = do
- try $ string "operator"
+ try $ string' "operator"
comments
i <- manyTill anyChar space
comments
@@ -274,14 +292,15 @@
comments
rid <- iD
comments
- char ':'
+ char' ':'
comments
ret <- typeDecl
comments
- return ret
- char ';'
+ -- return ret
+ -- ^^^^^^^^^^ wth was this???
+ char' ';'
comments
- forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
+ forward <- liftM isJust $ optionMaybe (try (string' "forward;") >> comments)
inline <- liftM (any (== "inline;")) $ many functionDecorator
b <- if isImpl && (not forward) then
liftM Just functionBody
@@ -297,14 +316,14 @@
vs <- option [] $ parens pas $ varsDecl False
comments
ret <- if (fp == "function") then do
- char ':'
+ char' ':'
comments
ret <- typeDecl
comments
return ret
else
return VoidType
- char ';'
+ char' ';'
comments
forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
decorators <- many functionDecorator
@@ -323,17 +342,18 @@
, try $ string "overload;"
, try $ string "export;"
, try $ string "varargs;"
- , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
+ , try (string' "external") >> comments >> iD >> optional (string' "name" >> comments >> stringLiteral pas) >> string' ";" >> return "external"
]
comments
return d
+program :: Parsec String u PascalUnit
program = do
- string "program"
+ string' "program"
comments
name <- iD
- (char ';')
+ (char' ';')
comments
comments
u <- uses
@@ -342,12 +362,13 @@
comments
p <- phrase
comments
- char '.'
+ char' '.'
comments
return $ Program name (Implementation u (TypesAndVars tv)) p
+interface :: Parsec String u Interface
interface = do
- string "interface"
+ string' "interface"
comments
u <- uses
comments
@@ -355,84 +376,88 @@
comments
return $ Interface u (TypesAndVars tv)
+implementation :: Parsec String u Implementation
implementation = do
- string "implementation"
+ string' "implementation"
comments
u <- uses
comments
tv <- typeVarDeclaration True
- string "end."
+ string' "end."
comments
return $ Implementation u (TypesAndVars tv)
+expression :: Parsec String u Expression
expression = do
buildExpressionParser table term <?> "expression"
where
term = comments >> choice [
builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n BTUnknown))
- , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e)
+ , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char' '.') >> return e)
, brackets pas (commaSep pas iD) >>= return . SetExpression
- , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
+ , try $ integer pas >>= \i -> notFollowedBy (char' '.') >> (return . NumberLiteral . show) i
, float pas >>= return . FloatLiteral . show
, try $ integer pas >>= return . NumberLiteral . show
- , try (string "_S" >> stringLiteral pas) >>= return . StringLiteral
- , try (string "_P" >> stringLiteral pas) >>= return . PCharLiteral
+ , try (string' "_S" >> stringLiteral pas) >>= return . StringLiteral
+ , try (string' "_P" >> stringLiteral pas) >>= return . PCharLiteral
, stringLiteral pas >>= return . strOrChar
- , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c)
- , char '#' >> many digit >>= \c -> comments >> return (CharCode c)
- , char '$' >> many hexDigit >>= \h -> comments >> return (HexNumber h)
- --, char '-' >> expression >>= return . PrefixOp "-"
- , char '-' >> reference >>= return . PrefixOp "-" . Reference
- , (try $ string "not" >> notFollowedBy comments) >> unexpected "'not'"
- , try $ string "nil" >> return Null
+ , try (string' "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c)
+ , char' '#' >> many digit >>= \c -> comments >> return (CharCode c)
+ , char' '$' >> many hexDigit >>= \h -> comments >> return (HexNumber h)
+ --, char' '-' >> expression >>= return . PrefixOp "-"
+ , char' '-' >> reference >>= return . PrefixOp "-" . Reference
+ , (try $ string' "not" >> notFollowedBy comments) >> unexpected "'not'"
+ , try $ string' "nil" >> return Null
, reference >>= return . Reference
] <?> "simple expression"
table = [
[ Prefix (reservedOp pas "not">> return (PrefixOp "not"))
- , Prefix (try (char '-') >> return (PrefixOp "-"))]
+ , Prefix (try (char' '-') >> return (PrefixOp "-"))]
,
- [ Infix (char '*' >> return (BinOp "*")) AssocLeft
- , Infix (char '/' >> return (BinOp "/")) AssocLeft
- , Infix (try (string "div") >> return (BinOp "div")) AssocLeft
- , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft
- , Infix (try (string "in") >> return (BinOp "in")) AssocNone
- , Infix (try $ string "and" >> return (BinOp "and")) AssocLeft
- , Infix (try $ string "shl" >> return (BinOp "shl")) AssocLeft
- , Infix (try $ string "shr" >> return (BinOp "shr")) AssocLeft
+ [ Infix (char' '*' >> return (BinOp "*")) AssocLeft
+ , Infix (char' '/' >> return (BinOp "/")) AssocLeft
+ , Infix (try (string' "div") >> return (BinOp "div")) AssocLeft
+ , Infix (try (string' "mod") >> return (BinOp "mod")) AssocLeft
+ , Infix (try (string' "in") >> return (BinOp "in")) AssocNone
+ , Infix (try $ string' "and" >> return (BinOp "and")) AssocLeft
+ , Infix (try $ string' "shl" >> return (BinOp "shl")) AssocLeft
+ , Infix (try $ string' "shr" >> return (BinOp "shr")) AssocLeft
]
- , [ Infix (char '+' >> return (BinOp "+")) AssocLeft
- , Infix (char '-' >> return (BinOp "-")) AssocLeft
- , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
+ , [ Infix (char' '+' >> return (BinOp "+")) AssocLeft
+ , Infix (char' '-' >> return (BinOp "-")) AssocLeft
+ , Infix (try $ string' "or" >> return (BinOp "or")) AssocLeft
+ , Infix (try $ string' "xor" >> return (BinOp "xor")) AssocLeft
]
- , [ Infix (try (string "<>") >> return (BinOp "<>")) AssocNone
- , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone
- , Infix (try (string ">=") >> return (BinOp ">=")) AssocNone
- , Infix (char '<' >> return (BinOp "<")) AssocNone
- , Infix (char '>' >> return (BinOp ">")) AssocNone
+ , [ Infix (try (string' "<>") >> return (BinOp "<>")) AssocNone
+ , Infix (try (string' "<=") >> return (BinOp "<=")) AssocNone
+ , Infix (try (string' ">=") >> return (BinOp ">=")) AssocNone
+ , Infix (char' '<' >> return (BinOp "<")) AssocNone
+ , Infix (char' '>' >> return (BinOp ">")) AssocNone
]
- {-, [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone
- , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone
+ {-, [ Infix (try $ string' "shl" >> return (BinOp "shl")) AssocNone
+ , Infix (try $ string' "shr" >> return (BinOp "shr")) AssocNone
]
, [
- Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
+ Infix (try $ string' "or" >> return (BinOp "or")) AssocLeft
+ , Infix (try $ string' "xor" >> return (BinOp "xor")) AssocLeft
]-}
, [
- Infix (char '=' >> return (BinOp "=")) AssocNone
+ Infix (char' '=' >> return (BinOp "=")) AssocNone
]
]
strOrChar [a] = CharCode . show . ord $ a
strOrChar a = StringLiteral a
+phrasesBlock :: Parsec String u Phrase
phrasesBlock = do
- try $ string "begin"
+ try $ string' "begin"
comments
- p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum)
+ p <- manyTill phrase (try $ string' "end" >> notFollowedBy alphaNum)
comments
return $ Phrases p
+phrase :: Parsec String u Phrase
phrase = do
o <- choice [
phrasesBlock
@@ -442,68 +467,73 @@
, switchCase
, withBlock
, forCycle
- , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> comments >> expression >>= return . Assignment r
+ , (try $ reference >>= \r -> string' ":=" >> return r) >>= \r -> comments >> expression >>= return . Assignment r
, builtInFunction expression >>= \(n, e) -> return $ BuiltInFunctionCall e (SimpleReference (Identifier n BTUnknown))
, procCall
- , char ';' >> comments >> return NOP
+ , char' ';' >> comments >> return NOP
]
- optional $ char ';'
+ optional $ char' ';'
comments
return o
+ifBlock :: Parsec String u Phrase
ifBlock = do
try $ string "if" >> notFollowedBy (alphaNum <|> char '_')
comments
e <- expression
comments
- string "then"
+ string' "then"
comments
o1 <- phrase
comments
o2 <- optionMaybe $ do
- try $ string "else" >> space
+ try $ string' "else" >> void space
comments
o <- option NOP phrase
comments
return o
return $ IfThenElse e o1 o2
+whileCycle :: Parsec String u Phrase
whileCycle = do
- try $ string "while"
+ try $ string' "while"
comments
e <- expression
comments
- string "do"
+ string' "do"
comments
o <- phrase
return $ WhileCycle e o
+withBlock :: Parsec String u Phrase
withBlock = do
- try $ string "with" >> space
+ try $ string' "with" >> void space
comments
rs <- (commaSep1 pas) reference
comments
- string "do"
+ string' "do"
comments
o <- phrase
return $ foldr WithBlock o rs
+repeatCycle :: Parsec String u Phrase
repeatCycle = do
- try $ string "repeat" >> space
+ try $ string' "repeat" >> void space
comments
o <- many phrase
- string "until"
+ string' "until"
comments
e <- expression
comments
return $ RepeatCycle e o
+forCycle :: Parsec String u Phrase
forCycle = do
- try $ string "for" >> space
+ try $ string' "for" >> void space
comments
i <- iD
comments
- string ":="
+ string' ":="
comments
e1 <- expression
comments
@@ -512,84 +542,90 @@
try $ string "to"
, try $ string "downto"
]
- --choice [string "to", string "downto"]
+ --choice [string' "to", string' "downto"]
comments
e2 <- expression
comments
- string "do"
+ string' "do"
comments
p <- phrase
comments
return $ ForCycle i e1 e2 p up
+switchCase :: Parsec String u Phrase
switchCase = do
- try $ string "case"
+ try $ string' "case"
comments
e <- expression
comments
- string "of"
+ string' "of"
comments
cs <- many1 aCase
o2 <- optionMaybe $ do
- try $ string "else" >> notFollowedBy alphaNum
+ try $ string' "else" >> notFollowedBy alphaNum
comments
o <- many phrase
comments
return o
- string "end"
+ string' "end"
comments
return $ SwitchCase e cs o2
where
aCase = do
e <- (commaSep pas) $ (liftM InitRange rangeDecl <|> initExpression)
comments
- char ':'
+ char' ':'
comments
p <- phrase
comments
return (e, p)
+procCall :: Parsec String u Phrase
procCall = do
r <- reference
p <- option [] $ (parens pas) parameters
return $ ProcCall r p
+parameters :: Parsec String u [Expression]
parameters = (commaSep pas) expression <?> "parameters"
+functionBody :: Parsec String u (TypesAndVars, Phrase)
functionBody = do
tv <- typeVarDeclaration True
comments
p <- phrasesBlock
- char ';'
+ char' ';'
comments
return (TypesAndVars tv, p)
+uses :: Parsec String u Uses
uses = liftM Uses (option [] u)
where
u = do
- string "uses"
+ string' "uses"
comments
- u <- (iD >>= \i -> comments >> return i) `sepBy1` (char ',' >> comments)
- char ';'
+ ulist <- (iD >>= \i -> comments >> return i) `sepBy1` (char' ',' >> comments)
+ char' ';'
comments
- return u
+ return ulist
+initExpression :: Parsec String u InitExpression
initExpression = buildExpressionParser table term <?> "initialization expression"
where
term = comments >> choice [
liftM (uncurry BuiltInFunction) $ builtInFunction initExpression
, try $ brackets pas (commaSep pas $ initExpression) >>= return . InitSet
, try $ parens pas (commaSep pas $ initExpression) >>= \ia -> when ((notRecord $ head ia) && (null $ tail ia)) mzero >> return (InitArray ia)
- , try $ parens pas (sepEndBy recField (char ';' >> comments)) >>= return . InitRecord
+ , try $ parens pas (sepEndBy recField (char' ';' >> comments)) >>= return . InitRecord
, parens pas initExpression
- , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
+ , try $ integer pas >>= \i -> notFollowedBy (char' '.') >> (return . InitNumber . show) i
, try $ float pas >>= return . InitFloat . show
, try $ integer pas >>= return . InitNumber . show
, stringLiteral pas >>= return . InitString
- , char '#' >> many digit >>= \c -> comments >> return (InitChar c)
- , char '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
- , char '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
- , try $ string "nil" >> return InitNull
+ , char' '#' >> many digit >>= \c -> comments >> return (InitChar c)
+ , char' '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
+ , char' '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
+ , try $ string' "nil" >> return InitNull
, itypeCast
, iD >>= return . InitReference
]
@@ -600,7 +636,7 @@
recField = do
i <- iD
spaces
- char ':'
+ char' ':'
spaces
e <- initExpression
spaces
@@ -608,37 +644,37 @@
table = [
[
- Prefix (char '-' >> return (InitPrefixOp "-"))
- ,Prefix (try (string "not") >> return (InitPrefixOp "not"))
+ Prefix (char' '-' >> return (InitPrefixOp "-"))
+ ,Prefix (try (string' "not") >> return (InitPrefixOp "not"))
]
- , [ Infix (char '*' >> return (InitBinOp "*")) AssocLeft
- , Infix (char '/' >> return (InitBinOp "/")) AssocLeft
- , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft
- , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft
- , Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
- , Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
- , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
+ , [ Infix (char' '*' >> return (InitBinOp "*")) AssocLeft
+ , Infix (char' '/' >> return (InitBinOp "/")) AssocLeft
+ , Infix (try (string' "div") >> return (InitBinOp "div")) AssocLeft
+ , Infix (try (string' "mod") >> return (InitBinOp "mod")) AssocLeft
+ , Infix (try $ string' "and" >> return (InitBinOp "and")) AssocLeft
+ , Infix (try $ string' "shl" >> return (InitBinOp "shl")) AssocNone
+ , Infix (try $ string' "shr" >> return (InitBinOp "shr")) AssocNone
]
- , [ Infix (char '+' >> return (InitBinOp "+")) AssocLeft
- , Infix (char '-' >> return (InitBinOp "-")) AssocLeft
- , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
+ , [ Infix (char' '+' >> return (InitBinOp "+")) AssocLeft
+ , Infix (char' '-' >> return (InitBinOp "-")) AssocLeft
+ , Infix (try $ string' "or" >> return (InitBinOp "or")) AssocLeft
+ , Infix (try $ string' "xor" >> return (InitBinOp "xor")) AssocLeft
]
- , [ Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone
- , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone
- , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone
- , Infix (char '<' >> return (InitBinOp "<")) AssocNone
- , Infix (char '>' >> return (InitBinOp ">")) AssocNone
- , Infix (char '=' >> return (InitBinOp "=")) AssocNone
+ , [ Infix (try (string' "<>") >> return (InitBinOp "<>")) AssocNone
+ , Infix (try (string' "<=") >> return (InitBinOp "<=")) AssocNone
+ , Infix (try (string' ">=") >> return (InitBinOp ">=")) AssocNone
+ , Infix (char' '<' >> return (InitBinOp "<")) AssocNone
+ , Infix (char' '>' >> return (InitBinOp ">")) AssocNone
+ , Infix (char' '=' >> return (InitBinOp "=")) AssocNone
]
- {--, [ Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
- , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
- , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
+ {--, [ Infix (try $ string' "and" >> return (InitBinOp "and")) AssocLeft
+ , Infix (try $ string' "or" >> return (InitBinOp "or")) AssocLeft
+ , Infix (try $ string' "xor" >> return (InitBinOp "xor")) AssocLeft
]
- , [ Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
- , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
+ , [ Infix (try $ string' "shl" >> return (InitBinOp "shl")) AssocNone
+ , Infix (try $ string' "shr" >> return (InitBinOp "shr")) AssocNone
]--}
- --, [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
+ --, [Prefix (try (string' "not") >> return (InitPrefixOp "not"))]
]
itypeCast = do
@@ -647,6 +683,7 @@
comments
return $ InitTypeCast (Identifier t BTUnknown) i
+builtInFunction :: Parsec String u a -> Parsec String u (String, [a])
builtInFunction e = do
name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
spaces
@@ -654,23 +691,25 @@
spaces
return (name, exprs)
+systemUnit :: Parsec String u PascalUnit
systemUnit = do
- string "system;"
+ string' "system;"
comments
- string "type"
+ string' "type"
comments
t <- typesDecl
- string "var"
+ string' "var"
v <- varsDecl True
return $ System (t ++ v)
+redoUnit :: Parsec String u PascalUnit
redoUnit = do
- string "redo;"
+ string' "redo;"
comments
- string "type"
+ string' "type"
comments
t <- typesDecl
- string "var"
+ string' "var"
v <- varsDecl True
return $ Redo (t ++ v)