48 deriving Show |
48 deriving Show |
49 data Finalize = Finalize String |
49 data Finalize = Finalize String |
50 deriving Show |
50 deriving Show |
51 data Uses = Uses [Identifier] |
51 data Uses = Uses [Identifier] |
52 deriving Show |
52 deriving Show |
53 data Phrase = ProcCall Identifier [Expression] |
53 data Phrase = ProcCall Reference [Expression] |
54 | IfThenElse Expression Phrase (Maybe Phrase) |
54 | IfThenElse Expression Phrase (Maybe Phrase) |
55 | WhileCycle Expression Phrase |
55 | WhileCycle Expression Phrase |
56 | RepeatCycle Expression [Phrase] |
56 | RepeatCycle Expression [Phrase] |
57 | ForCycle Identifier Expression Expression Phrase |
57 | ForCycle Identifier Expression Expression Phrase |
58 | WithBlock Reference Phrase |
58 | WithBlock Reference Phrase |
59 | Phrases [Phrase] |
59 | Phrases [Phrase] |
60 | SwitchCase Expression [([Expression], Phrase)] (Maybe Phrase) |
60 | SwitchCase Expression [([InitExpression], Phrase)] (Maybe Phrase) |
61 | Assignment Reference Expression |
61 | Assignment Reference Expression |
|
62 | NOP |
62 deriving Show |
63 deriving Show |
63 data Expression = Expression String |
64 data Expression = Expression String |
64 | BuiltInFunCall [Expression] Reference |
65 | BuiltInFunCall [Expression] Reference |
65 | PrefixOp String Expression |
66 | PrefixOp String Expression |
66 | PostfixOp String Expression |
67 | PostfixOp String Expression |
70 | HexCharCode String |
71 | HexCharCode String |
71 | NumberLiteral String |
72 | NumberLiteral String |
72 | FloatLiteral String |
73 | FloatLiteral String |
73 | HexNumber String |
74 | HexNumber String |
74 | Reference Reference |
75 | Reference Reference |
|
76 | SetExpression [Identifier] |
75 | Null |
77 | Null |
76 deriving Show |
78 deriving Show |
77 data Reference = ArrayElement [Expression] Reference |
79 data Reference = ArrayElement [Expression] Reference |
78 | FunCall [Expression] Reference |
80 | FunCall [Expression] Reference |
|
81 | TypeCast Identifier Reference |
79 | SimpleReference Identifier |
82 | SimpleReference Identifier |
80 | Dereference Reference |
83 | Dereference Reference |
81 | RecordField Reference Reference |
84 | RecordField Reference Reference |
82 | Address Reference |
85 | Address Reference |
83 deriving Show |
86 deriving Show |
120 |
125 |
121 reference = buildExpressionParser table term <?> "reference" |
126 reference = buildExpressionParser table term <?> "reference" |
122 where |
127 where |
123 term = comments >> choice [ |
128 term = comments >> choice [ |
124 parens pas (reference >>= postfixes) >>= postfixes |
129 parens pas (reference >>= postfixes) >>= postfixes |
125 , char '@' >> reference >>= postfixes >>= return . Address |
130 , typeCast >>= postfixes |
|
131 , char '@' >> liftM Address reference >>= postfixes |
126 , liftM SimpleReference iD >>= postfixes |
132 , liftM SimpleReference iD >>= postfixes |
127 ] <?> "simple reference" |
133 ] <?> "simple reference" |
128 |
134 |
129 table = [ |
135 table = [ |
130 [Infix (try (char '.' >> notFollowedBy (char '.')) >> return RecordField) AssocLeft] |
136 [Infix (try (char '.' >> notFollowedBy (char '.')) >> return RecordField) AssocLeft] |
135 parens pas (option [] parameters) >>= return . FunCall |
141 parens pas (option [] parameters) >>= return . FunCall |
136 , char '^' >> return Dereference |
142 , char '^' >> return Dereference |
137 , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement |
143 , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement |
138 ] |
144 ] |
139 |
145 |
|
146 typeCast = do |
|
147 t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes |
|
148 r <- parens pas reference |
|
149 comments |
|
150 return $ TypeCast (Identifier t) r |
|
151 |
140 |
152 |
141 varsDecl1 = varsParser sepEndBy1 |
153 varsDecl1 = varsParser sepEndBy1 |
142 varsDecl = varsParser sepEndBy |
154 varsDecl = varsParser sepEndBy |
143 varsParser m endsWithSemi = do |
155 varsParser m endsWithSemi = do |
144 vs <- m (aVarDecl endsWithSemi) (semi pas) |
156 vs <- m (aVarDecl endsWithSemi) (semi pas) |
418 expression = buildExpressionParser table term <?> "expression" |
430 expression = buildExpressionParser table term <?> "expression" |
419 where |
431 where |
420 term = comments >> choice [ |
432 term = comments >> choice [ |
421 builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n)) |
433 builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n)) |
422 , parens pas $ expression |
434 , parens pas $ expression |
|
435 , brackets pas (commaSep pas iD) >>= return . SetExpression |
423 , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i |
436 , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i |
424 , try $ float pas >>= return . FloatLiteral . show |
437 , try $ float pas >>= return . FloatLiteral . show |
425 , try $ natural pas >>= return . NumberLiteral . show |
438 , try $ natural pas >>= return . NumberLiteral . show |
426 , stringLiteral pas >>= return . StringLiteral |
439 , stringLiteral pas >>= return . StringLiteral |
427 , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c) |
440 , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c) |
435 table = [ |
448 table = [ |
436 [ Infix (char '*' >> return (BinOp "*")) AssocLeft |
449 [ Infix (char '*' >> return (BinOp "*")) AssocLeft |
437 , Infix (char '/' >> return (BinOp "/")) AssocLeft |
450 , Infix (char '/' >> return (BinOp "/")) AssocLeft |
438 , Infix (try (string "div") >> return (BinOp "div")) AssocLeft |
451 , Infix (try (string "div") >> return (BinOp "div")) AssocLeft |
439 , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft |
452 , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft |
|
453 , Infix (try (string "in") >> return (BinOp "in")) AssocNone |
440 ] |
454 ] |
441 , [ Infix (char '+' >> return (BinOp "+")) AssocLeft |
455 , [ Infix (char '+' >> return (BinOp "+")) AssocLeft |
442 , Infix (char '-' >> return (BinOp "-")) AssocLeft |
456 , Infix (char '-' >> return (BinOp "-")) AssocLeft |
443 ] |
457 ] |
444 , [Prefix (try (string "not") >> return (PrefixOp "not"))] |
458 , [Prefix (try (string "not") >> return (PrefixOp "not"))] |
554 comments |
568 comments |
555 string "of" |
569 string "of" |
556 comments |
570 comments |
557 cs <- many1 aCase |
571 cs <- many1 aCase |
558 o2 <- optionMaybe $ do |
572 o2 <- optionMaybe $ do |
559 try $ string "else" |
573 try $ string "else" >> notFollowedBy alphaNum |
560 comments |
574 comments |
561 o <- phrase |
575 o <- phrase |
562 comments |
576 comments |
563 return o |
577 return o |
564 string "end" |
578 string "end" |
565 comments |
579 comments |
566 return $ SwitchCase e cs o2 |
580 return $ SwitchCase e cs o2 |
567 where |
581 where |
568 aCase = do |
582 aCase = do |
569 e <- (commaSep pas) expression |
583 e <- (commaSep pas) initExpression |
570 comments |
584 comments |
571 char ':' |
585 char ':' |
572 comments |
586 comments |
573 p <- phrase |
587 p <- phrase |
574 comments |
588 comments |
575 return (e, p) |
589 return (e, p) |
576 |
590 |
577 procCall = do |
591 procCall = do |
578 i <- iD |
592 r <- reference |
579 p <- option [] $ (parens pas) parameters |
593 p <- option [] $ (parens pas) parameters |
580 return $ ProcCall i p |
594 return $ ProcCall r p |
581 |
595 |
582 parameters = (commaSep pas) expression <?> "parameters" |
596 parameters = (commaSep pas) expression <?> "parameters" |
583 |
597 |
584 functionBody = do |
598 functionBody = do |
585 tv <- typeVarDeclaration True |
599 tv <- typeVarDeclaration True |