kesterel2lustre

compile Kernel Esterel to Lustre
git clone https://a3nm.net/git/kesterel2lustre/
Log | Files | Refs | README

parse.hs (2570B)

      1 {-# LANGUAGE NoMonomorphismRestriction #-}
      2 
      3 module Parse where
      4 
      5 import Esterel
      6 import Text.Parsec
      7 import Char
      8 import Checker
      9 
     10 idChar = satisfy (\ x -> not (elem x ":;|[]()-,\"") && not (isSpace x))
     11 spaced = between spaces spaces
     12 parenthesized = between (char '[') (char ']')
     13 
     14 parseName = spaced $ (do
     15     id <- many1 $ idChar
     16     return $ id
     17     )
     18 
     19 parseFile = spaced $ do
     20     string "module"
     21     name <- parseModuleName
     22     string ":"
     23     input <- parseModuleIO "input"
     24     output <- parseModuleIO "output"
     25     expr <- parseExpr
     26     string "end module"
     27     space
     28     eof
     29     return $ Module name input output expr
     30 
     31 parseModuleName = parseName
     32 
     33 parseSignals = spaced $ do
     34     signals <- sepBy1 parseSignal (char ',')
     35     return signals
     36 
     37 parseModuleIO decl = spaced $ do
     38     string decl
     39     args <- parseSignals
     40     string ";"
     41     return args
     42     
     43 parseSimpleExpr = spaced $ (do
     44     x <- parenthesized $ parseExpr
     45     return x
     46     )
     47   <|> (try $ do
     48     string "pause"
     49     return $ Annotated (Pause) ()
     50     )
     51   <|> (try $ do
     52     string "present" 
     53     signal <- parseSignal
     54     string "then" 
     55     e1 <- parseExpr
     56     string "else" 
     57     e2 <- parseExpr
     58     string "end" 
     59     return $ Annotated (Present signal e1 e2) ()
     60     )
     61   <|> (do
     62     string "nothing"
     63     return $ Annotated (Esterel.Nothing) ()
     64     )
     65   <|> (do
     66     p <- between (string "loop") (string "end") $ parseExpr
     67     if instantaneous p
     68     then fail "loop block ending here has unbounded looping"
     69     else return $ Annotated (Loop p) ()
     70     )
     71   <|> (try $ do
     72     string "emit" 
     73     s <- parseSignal
     74     return $ Annotated (Emit s) ()
     75     )
     76   <|> (try $ do
     77     string "exit" 
     78     t <- parseTrap
     79     return $ Annotated (Exit t) ()
     80     )
     81   <|> (do
     82     string "trap" 
     83     t <- parseTrap
     84     string "in" 
     85     p <- parseExpr
     86     string "end" 
     87     return $ Annotated (Trap t p) ()
     88     )
     89   <|> (try $ do
     90     string "signal" 
     91     s <- parseSignal
     92     string "in" 
     93     p <- parseExpr
     94     string "end" 
     95     return $ Annotated (Signal s p) ()
     96     )
     97   <|> (do
     98     string "suspend" 
     99     p <- parseExpr
    100     string "when" 
    101     s <- parseSignal
    102     return $ Annotated (Suspend p s) ()
    103     )
    104 
    105 parseExpr = (try $ do
    106     p1 <- parseScExpr
    107     spaced $ string "||"
    108     p2 <- parseExpr
    109     return $ Annotated (Par p1 p2) ()
    110     )
    111   <|> (do
    112     x <- parseScExpr
    113     return x
    114     )
    115 
    116 parseScExpr = spaced $ (try $ do
    117     p1 <- parseSimpleExpr
    118     spaced $ string ";"
    119     p2 <- parseScExpr
    120     return $ Annotated (Seq p1 p2) ()
    121     )
    122   <|> (do
    123     x <- parseSimpleExpr
    124     return x
    125     )
    126 
    127 parseSignal = parseName
    128 parseTrap = parseName
    129