315 lines
11 KiB
Plaintext
315 lines
11 KiB
Plaintext
%if false
|
|
Copyright (c) 2009, ETH Zurich.
|
|
All rights reserved.
|
|
|
|
This file is distributed under the terms in the attached LICENSE file.
|
|
If you do not find this file, copies can be found by writing to:
|
|
ETH Zurich D-INFK, Universitaetstrasse 6, CH-8092 Zurich. Attn: Systems Group.
|
|
%endif
|
|
|
|
%include polycode.fmt
|
|
|
|
%if false
|
|
|
|
> module IL.Paka.Compile where
|
|
> import Prelude hiding ((<>))
|
|
> import Text.PrettyPrint.HughesPJ as Pprinter
|
|
> import qualified Data.Map as Map
|
|
> import Data.List
|
|
|
|
> import PureExpressions
|
|
|
|
> import IL.Paka.Syntax
|
|
|
|
%endif
|
|
|
|
\section{Translating @IL.Paka@ to @C@}
|
|
\label{sec:il_paka_compile}
|
|
|
|
This file could as well be called @./IL/C/C.lhs@ but I felt guilty of
|
|
introducing yet another confusing IL. So, it is here but feel free to
|
|
move it around.
|
|
|
|
\subsection{Printing types and expressions}
|
|
|
|
Because we are good kids, we create a type-class called
|
|
|Compileable|. A data-type satisfying |Compileable| can be
|
|
pretty-printed to something vaguely looking like a bunch of C code.
|
|
|
|
> class Compileable a where
|
|
> toC :: a -> Doc
|
|
|
|
Part of the |Compileable| class are FoF's types |TypeExpr| and FoF's
|
|
pure expressions |PureExpr|.
|
|
|
|
There is nothing but boiler plate code to get the job done for pure
|
|
expressions:
|
|
|
|
> instance Compileable PureExpr where
|
|
> toC (Quote s) = doubleQuotes $ text s
|
|
> toC Void = empty
|
|
> toC (CLInteger _ _ x) = integer x
|
|
> toC (CLFloat x) = Pprinter.float x
|
|
>
|
|
> toC (CLRef origin (TPointer _ Avail) loc) = toC loc
|
|
> toC (CLRef origin (TPointer _ Read) loc) = char '*' <> toC loc
|
|
> toC (CLRef origin _ loc) = toC loc
|
|
>
|
|
> toC (Unary op x) = parens $ toC op <+> toC x
|
|
> toC (Binary op x y) = parens $ toC x <+> toC op <+> toC y
|
|
> toC (Sizeof t) = text "sizeof" <> (parens $ toC t)
|
|
> toC (Test t1 t2 t3) = parens $
|
|
> parens (toC t1) <+> char '?' <+>
|
|
> parens (toC t2) <+> char ':' <+>
|
|
> parens (toC t3)
|
|
> toC (Cast t e) = parens $ parens (toC t) <+> toC e
|
|
>
|
|
> instance Compileable UnaryOp where
|
|
> toC Minus = char '-'
|
|
> toC Complement = char '~'
|
|
> toC Negation = char '!'
|
|
>
|
|
> instance Compileable BinaryOp where
|
|
> toC Plus = text "+"
|
|
> toC Sub = text "-"
|
|
> toC Mul = text "*"
|
|
> toC Div = text "/"
|
|
> toC Mod = text "%"
|
|
> toC Shl = text "<<"
|
|
> toC Shr = text ">>"
|
|
> toC AndBit = text "&"
|
|
> toC OrBit = text "|"
|
|
> toC XorBit = text "^"
|
|
> toC Le = text "<"
|
|
> toC Leq = text "<="
|
|
> toC Ge = text ">"
|
|
> toC Geq = text ">="
|
|
> toC Eq = text "=="
|
|
> toC Neq = text "!="
|
|
|
|
And similarly for types:
|
|
|
|
> instance Compileable TypeExpr where
|
|
> toC (TInt Signed TInt8) = text "int8_t"
|
|
> toC (TInt Signed TInt16) = text "int16_t"
|
|
> toC (TInt Signed TInt32) = text "int32_t"
|
|
> toC (TInt Signed TInt64) = text "int64_t"
|
|
> toC (TInt Unsigned TInt8) = text "uint8_t"
|
|
> toC (TInt Unsigned TInt16) = text "uint16_t"
|
|
> toC (TInt Unsigned TInt32) = text "uint32_t"
|
|
> toC (TInt Unsigned TInt64) = text "uint64_t"
|
|
> toC TFloat = text "float"
|
|
> toC TVoid = text "void"
|
|
> toC TChar = text "char"
|
|
> toC (TArray DynamicArray typ) = toC typ <> char '*'
|
|
> toC (TArray (StaticArray size) typ) = toC typ <> char '*'
|
|
> toC (TPointer x _) = toC x <> char '*'
|
|
> toC (TStruct DynamicStruct name fields) = text "struct " <+> text name <+> char '*'
|
|
> toC (TStruct StaticStruct name fields) = text "struct " <+> text name
|
|
> toC (TUnion DynamicUnion name fields) = text "union " <+> text name <+> char '*'
|
|
> toC (TUnion StaticUnion name fields) = text "union " <+> text name
|
|
> toC (TCompPointer name) = text "uintptr_t"
|
|
> toC (TTypedef typ name) = text name
|
|
> toC (TEnum name _) = text "enum" <+> text name
|
|
|
|
The picky reader will have noticed the absence of printer for function
|
|
types. This is hardly a problem at the moment because we do not
|
|
support function pointers, so we are not going to declare function
|
|
types anytime soon. Note that this argument might well be circular: if
|
|
we do not support function pointers, it is because it is a pain to
|
|
write their type, among other things (if I remember correctly). Oh
|
|
well.
|
|
|
|
Printing variable names is dead easy:
|
|
|
|
> instance Compileable VarName where
|
|
> toC x = text $ mkPakaVarName x
|
|
|
|
\subsection{Names, everywhere}
|
|
|
|
I am not very proud of that section, and of the way I abused these
|
|
functions in @IL/Paka/Paka.lhs@. I beg your pardon for that. There
|
|
\emph{must} some abstraction to bust here but I was not able to catch
|
|
it.
|
|
|
|
Provided a @FoF@ |VarName|, we turn it into a string with a bit of
|
|
Hungarianism, but very little. Why this function is called
|
|
|mkPakaVarName| when it does not deal with |PakaVarName|? I have no
|
|
clue.
|
|
|
|
> mkPakaVarName :: VarName -> String
|
|
> mkPakaVarName (Generated x) = "_" ++ x
|
|
> mkPakaVarName (Provided x) = x
|
|
> mkPakaVarName (Inherited y x) = mkPakaVarName x ++ "__" ++ show y
|
|
|
|
Then, we have to functions turning a |PureExpr| into a
|
|
|PakaVarName|. |PakaValName| provides you with the value described by
|
|
the |PureExpr|. On the other hand, |PakaVarName| works one level below
|
|
and gives you the value contained in the |PureExpr|.
|
|
|
|
I have to admit that I am not myself convinced by this
|
|
explanation. Basically, I would have to look at the former code, the
|
|
|typeOf|, |deref|, |readOf| functions, and the new code. Then, I might
|
|
be able to make more sense of that. However, intrinsically, references
|
|
are a non-sense.
|
|
|
|
> pakaValName :: PureExpr -> PakaVarName
|
|
> pakaValName (CLRef origin (TPointer _ Avail) loc) = Var $! mkPakaVarName loc
|
|
> pakaValName (CLRef origin (TPointer _ Read) loc) = Ptr $! Var $ mkPakaVarName loc
|
|
> pakaValName (CLRef _ _ loc) = Var $! mkPakaVarName loc
|
|
> pakaValName x = K x
|
|
>
|
|
> pakaVarName :: PureExpr -> PakaVarName
|
|
> pakaVarName (CLRef origin (TPointer _ Avail) loc) = Deref (Var $ mkPakaVarName loc)
|
|
> pakaVarName (CLRef origin (TPointer _ Read) loc) = Var $ mkPakaVarName loc
|
|
> pakaVarName (CLRef _ _ loc) = Var $ mkPakaVarName loc
|
|
> pakaVarName x = K x
|
|
|
|
Finally, we need to be able to print these |PakaVarName| into meaning
|
|
C code. Here you go.
|
|
|
|
> instance Compileable PakaVarName where
|
|
> toC (Deref x) = char '&' <> toC x
|
|
> toC (Var x) = text x
|
|
> toC (Ptr x) = char '*' <> toC x
|
|
> toC (Complex _) = error "Cannot convert a Complex var name to C"
|
|
> toC (K x) = toC x
|
|
|
|
|
|
\subsection{Generating C}
|
|
|
|
The following is a small addendum to the pretty-printer library. We
|
|
don't know why it is not defined there.
|
|
|
|
> vcat' :: [Doc] -> Doc
|
|
> vcat' [] = empty
|
|
> vcat' (x:xs) = l `seq` r `seq` r
|
|
> where l = vcat' xs
|
|
> r = x $+$ l
|
|
|
|
For once, I will do a bottom-up presentation. So, I will describe the
|
|
implementation of pretty-printers from |Paka| code to C.
|
|
|
|
The first step consists in printing closing terms:
|
|
|
|
> pprintClosing :: PakaClosing -> Doc
|
|
> pprintClosing (PReturn e) = text "return" <+> parens (toC e) <> semi
|
|
> pprintClosing PBreak = text "break"
|
|
> pprintClosing PContinue = text "continue"
|
|
|
|
Then, we print statements. As you remember, we need to build the final
|
|
code by applying the variables to the term:
|
|
|
|
> pprintStmt :: PakaStatement -> Doc
|
|
> pprintStmt (PAssign dst x srcs) = x (toC dst : map toC srcs)
|
|
> pprintStmt (PInstruction x srcs) = x (map toC srcs)
|
|
|
|
The next step consists in compiling intra-procedural code. This is
|
|
rather simple and quite directly follows from the |Paka| definitions:
|
|
|
|
> pprintPaka :: ILPaka -> Doc
|
|
> pprintPaka PVoid = empty
|
|
> pprintPaka (PClosing c) = pprintClosing c
|
|
> pprintPaka (PStatement stmt k) =
|
|
> pprintStmt stmt $+$
|
|
> pprintPaka k
|
|
> pprintPaka (PIf cond test ifTrue ifFalse k) =
|
|
> pprintPaka cond $+$
|
|
> text "if" <+> parens (toC test) <> lbrace $+$
|
|
> (nest 4 $! pprintPaka ifTrue) $+$
|
|
> rbrace <+> text "else" <+> lbrace $+$
|
|
> (nest 4 $! pprintPaka ifFalse) $+$
|
|
> rbrace $+$
|
|
> pprintPaka k
|
|
> pprintPaka (PWhile cond test loop k) =
|
|
> pprintPaka cond $+$
|
|
> text "while" <> parens (toC test) <> lbrace $+$
|
|
> (nest 4 $! pprintPaka loop) $+$
|
|
> rbrace $+$
|
|
> pprintPaka k
|
|
> pprintPaka (PDoWhile loop cond test k) =
|
|
> text "do" <+> lbrace $+$
|
|
> (nest 4 $! pprintPaka loop) $+$
|
|
> rbrace <+> text "while" <+> parens (toC test) <> semi $+$
|
|
> pprintPaka k
|
|
> pprintPaka (PSwitch test cases defaultCase k) =
|
|
> text "switch" <+> parens (toC test) <+> lbrace $+$
|
|
> (nest 4 $ vcat' $ map compileCase cases) $+$
|
|
> (nest 4 (text "default:" <+> lbrace $+$
|
|
> (nest 4 $! pprintPaka defaultCase) $+$
|
|
> rbrace)) $+$
|
|
> rbrace $+$
|
|
> pprintPaka k
|
|
> where compileCase (i, code) =
|
|
> text "case" <+> toC i <> colon <+> lbrace $+$
|
|
> (nest 4 $! (pprintPaka code $+$
|
|
> text "break" <> semi)) $+$
|
|
> rbrace
|
|
|
|
Finally, we can pretty-print a complete |PakaCode| by iterating other
|
|
each section, and, in each section, pretty-printing each element.
|
|
|
|
> pprint :: PakaCode -> Doc
|
|
> pprint code =
|
|
> text "/* Includes: */" $+$
|
|
> space $+$
|
|
> text "#include <stdint.h>" $+$
|
|
> vcat' (extractM $ includes code) $+$
|
|
> space $+$
|
|
> (case Map.null $ types code of
|
|
> True -> empty
|
|
> _ -> text "/* Type Declarations: */" $+$
|
|
> space $+$
|
|
> vcat' (extractM $ types code) $+$
|
|
> vcat' (extractL $ declarations code) $+$
|
|
> space) $+$
|
|
> (case null $ globalVars code of
|
|
> True -> empty
|
|
> _ -> text "/* Global Variables: */" $+$
|
|
> space $+$
|
|
> vcat' (map (\y -> text "static" <+> y) $
|
|
> extractL $
|
|
> globalVars code) $+$
|
|
> space) $+$
|
|
> (case Map.null $ prototypes code of
|
|
> True -> empty
|
|
> _ -> text "/* Prototypes: */" $+$
|
|
> space $+$
|
|
> vcat' (extractM $ prototypes code) $+$
|
|
> space) $+$
|
|
> (case Map.null $ functions code of
|
|
> True -> empty
|
|
> _ -> text "/* Function Definitions: */" $+$
|
|
> space $+$
|
|
> vcat' (map (\(returnT, attrs, name, args, lEnv, body) ->
|
|
> returnT <+> attrs <+> text name <> parens args <+> lbrace $+$
|
|
> (nest 4 $ vcat' $ extractM $ localVars lEnv) $+$
|
|
> space $+$
|
|
> (nest 4 $ pprintPaka body) $+$
|
|
> rbrace $+$
|
|
> space)
|
|
> $ extractM
|
|
> $ functions code) $+$
|
|
> space)
|
|
> $+$ space
|
|
|
|
We note the use of two extraction functions: these functions remove
|
|
the keys from the associative structure in use, and simply return the
|
|
content. When an order was maintained, ie. an associative list was
|
|
used, the definition order is carefully restored by reversing the
|
|
list.
|
|
|
|
> extractL :: Eq a => [(a, b)] -> [b]
|
|
> extractL = (map snd) .
|
|
> reverse
|
|
>
|
|
> extractM :: Map.Map a b -> [b]
|
|
> extractM = Map.elems
|
|
|
|
|
|
Because we have worked very hard, we are rewarded by the right to
|
|
instantiate these |PakaCode| in the |Show|.
|
|
|
|
> instance Show PakaCode where
|
|
> show = render . pprint
|