Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-
- This is the translator from the ASTCG to C source code,
- every other translator should follow this template.
- Since we have four AST specific data types, the translator must provide the following
- four functions:
- translateField, translateNode, translateKind and translateProgram
- Since we're writing files, their type should be:
- translateField :: ASTField -> Flag -> IO ()
- Where Flag is a custom type, the only restriction made here is that Flag should provide
- a default value (Except for a ASTProgram, it must be ASTProgram -> IO()).
- Copyright (C) 2012 Victor Cacciari Miraldo
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
- -}
- module AST_C_Target where
- import AST
- import Char
- data Flag = Decl | Imp | ParmDecl
- flagDefault :: Flag
- flagDefault = Decl
- ident :: IO ()
- ident = putStr "\t"
- identn :: Int -> IO()
- identn 1 = ident
- identn (n+1) = do {ident; identn n}
- {-
- A "field" in C is simply a declaration of a variable.
- -}
- translateField :: ASTField -> Flag -> IO ()
- translateField (ASTField _ n) Imp =
- do { putStr (n ++ " = " ++ n ++ ";\n") }
- translateField (ASTField t n) ParmDecl =
- do { putStr (t ++ " " ++ n) }
- translateField (ASTField t n) Decl =
- do { putStr (t ++ " " ++ n ++ ";") }
- {-
- Now, a kind is somewhat more complex. It is different if we're inside the declaration module,
- the implementation or declaring a parameter.
- -}
- translateKind :: ASTKind -> Flag -> IO()
- translateKind (ASTAtomKind f) Decl =
- do { identn 2; translateField f Decl; putChar '\n' }
- translateKind (ASTAtomKind f) ParmDecl =
- do { translateField f ParmDecl }
- translateKind (ASTAtomKind (ASTField _ n)) Imp =
- do { ident; putStrLn ("__a->u." ++ n ++ " = " ++ n ++ ";") }
- {-
- We have some more complicated cases here:
- For the following functions, we will ilustrate the output of the following kind:
- ASTKind "binop" [(ASTField "int" "op"), (ASTField "tree*" "lh"), (ASTField "tree*" "rh")]
- If it's a declaration, it should be:
- struct {
- int op;
- tree* lh;
- tree* rh;
- } binop;
- -}
- translateKind (ASTKind n fields) Decl =
- do
- { identn 2
- ; putStr "struct {\n"
- ; foldr (\h r -> do { identn 3; translateField h Decl; putChar '\n'; r }) (identn 2) fields
- ; putStr ("} " ++ n ++ ";\n")
- }
- {-
- If we're inside a initializer:
- __a->u.binop.op = op;
- __a->u.binop.lh = lh;
- __a->u.binop.rh = rh;
- -}
- translateKind (ASTKind n fields) Imp =
- do
- { foldr
- (\h r ->
- do
- { ident
- ; putStr ("__a->u." ++ n ++ ".")
- ; translateField h Imp
- ; r
- }
- ) (return ()) fields
- }
- {-
- And if we're dealing with a parameter declaration:
- int op, tree* lh, tree* rh
- -}
- translateKind (ASTKind _ fields) ParmDecl =
- translateParmFieldList fields
- translateParmFieldList :: [ASTField] -> IO ()
- translateParmFieldList fields =
- do
- { case pushLast fields of
- (l:tt) ->
- foldr
- (\h r ->
- do
- { translateField h ParmDecl
- ; putStr ", "
- ; r
- }
- ) (translateField l ParmDecl) tt
- [] -> return ()
- }
- where
- pushLast [] = []
- pushLast [x] = [x]
- pushLast [x,y] = [y,x]
- pushLast (h:t) = let (k:ks) = pushLast t in k:h:ks
- {-
- Ok, we're finally in the node part, this is not hard. Let's consider the following
- node to illustrate our functions:
- ASTNode "Exp" [(ASTField "int" "line")] kindlist
- This, in the declaration should become:
- struct Exp_st {
- enum ExpKind_t kind;
- int line;
- translate(kindlist)
- };
- -}
- -- Just a simple auxiliar to handle the function prototype name.
- translateNodeFuncPrototype :: ASTNode -> ASTKind -> IO ()
- translateNodeFuncPrototype (ASTNode name fields kinds) k =
- do
- { putStr (name ++ "*\t")
- ; putStr ((map toLower name) ++ "_" ++ (kindName k) ++ "_new(")
- ; translateParmFieldList (fields ++ (kindFields k))
- ; putChar ')'
- }
- translateNode :: ASTNode -> Flag -> IO ()
- translateNode node@(ASTNode name fields []) Decl =
- do
- { putStr ("struct " ++ name ++ "_st {\n")
- ; foldr (\h r -> do { ident ; translateField h Decl; putChar '\n'; r }) (return ()) fields
- ; putStr "};\n\n\n"
- ; putStr (name ++ "*\t")
- ; putStr ((map toLower name) ++ "_new(")
- ; translateParmFieldList fields
- ; putStr ");\n"
- }
- translateNode node@(ASTNode name fields kinds) Decl =
- do
- { putStr ("struct " ++ name ++ "_st {\n")
- ; putStr ("\tenum " ++ name ++ "Kind_t kind;\n")
- ; foldr (\h r -> do { ident ; translateField h Decl; putChar '\n'; r }) (return ()) fields
- ; putStr "\tunion {\n"
- ; foldr (\h r -> do { translateKind h Decl; r }) (return ()) kinds
- ; putStr "\t} u;\n"
- ; putStr "};\n\n\n"
- {-
- Cool, we're almost there.
- Now, we need the whole function declaration
- We want something like:
- Exp* exp_binop_new(int line, int binop, tree* lh, tree* rh);
- For each different kind!
- -}
- ; foldr (\k r ->
- do
- { translateNodeFuncPrototype node k
- ; putStr ";\n"
- ; r
- }
- ) (return ()) kinds
- ; putStr "\n\n"
- }
- {-
- Now we are going to actually implement every function, this is the
- time consuming task.
- -}
- translateNode node@(ASTNode name fields []) Imp =
- do
- { putStr (name ++ "*\t")
- ; putStr ((map toLower name) ++ "_new(")
- ; translateParmFieldList fields
- ; putStr ")\n{\n"
- ; putStr (name ++ "* __a = ALLOC(" ++ name ++ ");\n\n")
- ; foldr (\f r -> do { putStr "\t__a->"; translateField f Imp; r }) (return ()) fields
- ; putStr "\n\treturn __a;\n}\n\n"
- }
- translateNode node@(ASTNode name fields kinds) Imp =
- foldr (\k r ->
- do
- { translateNodeFuncPrototype node k
- ; putStr "\n{\n"
- ; putStr (name ++ "* __a = ALLOC(" ++ name ++ ");\n\n")
- ; putStr ("\t__a->kind = " ++ (map toUpper (name ++ "_" ++ (kindName k))) ++ ";\n")
- ; foldr (\f r -> do { putStr "\t__a->"; translateField f Imp; r }) (return ()) fields
- ; translateKind k Imp
- ; putStr "\n\treturn __a;\n}\n\n"
- ; r
- }
- ) (return ()) kinds
- {-
- Ok, now it comes the final part, how do we translate a program?
- Let's imagine the following program:
- ASTProgram header footer [ExpNode]
- We want something like:
- header
- typedef struct Exp_st Exp;
- struct Exp_st
- { ... }
- Exp* exp_ ...
- ...
- footer
- implementations
- -}
- translateProgram :: ASTProgram -> IO ()
- translateProgram (ASTProgram header footer nodes) =
- do
- { putStr header
- ; foldr (\(ASTNode n _ _) r ->
- do { putStr ("typedef struct " ++ n ++ "_st " ++ n ++ ";\n"); r }
- ) (return ()) nodes
- ; putStr "\n\n/* E N U M S */\n"
- ; foldr (\n r -> do { genEnum n ; r }) (return ()) nodes
- ; putStr "\n\n/* D E C L A R A T I O N S */\n\n"
- ; foldr (\h r -> do { translateNode h Decl ; r }) (return ()) nodes
- ; putStr "\n\n"
- ; putStr footer
- ; foldr (\h r -> do { translateNode h Imp ; r }) (return ()) nodes
- }
- genEnum :: ASTNode -> IO ()
- genEnum (ASTNode _ _ []) = return ()
- genEnum (ASTNode name _ (kh:kinds)) =
- do
- { putStr ("enum " ++ name ++ "Kind_t {\n")
- ; foldr (\k r ->
- do { putStr ("\t" ++ (map toUpper (name ++ "_" ++ (kindName k))) ++ ",\n"); r}
- ) (putStr ("\t" ++ (map toUpper (name ++ "_" ++ (kindName kh))) ++ "};\n")) kinds
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement