tools/pas2c.hs
author Xeli
Sat, 12 Nov 2011 17:06:49 +0100
branchhedgeroid
changeset 6328 d14adf1c7721
parent 6317 83b93a2d2741
child 6355 734fed7aefd3
permissions -rw-r--r--
merge...i think
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     1
module Pas2C where
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     2
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     3
import PascalParser
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     4
import Text.PrettyPrint.HughesPJ
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     5
import Data.Maybe
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
     6
import Data.Char
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     7
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     8
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     9
pascal2C :: PascalUnit -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    10
pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    11
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    12
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    13
implementation2C :: Implementation -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    14
implementation2C (Implementation uses tvars) = typesAndVars2C tvars
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    15
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    16
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    17
typesAndVars2C :: TypesAndVars -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    18
typesAndVars2C (TypesAndVars ts) = vcat $ map tvar2C ts
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    19
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    20
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    21
tvar2C :: TypeVarDeclaration -> Doc
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    22
tvar2C (FunctionDeclaration (Identifier name) returnType Nothing) = 
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    23
    type2C returnType <+> text (name ++ "();")
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    24
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    25
    
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    26
tvar2C (FunctionDeclaration (Identifier name) returnType (Just phrase)) = 
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    27
    type2C returnType <+> text (name ++ "()") 
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    28
    $$
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    29
    phrase2C phrase
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    30
tvar2C _ = empty
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    31
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    32
type2C :: TypeDecl -> Doc
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    33
type2C UnknownType = text "void"
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    34
type2C _ = text "<<type>>"
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    35
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    36
phrase2C :: Phrase -> Doc
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    37
phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}"
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    38
phrase2C (ProcCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    39
phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $+$ (phrase2C . wrapPhrase) phrase1 $+$ elsePart
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    40
    where
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    41
    elsePart | isNothing mphrase2 = empty
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    42
             | otherwise = text "else" $$ (phrase2C . wrapPhrase) (fromJust mphrase2)
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    43
phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    44
phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ (phrase2C $ wrapPhrase phrase)
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    45
phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    46
    where
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    47
    case2C :: (Expression, Phrase) -> Doc
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    48
    case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    49
{-
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    50
        | RepeatCycle Expression Phrase
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    51
        | ForCycle
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    52
        -}
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    53
phrase2C _ = empty
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    54
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    55
wrapPhrase p@(Phrases _) = p
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    56
wrapPhrase p = Phrases [p]
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    57
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    58
expr2C :: Expression -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    59
expr2C (Expression s) = text s
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    60
expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2)
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    61
expr2C (NumberLiteral s) = text s
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    62
expr2C (HexNumber s) = text "0x" <> (text . map toLower $ s)
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    63
expr2C (StringLiteral s) = doubleQuotes $ text s 
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    64
expr2C (Reference ref) = ref2C ref
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    65
expr2C (PrefixOp op expr) = op2C op <+> expr2C expr
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    66
    {-
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    67
    | PostfixOp String Expression
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    68
    | CharCode String
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    69
    -}            
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    70
expr2C _ = empty
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    71
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    72
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    73
ref2C :: Reference -> Doc
6317
83b93a2d2741 Improve parsing of complex references like "a^[b[c], d]"
unc0rr
parents: 6307
diff changeset
    74
ref2C (ArrayElement exprs ref) = ref2C ref <> (brackets . hcat) (punctuate comma $ map expr2C exprs)
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    75
ref2C (SimpleReference (Identifier name)) = text name
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    76
ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    77
ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    78
ref2C (Dereference ref) = parens $ text "*" <> ref2C ref
6317
83b93a2d2741 Improve parsing of complex references like "a^[b[c], d]"
unc0rr
parents: 6307
diff changeset
    79
ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
83b93a2d2741 Improve parsing of complex references like "a^[b[c], d]"
unc0rr
parents: 6307
diff changeset
    80
ref2C (Address ref) = text "&" <> ref2C ref
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    81
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
    82
op2C "or" = text "|"
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
    83
op2C "and" = text "&"
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    84
op2C "not" = text "!"
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    85
op2C "xor" = text "^"
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
    86
op2C "div" = text "/"
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
    87
op2C "mod" = text "%"
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    88
op2C "shl" = text "<<"
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
    89
op2C "shr" = text ">>"
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
    90
op2C "<>" = text "!="
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
    91
op2C "=" = text "=="
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
    92
op2C a = text a
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    93
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    94
maybeVoid "" = "void"
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    95
maybeVoid a = a