tools/pas2c/PascalParser.hs
branchwebgl
changeset 7969 7fcbbd46704a
parent 7762 d2fd8040534f
child 8020 00b1facf2805
equal deleted inserted replaced
7965:b518458f83e6 7969:7fcbbd46704a
       
     1 module PascalParser where
       
     2 
       
     3 import Text.Parsec
       
     4 import Text.Parsec.Char
       
     5 import Text.Parsec.Token
       
     6 import Text.Parsec.Language
       
     7 import Text.Parsec.Expr
       
     8 import Text.Parsec.Prim
       
     9 import Text.Parsec.Combinator
       
    10 import Text.Parsec.String
       
    11 import Control.Monad
       
    12 import Data.Maybe
       
    13 import Data.Char
       
    14 
       
    15 import PascalBasics
       
    16 import PascalUnitSyntaxTree
       
    17 
       
    18 knownTypes = ["shortstring", "ansistring", "char", "byte"]
       
    19 
       
    20 pascalUnit = do
       
    21     comments
       
    22     u <- choice [program, unit, systemUnit, redoUnit]
       
    23     comments
       
    24     return u
       
    25 
       
    26 iD = do
       
    27     i <- liftM (flip Identifier BTUnknown) (identifier pas)
       
    28     comments
       
    29     return i
       
    30 
       
    31 unit = do
       
    32     string "unit" >> comments
       
    33     name <- iD
       
    34     semi pas
       
    35     comments
       
    36     int <- interface
       
    37     impl <- implementation
       
    38     comments
       
    39     return $ Unit name int impl Nothing Nothing
       
    40 
       
    41 
       
    42 reference = buildExpressionParser table term <?> "reference"
       
    43     where
       
    44     term = comments >> choice [
       
    45         parens pas (liftM RefExpression expression >>= postfixes) >>= postfixes
       
    46         , try $ typeCast >>= postfixes
       
    47         , char '@' >> liftM Address reference >>= postfixes
       
    48         , liftM SimpleReference iD >>= postfixes 
       
    49         ] <?> "simple reference"
       
    50 
       
    51     table = [
       
    52         ]
       
    53 
       
    54     postfixes r = many postfix >>= return . foldl (flip ($)) r
       
    55     postfix = choice [
       
    56             parens pas (option [] parameters) >>= return . FunCall
       
    57           , char '^' >> return Dereference
       
    58           , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement
       
    59           , (char '.' >> notFollowedBy (char '.')) >> liftM (flip RecordField) reference
       
    60         ]
       
    61 
       
    62     typeCast = do
       
    63         t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
       
    64         e <- parens pas expression
       
    65         comments
       
    66         return $ TypeCast (Identifier t BTUnknown) e
       
    67 
       
    68 varsDecl1 = varsParser sepEndBy1
       
    69 varsDecl = varsParser sepEndBy
       
    70 varsParser m endsWithSemi = do
       
    71     vs <- m (aVarDecl endsWithSemi) (semi pas)
       
    72     return vs
       
    73 
       
    74 aVarDecl endsWithSemi = do
       
    75     isVar <- liftM (== Just "var") $
       
    76         if not endsWithSemi then
       
    77             optionMaybe $ choice [
       
    78                 try $ string "var"
       
    79                 , try $ string "const"
       
    80                 , try $ string "out"
       
    81                 ]
       
    82             else
       
    83                 return Nothing
       
    84     comments
       
    85     ids <- do
       
    86         i <- (commaSep1 pas) $ (try iD <?> "variable declaration")
       
    87         char ':'
       
    88         return i
       
    89     comments
       
    90     t <- typeDecl <?> "variable type declaration"
       
    91     comments
       
    92     init <- option Nothing $ do
       
    93         char '='
       
    94         comments
       
    95         e <- initExpression
       
    96         comments
       
    97         return (Just e)
       
    98     return $ VarDeclaration isVar False (ids, t) init
       
    99 
       
   100 
       
   101 constsDecl = do
       
   102     vs <- many1 (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i)
       
   103     comments
       
   104     return vs
       
   105     where
       
   106     aConstDecl = do
       
   107         comments
       
   108         i <- iD
       
   109         t <- optionMaybe $ do
       
   110             char ':'
       
   111             comments
       
   112             t <- typeDecl
       
   113             comments
       
   114             return t
       
   115         char '='
       
   116         comments
       
   117         e <- initExpression
       
   118         comments
       
   119         return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e)
       
   120 
       
   121 typeDecl = choice [
       
   122     char '^' >> typeDecl >>= return . PointerTo
       
   123     , try (string "shortstring") >> return (String 255)
       
   124     , try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
       
   125     , try (string "ansistring") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
       
   126     , arrayDecl
       
   127     , recordDecl
       
   128     , setDecl
       
   129     , functionType
       
   130     , sequenceDecl >>= return . Sequence
       
   131     , try iD >>= return . SimpleType
       
   132     , rangeDecl >>= return . RangeType
       
   133     ] <?> "type declaration"
       
   134     where
       
   135     arrayDecl = do
       
   136         try $ do
       
   137             optional $ (try $ string "packed") >> comments
       
   138             string "array"
       
   139         comments
       
   140         r <- option [] $ do
       
   141             char '['
       
   142             r <- commaSep pas rangeDecl
       
   143             char ']'
       
   144             comments
       
   145             return r
       
   146         string "of"
       
   147         comments
       
   148         t <- typeDecl
       
   149         if null r then
       
   150             return $ ArrayDecl Nothing t
       
   151             else
       
   152             return $ foldr (\a b -> ArrayDecl (Just a) b) (ArrayDecl (Just $ head r) t) (tail r) 
       
   153     recordDecl = do
       
   154         try $ do
       
   155             optional $ (try $ string "packed") >> comments
       
   156             string "record"
       
   157         comments
       
   158         vs <- varsDecl True
       
   159         union <- optionMaybe $ do
       
   160             string "case"
       
   161             comments
       
   162             iD
       
   163             comments
       
   164             string "of"
       
   165             comments
       
   166             many unionCase
       
   167         string "end"
       
   168         return $ RecordType vs union
       
   169     setDecl = do
       
   170         try $ string "set" >> space
       
   171         comments
       
   172         string "of"
       
   173         comments
       
   174         liftM Set typeDecl
       
   175     unionCase = do
       
   176         try $ commaSep pas $ (iD >> return ()) <|> (integer pas >> return ())
       
   177         char ':'
       
   178         comments
       
   179         u <- parens pas $ varsDecl True
       
   180         char ';'
       
   181         comments
       
   182         return u
       
   183     sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char '=' >> spaces >> integer pas) >> return i)
       
   184     functionType = do
       
   185         fp <- try (string "function") <|> try (string "procedure")
       
   186         comments
       
   187         vs <- option [] $ parens pas $ varsDecl False
       
   188         comments
       
   189         ret <- if (fp == "function") then do
       
   190             char ':'
       
   191             comments
       
   192             ret <- typeDecl
       
   193             comments
       
   194             return ret
       
   195             else
       
   196             return VoidType
       
   197         optional $ try $ char ';' >> comments >> string "cdecl"
       
   198         comments
       
   199         return $ FunctionType ret vs
       
   200 
       
   201 typesDecl = many (aTypeDecl >>= \t -> comments >> return t)
       
   202     where
       
   203     aTypeDecl = do
       
   204         i <- try $ do
       
   205             i <- iD <?> "type declaration"
       
   206             comments
       
   207             char '='
       
   208             return i
       
   209         comments
       
   210         t <- typeDecl
       
   211         comments
       
   212         semi pas
       
   213         comments
       
   214         return $ TypeDeclaration i t
       
   215 
       
   216 rangeDecl = choice [
       
   217     try $ rangeft
       
   218     , iD >>= return . Range
       
   219     ] <?> "range declaration"
       
   220     where
       
   221     rangeft = do
       
   222     e1 <- initExpression
       
   223     string ".."
       
   224     e2 <- initExpression
       
   225     return $ RangeFromTo e1 e2
       
   226 
       
   227 typeVarDeclaration isImpl = (liftM concat . many . choice) [
       
   228     varSection,
       
   229     constSection,
       
   230     typeSection,
       
   231     funcDecl,
       
   232     operatorDecl
       
   233     ]
       
   234     where
       
   235     varSection = do
       
   236         try $ string "var"
       
   237         comments
       
   238         v <- varsDecl1 True <?> "variable declaration"
       
   239         comments
       
   240         return v
       
   241 
       
   242     constSection = do
       
   243         try $ string "const"
       
   244         comments
       
   245         c <- constsDecl <?> "const declaration"
       
   246         comments
       
   247         return c
       
   248 
       
   249     typeSection = do
       
   250         try $ string "type"
       
   251         comments
       
   252         t <- typesDecl <?> "type declaration"
       
   253         comments
       
   254         return t
       
   255 
       
   256     operatorDecl = do
       
   257         try $ string "operator"
       
   258         comments
       
   259         i <- manyTill anyChar space
       
   260         comments
       
   261         vs <- parens pas $ varsDecl False
       
   262         comments
       
   263         rid <- iD
       
   264         comments
       
   265         char ':'
       
   266         comments
       
   267         ret <- typeDecl
       
   268         comments
       
   269         return ret
       
   270         char ';'
       
   271         comments
       
   272         forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
       
   273         inline <- liftM (any (== "inline;")) $ many functionDecorator
       
   274         b <- if isImpl && (not forward) then
       
   275                 liftM Just functionBody
       
   276                 else
       
   277                 return Nothing
       
   278         return $ [OperatorDeclaration i rid inline ret vs b]
       
   279 
       
   280 
       
   281     funcDecl = do
       
   282         fp <- try (string "function") <|> try (string "procedure")
       
   283         comments
       
   284         i <- iD
       
   285         vs <- option [] $ parens pas $ varsDecl False
       
   286         comments
       
   287         ret <- if (fp == "function") then do
       
   288             char ':'
       
   289             comments
       
   290             ret <- typeDecl
       
   291             comments
       
   292             return ret
       
   293             else
       
   294             return VoidType
       
   295         char ';'
       
   296         comments
       
   297         forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
       
   298         inline <- liftM (any (== "inline;")) $ many functionDecorator
       
   299         b <- if isImpl && (not forward) then
       
   300                 liftM Just functionBody
       
   301                 else
       
   302                 return Nothing
       
   303         return $ [FunctionDeclaration i inline ret vs b]
       
   304 
       
   305     functionDecorator = do
       
   306         d <- choice [
       
   307             try $ string "inline;"
       
   308             , try $ caseInsensitiveString "cdecl;"
       
   309             , try $ string "overload;"
       
   310             , try $ string "export;"
       
   311             , try $ string "varargs;"
       
   312             , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
       
   313             ]
       
   314         comments
       
   315         return d
       
   316 
       
   317 
       
   318 program = do
       
   319     string "program"
       
   320     comments
       
   321     name <- iD
       
   322     (char ';')
       
   323     comments
       
   324     comments
       
   325     u <- uses
       
   326     comments
       
   327     tv <- typeVarDeclaration True
       
   328     comments
       
   329     p <- phrase
       
   330     comments
       
   331     char '.'
       
   332     comments
       
   333     return $ Program name (Implementation u (TypesAndVars tv)) p
       
   334 
       
   335 interface = do
       
   336     string "interface"
       
   337     comments
       
   338     u <- uses
       
   339     comments
       
   340     tv <- typeVarDeclaration False
       
   341     comments
       
   342     return $ Interface u (TypesAndVars tv)
       
   343 
       
   344 implementation = do
       
   345     string "implementation"
       
   346     comments
       
   347     u <- uses
       
   348     comments
       
   349     tv <- typeVarDeclaration True
       
   350     string "end."
       
   351     comments
       
   352     return $ Implementation u (TypesAndVars tv)
       
   353 
       
   354 expression = do
       
   355     buildExpressionParser table term <?> "expression"
       
   356     where
       
   357     term = comments >> choice [
       
   358         builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n BTUnknown))
       
   359         , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e)
       
   360         , brackets pas (commaSep pas iD) >>= return . SetExpression
       
   361         , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
       
   362         , float pas >>= return . FloatLiteral . show
       
   363         , try $ integer pas >>= return . NumberLiteral . show
       
   364         , try (string "_S" >> stringLiteral pas) >>= return . StringLiteral
       
   365         , try (string "_P" >> stringLiteral pas) >>= return . PCharLiteral
       
   366         , stringLiteral pas >>= return . strOrChar
       
   367         , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c)
       
   368         , char '#' >> many digit >>= \c -> comments >> return (CharCode c)
       
   369         , char '$' >> many hexDigit >>=  \h -> comments >> return (HexNumber h)
       
   370         --, char '-' >> expression >>= return . PrefixOp "-"
       
   371         , char '-' >> reference >>= return . PrefixOp "-" . Reference
       
   372         , (try $ string "not" >> notFollowedBy comments) >> unexpected "'not'"
       
   373         , try $ string "nil" >> return Null
       
   374         , reference >>= return . Reference
       
   375         ] <?> "simple expression"
       
   376 
       
   377     table = [
       
   378           [  Prefix (try (string "not") >> return (PrefixOp "not"))
       
   379            , Prefix (try (char '-') >> return (PrefixOp "-"))]
       
   380         ,
       
   381           [  Infix (char '*' >> return (BinOp "*")) AssocLeft
       
   382            , Infix (char '/' >> return (BinOp "/")) AssocLeft
       
   383            , Infix (try (string "div") >> return (BinOp "div")) AssocLeft
       
   384            , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft
       
   385            , Infix (try (string "in") >> return (BinOp "in")) AssocNone
       
   386            , Infix (try $ string "and" >> return (BinOp "and")) AssocLeft
       
   387            , Infix (try $ string "shl" >> return (BinOp "shl")) AssocLeft
       
   388            , Infix (try $ string "shr" >> return (BinOp "shr")) AssocLeft
       
   389           ]
       
   390         , [  Infix (char '+' >> return (BinOp "+")) AssocLeft
       
   391            , Infix (char '-' >> return (BinOp "-")) AssocLeft
       
   392            , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
       
   393            , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
       
   394           ]
       
   395         , [  Infix (try (string "<>") >> return (BinOp "<>")) AssocNone
       
   396            , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone
       
   397            , Infix (try (string ">=") >> return (BinOp ">=")) AssocNone
       
   398            , Infix (char '<' >> return (BinOp "<")) AssocNone
       
   399            , Infix (char '>' >> return (BinOp ">")) AssocNone
       
   400           ]
       
   401         {-, [  Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone
       
   402              , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone
       
   403           ]
       
   404         , [ 
       
   405              Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
       
   406            , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
       
   407           ]-}
       
   408         , [
       
   409              Infix (char '=' >> return (BinOp "=")) AssocNone
       
   410           ]
       
   411         ]
       
   412     strOrChar [a] = CharCode . show . ord $ a
       
   413     strOrChar a = StringLiteral a
       
   414 
       
   415 phrasesBlock = do
       
   416     try $ string "begin"
       
   417     comments
       
   418     p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum)
       
   419     comments
       
   420     return $ Phrases p
       
   421 
       
   422 phrase = do
       
   423     o <- choice [
       
   424         phrasesBlock
       
   425         , ifBlock
       
   426         , whileCycle
       
   427         , repeatCycle
       
   428         , switchCase
       
   429         , withBlock
       
   430         , forCycle
       
   431         , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> comments >> expression >>= return . Assignment r
       
   432         , builtInFunction expression >>= \(n, e) -> return $ BuiltInFunctionCall e (SimpleReference (Identifier n BTUnknown))
       
   433         , procCall
       
   434         , char ';' >> comments >> return NOP
       
   435         ]
       
   436     optional $ char ';'
       
   437     comments
       
   438     return o
       
   439 
       
   440 ifBlock = do
       
   441     try $ string "if" >> notFollowedBy (alphaNum <|> char '_')
       
   442     comments
       
   443     e <- expression
       
   444     comments
       
   445     string "then"
       
   446     comments
       
   447     o1 <- phrase
       
   448     comments
       
   449     o2 <- optionMaybe $ do
       
   450         try $ string "else" >> space
       
   451         comments
       
   452         o <- option NOP phrase
       
   453         comments
       
   454         return o
       
   455     return $ IfThenElse e o1 o2
       
   456 
       
   457 whileCycle = do
       
   458     try $ string "while"
       
   459     comments
       
   460     e <- expression
       
   461     comments
       
   462     string "do"
       
   463     comments
       
   464     o <- phrase
       
   465     return $ WhileCycle e o
       
   466 
       
   467 withBlock = do
       
   468     try $ string "with" >> space
       
   469     comments
       
   470     rs <- (commaSep1 pas) reference
       
   471     comments
       
   472     string "do"
       
   473     comments
       
   474     o <- phrase
       
   475     return $ foldr WithBlock o rs
       
   476 
       
   477 repeatCycle = do
       
   478     try $ string "repeat" >> space
       
   479     comments
       
   480     o <- many phrase
       
   481     string "until"
       
   482     comments
       
   483     e <- expression
       
   484     comments
       
   485     return $ RepeatCycle e o
       
   486 
       
   487 forCycle = do
       
   488     try $ string "for" >> space
       
   489     comments
       
   490     i <- iD
       
   491     comments
       
   492     string ":="
       
   493     comments
       
   494     e1 <- expression
       
   495     comments
       
   496     up <- liftM (== Just "to") $
       
   497             optionMaybe $ choice [
       
   498                 try $ string "to"
       
   499                 , try $ string "downto"
       
   500                 ]   
       
   501     --choice [string "to", string "downto"]
       
   502     comments
       
   503     e2 <- expression
       
   504     comments
       
   505     string "do"
       
   506     comments
       
   507     p <- phrase
       
   508     comments
       
   509     return $ ForCycle i e1 e2 p up
       
   510 
       
   511 switchCase = do
       
   512     try $ string "case"
       
   513     comments
       
   514     e <- expression
       
   515     comments
       
   516     string "of"
       
   517     comments
       
   518     cs <- many1 aCase
       
   519     o2 <- optionMaybe $ do
       
   520         try $ string "else" >> notFollowedBy alphaNum
       
   521         comments
       
   522         o <- many phrase
       
   523         comments
       
   524         return o
       
   525     string "end"
       
   526     comments
       
   527     return $ SwitchCase e cs o2
       
   528     where
       
   529     aCase = do
       
   530         e <- (commaSep pas) $ (liftM InitRange rangeDecl <|> initExpression)
       
   531         comments
       
   532         char ':'
       
   533         comments
       
   534         p <- phrase
       
   535         comments
       
   536         return (e, p)
       
   537 
       
   538 procCall = do
       
   539     r <- reference
       
   540     p <- option [] $ (parens pas) parameters
       
   541     return $ ProcCall r p
       
   542 
       
   543 parameters = (commaSep pas) expression <?> "parameters"
       
   544 
       
   545 functionBody = do
       
   546     tv <- typeVarDeclaration True
       
   547     comments
       
   548     p <- phrasesBlock
       
   549     char ';'
       
   550     comments
       
   551     return (TypesAndVars tv, p)
       
   552 
       
   553 uses = liftM Uses (option [] u)
       
   554     where
       
   555         u = do
       
   556             string "uses"
       
   557             comments
       
   558             u <- (iD >>= \i -> comments >> return i) `sepBy1` (char ',' >> comments)
       
   559             char ';'
       
   560             comments
       
   561             return u
       
   562 
       
   563 initExpression = buildExpressionParser table term <?> "initialization expression"
       
   564     where
       
   565     term = comments >> choice [
       
   566         liftM (uncurry BuiltInFunction) $ builtInFunction initExpression 
       
   567         , try $ brackets pas (commaSep pas $ initExpression) >>= return . InitSet
       
   568         , try $ parens pas (commaSep pas $ initExpression) >>= \ia -> when (null $ tail ia) mzero >> return (InitArray ia)
       
   569         , try $ parens pas (sepEndBy recField (char ';' >> comments)) >>= return . InitRecord
       
   570         , parens pas initExpression
       
   571         , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
       
   572         , try $ float pas >>= return . InitFloat . show
       
   573         , try $ integer pas >>= return . InitNumber . show
       
   574         , stringLiteral pas >>= return . InitString
       
   575         , char '#' >> many digit >>= \c -> comments >> return (InitChar c)
       
   576         , char '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
       
   577         , char '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
       
   578         , try $ string "nil" >> return InitNull
       
   579         , itypeCast
       
   580         , iD >>= return . InitReference
       
   581         ]
       
   582 
       
   583     recField = do
       
   584         i <- iD
       
   585         spaces
       
   586         char ':'
       
   587         spaces
       
   588         e <- initExpression
       
   589         spaces
       
   590         return (i ,e)
       
   591 
       
   592     table = [
       
   593           [
       
   594              Prefix (char '-' >> return (InitPrefixOp "-"))
       
   595             ,Prefix (try (string "not") >> return (InitPrefixOp "not"))
       
   596           ]
       
   597         , [  Infix (char '*' >> return (InitBinOp "*")) AssocLeft
       
   598            , Infix (char '/' >> return (InitBinOp "/")) AssocLeft
       
   599            , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft
       
   600            , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft
       
   601            , Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
       
   602            , Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
       
   603            , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
       
   604           ]
       
   605         , [  Infix (char '+' >> return (InitBinOp "+")) AssocLeft
       
   606            , Infix (char '-' >> return (InitBinOp "-")) AssocLeft
       
   607            , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
       
   608            , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
       
   609           ]
       
   610         , [  Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone
       
   611            , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone
       
   612            , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone
       
   613            , Infix (char '<' >> return (InitBinOp "<")) AssocNone
       
   614            , Infix (char '>' >> return (InitBinOp ">")) AssocNone
       
   615            , Infix (char '=' >> return (InitBinOp "=")) AssocNone
       
   616           ]
       
   617         {--, [  Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
       
   618            , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
       
   619            , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
       
   620           ]
       
   621         , [  Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
       
   622            , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
       
   623           ]--}
       
   624         --, [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
       
   625         ]
       
   626 
       
   627     itypeCast = do
       
   628         t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
       
   629         i <- parens pas initExpression
       
   630         comments
       
   631         return $ InitTypeCast (Identifier t BTUnknown) i
       
   632 
       
   633 builtInFunction e = do
       
   634     name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
       
   635     spaces
       
   636     exprs <- option [] $ parens pas $ option [] $ commaSep1 pas $ e
       
   637     spaces
       
   638     return (name, exprs)
       
   639 
       
   640 systemUnit = do
       
   641     string "system;"
       
   642     comments
       
   643     string "type"
       
   644     comments
       
   645     t <- typesDecl
       
   646     string "var"
       
   647     v <- varsDecl True
       
   648     return $ System (t ++ v)
       
   649 
       
   650 redoUnit = do
       
   651     string "redo;"
       
   652     comments
       
   653     string "type"
       
   654     comments
       
   655     t <- typesDecl
       
   656     string "var"
       
   657     v <- varsDecl True
       
   658     return $ Redo (t ++ v)
       
   659