Parse.hs revision 98890889ffb2e8f6f722b00e265a211f13b5a861
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby{-# LANGUAGE TypeSynonymInstances #-}
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby{- |
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyModule : $Header$
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyDescription : parsing VSE parts
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyCopyright : (c) C. Maeder, DFKI Bremen 2008
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyLicense : GPLv2 or higher, see LICENSE.txt
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyMaintainer : Christian.Maeder@dfki.de
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyStability : provisional
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyPortability : portable
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyParser for VSE logic extension of CASL
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby-}
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbymodule VSE.Parse where
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Common.AnnoState
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Common.DocUtils
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Common.Id
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Common.Lexer
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Common.Result
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Common.Token
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport VSE.As
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Text.ParserCombinators.Parsec
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport CASL.Formula
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport CASL.AS_Basic_CASL
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyimport Data.Char (toUpper, toLower)
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbydeclWords :: [String]
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbydeclWords = let
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby ps = ["procedure", "function"]
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby rs = ps ++ map (++ "s") ps
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby in rs ++ map (map toUpper) rs
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyreservedWords :: [String]
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyreservedWords = let
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby rs =
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby [ "in", "out", "begin", "end", "abort", "skip", "return", "declare"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby , "if", "then", "else", "fi", "while", "do", "od"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby , "defprocs", "defprocsend", "restricted" ]
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby in [ "<:", ":>"] ++ declWords ++ rs ++ map (map toUpper) rs
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbykeyword :: String -> AParser st Token
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbykeyword s = pToken $ try $ do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby annos
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby str <- scanAnyWords
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby lineAnnos
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby if map toLower str == s then return s else unexpected str <?> map toUpper s
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyvseVarDecl :: AParser st VarDecl
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyvseVarDecl = do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby v <- varId reservedWords
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby c <- colonT
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby s <- sortId reservedWords
7014882c6a3672fd0e5d60200af8643ae53c5928Richard Lowe option (VarDecl v s Nothing $ tokPos c) $ do
7014882c6a3672fd0e5d60200af8643ae53c5928Richard Lowe a <- asKey ":="
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby t <- term reservedWords
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ VarDecl v s (Just t) $ toRange c [] a
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyfromVarDecl :: [VarDecl] -> Program -> ([VAR_DECL], Program)
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin MaltbyfromVarDecl vs p = case vs of
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby [] -> ([], p)
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby VarDecl v s mt r : n ->
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby let (rs, q) = fromVarDecl n p
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby in (Var_decl [v] s r : rs, case mt of
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby Nothing -> q
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby Just t -> Ranged (Seq (Ranged (Assign v t) r) q) r)
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyprogram :: AParser st Program
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltbyprogram = do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby t <- keyword "abort"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged Abort $ tokPos t
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby <|> do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby t <- keyword "skip"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged Skip $ tokPos t
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby <|> do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby r <- keyword "return"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby t <- term reservedWords
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged (Return t) $ tokPos r
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby <|> do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby b <- keyword "begin"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby p <- programSeq
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby e <- keyword "end"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged (Block [] p) $ toRange b [] e
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby <|> do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby d <- keyword "declare"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby (vs, ps) <- separatedBy vseVarDecl commaT
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby s <- anSemi
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby p <- programSeq
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby let (cs, q) = fromVarDecl vs p
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged (Block cs q) $ toRange d ps s
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby <|> do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby i <- keyword "if"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby c <- formula reservedWords
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby p <- keyword "then"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby t <- programSeq
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby do r <- keyword "fi"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby let s = toRange i [p] r
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged (If c t $ Ranged Skip s) s
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby <|> do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby q <- keyword "else"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby e <- programSeq
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby r <- keyword "fi"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged (If c t e) $ toRange i [p, q] r
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby <|> do
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby w <- keyword "while"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby c <- formula reservedWords
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby d <- keyword "do"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby p <- programSeq
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby o <- keyword "od"
f6e214c7418f43af38bd8c3a557e3d0a1d311cfaGavin Maltby return $ Ranged (While c p) $ toRange w [d] o
<|> do
(v, a) <- try $ do
v <- varId reservedWords
a <- asKey ":="
return (v, a)
t <- term reservedWords
return $ Ranged (Assign v t) $ tokPos a
<|> do
t <- term reservedWords
return . Ranged (Call $ Mixfix_formula t) . Range $ rangeSpan t
programSeq :: AParser st Program
programSeq = do
p1 <- program
option p1 $ do
s <- semiT
p2 <- programSeq
return $ Ranged (Seq p1 p2) $ tokPos s
procKind :: AParser st (ProcKind, Token)
procKind = do
k <- keyword "procedure"
return (Proc, k)
<|> do
k <- keyword "function"
return (Func, k)
defproc :: AParser st Defproc
defproc = do
(pk, q) <- procKind
i <- parseId reservedWords
o <- oParenT
(ts, ps) <- option ([], []) $
varId reservedWords `separatedBy` commaT
c <- cParenT
p <- program
return $ Defproc pk i ts p $ toRange q (o : ps) c
boxOrDiamandProg :: AParser st (Token, BoxOrDiamond, Program, Token)
boxOrDiamandProg = do
o <- asKey "<:"
p <- programSeq
c <- asKey ":>"
return (o, Diamond, p, c)
<|> do
o <- asKey "[:"
p <- programSeq
c <- asKey ":]"
return (o, Box, p, c)
dlformula :: AParser st Dlformula
dlformula = do
p <- keyword "defprocs"
(ps, qs) <- separatedBy defproc semiT
q <- keyword "defprocsend"
return $ Ranged (Defprocs ps) $ toRange p qs q
<|> do
(o, b, p, c) <- boxOrDiamandProg
f <- formula reservedWords
return $ Ranged (Dlformula b p f) $ toRange o [] c
param :: AParser st Procparam
param = do
k <- (keyword "in" >> return In) <|> (keyword "out" >> return Out)
s <- sortId reservedWords
return $ Procparam k s
profile :: AParser st Profile
profile = do
(ps, _) <- option ([], []) $ separatedBy param commaT
m <- optionMaybe $ asKey "->" >> sortId reservedWords
return $ Profile ps m
procdecl :: AParser st Sigentry
procdecl = do
i <- parseId reservedWords
c <- colonT
p <- profile
return $ Procedure i p $ tokPos c
procdecls :: AParser st Procdecls
procdecls = do
k <- keyword "procedures" <|> keyword "procedure"
auxItemList (declWords ++ startKeyword) [k] procdecl Procdecls
instance AParsable Dlformula where
aparser = dlformula
instance AParsable Procdecls where
aparser = procdecls
-- | just for testing
testParse :: String -> String
testParse str = case runParser (formula [] :: AParser () Sentence)
(emptyAnnos ()) "" str of
Left err -> showErr err
Right ps -> showDoc ps ""