tools/pas2c.hs
changeset 6277 627b5752733a
parent 6275 f1b4f37dba22
child 6307 25cfd9f4a567
equal deleted inserted replaced
6275:f1b4f37dba22 6277:627b5752733a
     1 module Pas2C where
     1 module Pas2C where
     2 
     2 
     3 import PascalParser
     3 import PascalParser
     4 import Text.PrettyPrint.HughesPJ
     4 import Text.PrettyPrint.HughesPJ
     5 import Data.Maybe
     5 import Data.Maybe
       
     6 import Data.Char
     6 
     7 
     7 
     8 
     8 pascal2C :: PascalUnit -> Doc
     9 pascal2C :: PascalUnit -> Doc
     9 pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation
    10 pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation
    10 
    11 
    34 phrase2C (ProcCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
    35 phrase2C (ProcCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
    35 phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $$ (braces . nest 4 . phrase2C) phrase1 $+$ elsePart
    36 phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $$ (braces . nest 4 . phrase2C) phrase1 $+$ elsePart
    36     where
    37     where
    37     elsePart | isNothing mphrase2 = empty
    38     elsePart | isNothing mphrase2 = empty
    38              | otherwise = text "else" $$ (braces . nest 4 . phrase2C) (fromJust mphrase2)
    39              | otherwise = text "else" $$ (braces . nest 4 . phrase2C) (fromJust mphrase2)
    39 phrase2C (Assignment (Identifier name) expr) = text name <> text " = " <> expr2C expr <> semi
    40 phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi
    40 phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ nest 4 (phrase2C phrase)
    41 phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ nest 4 (phrase2C phrase)
    41 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $$ (nest 4 . vcat . map case2C) cases
    42 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $$ (nest 4 . vcat . map case2C) cases
    42     where
    43     where
    43     case2C :: (Expression, Phrase) -> Doc
    44     case2C :: (Expression, Phrase) -> Doc
    44     case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $$ text "break;")
    45     case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $$ text "break;")
    48         | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase)
    49         | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase)
    49         | Assignment Identifier Expression
    50         | Assignment Identifier Expression
    50         -}
    51         -}
    51 phrase2C _ = empty
    52 phrase2C _ = empty
    52 
    53 
       
    54 ref2C :: Reference -> Doc
       
    55 ref2C (ArrayElement (Identifier name) expr) = text name <> brackets (expr2C expr)
       
    56 ref2C (SimpleReference (Identifier name)) = text name
       
    57 ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2
       
    58 ref2C (Dereference ref) = parens $ text "*" <> ref2C ref
    53 
    59 
    54 expr2C :: Expression -> Doc
    60 expr2C :: Expression -> Doc
    55 expr2C (Expression s) = text s
    61 expr2C (Expression s) = text s
    56 expr2C (FunCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params)
    62 expr2C (FunCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
    57 expr2C (BinOp op expr1 expr2) = (expr2C expr1) <+> op2C op <+> (expr2C expr2)
    63 expr2C (BinOp op expr1 expr2) = (expr2C expr1) <+> op2C op <+> (expr2C expr2)
    58 {-    | FunCall Identifier [Expression]
    64 expr2C (NumberLiteral s) = text s
       
    65 expr2C (HexNumber s) = text "0x" <> (text . map toLower $ s)
       
    66 expr2C (StringLiteral s) = doubleQuotes $ text s 
       
    67 expr2C (Address ref) = text "&" <> ref2C ref
       
    68 expr2C (Reference ref) = ref2C ref
       
    69 
       
    70 {-    
    59     | PrefixOp String Expression
    71     | PrefixOp String Expression
    60     | BinOp String Expression Expression
    72     | PostfixOp String Expression
       
    73     | CharCode String
    61     -}            
    74     -}            
    62 expr2C _ = empty
    75 expr2C _ = empty
    63 
    76 
    64 op2C "or" = text "|"
    77 op2C "or" = text "|"
    65 op2C "and" = text "&"
    78 op2C "and" = text "&"
    66 op2C "div" = text "/"
    79 op2C "div" = text "/"
    67 op2C "mod" = text "%"
    80 op2C "mod" = text "%"
    68 op2C "<>" = text "!="
    81 op2C "<>" = text "!="
       
    82 op2C "=" = text "=="
    69 op2C a = text a
    83 op2C a = text a
    70 
    84 
    71 maybeVoid "" = "void"
    85 maybeVoid "" = "void"
    72 maybeVoid a = a
    86 maybeVoid a = a