tools/pas2c.hs
author sheepluva
Fri, 04 Nov 2011 21:44:57 +0100
changeset 6279 7f724835ea57
parent 6274 a3e1eb794249
child 6275 f1b4f37dba22
permissions -rw-r--r--
I hope this helps...
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
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     6
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     7
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     8
pascal2C :: PascalUnit -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     9
pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    10
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    11
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    12
implementation2C :: Implementation -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    13
implementation2C (Implementation uses tvars) = typesAndVars2C tvars
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    14
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    15
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    16
typesAndVars2C :: TypesAndVars -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    17
typesAndVars2C (TypesAndVars ts) = vcat $ map tvar2C ts
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    18
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    19
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    20
tvar2C :: TypeVarDeclaration -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    21
tvar2C (FunctionDeclaration (Identifier name) (Identifier returnType) Nothing) = 
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    22
    text $ maybeVoid returnType ++ " " ++ name ++ "();"
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    23
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    24
    
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    25
tvar2C (FunctionDeclaration (Identifier name) (Identifier returnType) (Just phrase)) = 
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    26
    text (maybeVoid returnType ++ " " ++ name ++ "()") 
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    27
    $$
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    28
    phrase2C phrase
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    29
tvar2C _ = empty
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    30
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    31
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    32
phrase2C :: Phrase -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    33
phrase2C (Phrases p) = braces . nest 4 . vcat . map phrase2C $ p
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    34
phrase2C (ProcCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
6274
a3e1eb794249 Better 'else' part
unc0rr
parents: 6273
diff changeset
    35
phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $$ (braces . nest 4 . phrase2C) phrase1 $+$ elsePart
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    36
    where
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    37
    elsePart | isNothing mphrase2 = empty
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    38
             | otherwise = text "else" $$ (braces . nest 4 . phrase2C) (fromJust mphrase2)
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    39
phrase2C (Assignment (Identifier name) expr) = text name <> text " = " <> expr2C expr <> semi
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    40
phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ nest 4 (phrase2C phrase)
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    41
phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $$ (nest 4 . vcat . map case2C) cases
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    42
    where
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    43
    case2C :: (Expression, Phrase) -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    44
    case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $$ text "break;")
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    45
{-
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    46
        | RepeatCycle Expression Phrase
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    47
        | ForCycle
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    48
        | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase)
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    49
        | Assignment Identifier Expression
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    50
        -}
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    51
phrase2C _ = empty
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    52
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    53
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    54
expr2C :: Expression -> Doc
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    55
expr2C (Expression s) = text s
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    56
expr2C (FunCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params)
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    57
expr2C (BinOp op expr1 expr2) = (expr2C expr1) <+> op2C op <+> (expr2C expr2)
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    58
{-    | FunCall Identifier [Expression]
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    59
    | PrefixOp String Expression
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    60
    | BinOp String Expression Expression
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    61
    -}            
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    62
expr2C _ = empty
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    63
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    64
op2C = text
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    65
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    66
maybeVoid "" = "void"
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    67
maybeVoid a = a