Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/c-target/print-as-c.sml
ViewVC logotype

Annotation of /branches/pure-cfg/src/compiler/c-target/print-as-c.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 528 - (view) (download)

1 : jhr 525 (* print-as-c.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure PrintAsC : sig
8 :    
9 :     type strm
10 :    
11 :     val new : TextIO.outstream -> strm
12 :    
13 : jhr 527 val close : strm -> unit
14 :    
15 : jhr 525 val output : strm * CLang.decl -> unit
16 :    
17 :     end = struct
18 :    
19 :     structure CL = CLang
20 :     structure PP = TextIOPP
21 :    
22 :     type strm = PP.stream
23 :    
24 :     val indent = (PP.Abs 4) (* standard indentation amount *)
25 :    
26 :     fun new outs = PP.openOut {dst = outs, wid = 90}
27 :    
28 : jhr 527 val close = PP.closeStream
29 :    
30 : jhr 525 fun output (strm, decl) = let
31 :     val str = PP.string strm
32 :     fun sp () = PP.space strm 1
33 :     fun inHBox f = (PP.openHBox strm; f(); PP.closeBox strm)
34 :     fun ppComLn s = (
35 :     inHBox (fn () => (str "// "; str s));
36 :     PP.newline strm)
37 :     fun ppList {pp, sep, l} = let
38 :     fun ppList' [] = ()
39 :     | ppList' [x] = pp x
40 :     | ppList' (x::xs) = (pp x; sep(); ppList' xs)
41 :     in
42 :     ppList' l
43 :     end
44 :     fun ppTy (ty, optVar) = let
45 :     fun getBaseTy (CL.T_Ptr ty) = getBaseTy ty
46 :     | getBaseTy (CL.T_Array(ty, _)) = getBaseTy ty
47 :     | getBaseTy (CL.T_Num rty) = (case rty
48 :     of RawTypes.RT_Int8 => "int8_t"
49 :     | RawTypes.RT_UInt8 => "uint8_t"
50 :     | RawTypes.RT_Int16 => "int16_t"
51 :     | RawTypes.RT_UInt16 => "uint16_t"
52 :     | RawTypes.RT_Int32 => "int32_t"
53 :     | RawTypes.RT_UInt32 => "uint32_t"
54 :     | RawTypes.RT_Int64 => "int64_t"
55 :     | RawTypes.RT_UInt64 => "uint64_t"
56 :     | RawTypes.RT_Float => "float"
57 :     | RawTypes.RT_Double => "double"
58 :     (* end case *))
59 :     | getBaseTy (CL.T_Named ty) = ty
60 :     fun pp (isFirst, CL.T_Ptr ty, optVar) = (
61 :     if isFirst then sp() else ();
62 :     case ty
63 :     of CL.T_Array _ => (
64 :     str "(*"; pp(false, ty, optVar); str ")")
65 :     | _ => (str "*"; pp(false, ty, optVar))
66 :     (* end case *))
67 :     | pp (isFirst, CL.T_Array(ty, n), optVar) = (
68 :     pp (isFirst, ty, optVar);
69 :     str "["; str(Int.toString n); str "]")
70 :     | pp (isFirst, _, SOME x) = (
71 :     if isFirst then sp() else ();
72 :     str x)
73 :     | pp (_, _, NONE) = ()
74 :     in
75 :     str (getBaseTy ty);
76 :     pp (true, ty, optVar)
77 :     end
78 :     fun ppDecl dcl = (case dcl
79 :     of CL.D_Comment l => List.app ppComLn l
80 :     | CL.D_Var(attrs, ty, x) => (
81 :     inHBox (fn () => (
82 :     ppList {pp=str, sep=sp, l = attrs};
83 :     if List.null attrs then () else sp();
84 :     ppTy (ty, SOME x);
85 :     str ";"));
86 :     PP.newline strm)
87 :     | CL.D_Func(attrs, ty, f, params, body) => (
88 :     inHBox (fn () => (
89 :     ppList {pp=str, sep=sp, l = attrs};
90 :     if List.null attrs then () else sp();
91 :     ppTy(ty, SOME f);
92 :     sp(); str "(";
93 :     ppList {pp=ppParam, sep=fn () => (str ","; sp()), l=params};
94 :     str ")"));
95 :     PP.newline strm;
96 :     ppBlock (case body of CL.S_Block stms => stms | stm => [stm]))
97 :     (* end case *))
98 :     and ppParam (CL.PARAM(attr, ty, x)) = (
99 :     str attr; sp(); ppTy(ty, SOME(CL.varToString x)))
100 :     and ppBlock stms = (
101 :     str "{";
102 :     PP.openVBox strm indent;
103 :     PP.newline strm;
104 :     List.app ppStm stms;
105 :     PP.closeBox strm;
106 :     str "}"; PP.newline strm)
107 :     and ppStm stm = (case stm
108 :     of CL.S_Block stms => ppBlock stms
109 :     | CL.S_Comment l => List.app ppComLn l
110 :     | CL.S_Decl(ty, x, NONE) => (
111 :     inHBox (fn () => (ppTy(ty, SOME x); str ";")); PP.newline strm)
112 :     | CL.S_Decl(ty, x, SOME e) => (
113 :     inHBox (fn () => (
114 :     ppTy(ty, SOME x); sp(); str "="; sp(); ppExp e; str ";"));
115 :     PP.newline strm)
116 :     | CL.S_Assign(lhs, rhs) => (
117 :     inHBox (fn () => (
118 :     ppExp lhs; sp(); str "="; sp(); ppExp rhs; str ";"));
119 :     PP.newline strm)
120 :     | CL.S_If(e, blk, CL.S_Block[]) => (
121 :     inHBox (fn () => (str "if"; sp(); ppExp e)); ppStms blk)
122 :     | CL.S_If(e, blk1, blk2) => (
123 :     inHBox (fn () => (str "if"; sp(); ppExp e)); ppStms blk1;
124 :     str "else"; ppStms blk2)
125 :     | CL.S_While(e, blk) => (
126 :     inHBox (fn () => (str "while"; sp(); ppExp e)); ppStms blk)
127 :     | CL.S_Call(f, args) => (str f; ppArgs args; str ";"; PP.newline strm)
128 :     | CL.S_Return(SOME e) => (str "return"; sp(); ppExp e; str ";"; PP.newline strm)
129 :     | CL.S_Return _ => (str "return;"; PP.newline strm)
130 :     (* end case *))
131 :     and ppStms (CL.S_Block stms) = (sp(); ppBlock stms)
132 :     | ppStms stm = (
133 :     PP.openVBox strm indent;
134 :     PP.newline strm;
135 :     ppStm stm;
136 :     PP.closeBox strm)
137 :     and ppExp e = (case e
138 :     of CL.E_Grp e => (str "("; ppExp e; str ")")
139 :     | CL.E_BinOp(e1, rator, e2) => (ppExp e1; str(CL.binopToString rator); ppExp e2)
140 :     | CL.E_UnOp(rator, e) => (str(CL.unopToString rator); ppExp e)
141 :     | CL.E_Apply(f, args) => (str f; ppArgs args)
142 :     | CL.E_Subscript(e1, e2) => (ppExp e1; str "["; ppExp e2; str "]")
143 :     | CL.E_Select(e, f) => (ppExp e; str "."; str f)
144 :     | CL.E_Indirect(e, f) => (ppExp e; str "->"; str f)
145 :     | CL.E_Cast(ty, e) => (
146 :     str "("; ppTy(ty, NONE); str ")"; ppExp e)
147 :     | CL.E_Var x => str(CL.varToString x)
148 :     | CL.E_Int(n, CL.T_Num(RawTypes.RT_Int64)) =>
149 :     str(IntegerLit.toString n ^ "l")
150 :     | CL.E_Int(n, _) => str(IntegerLit.toString n)
151 :     | CL.E_Flt(f, CL.T_Num(RawTypes.RT_Float)) =>
152 :     str(FloatLit.toString f ^ "f")
153 :     | CL.E_Flt(f, _) => str(FloatLit.toString f)
154 :     | CL.E_Bool b => str(Bool.toString b)
155 : jhr 528 | CL.E_Str s => str(concat["\"", String.toCString s, "\""])
156 : jhr 525 (* end case *))
157 :     and ppArgs args = (
158 :     str "(";
159 :     PP.openHOVBox strm indent;
160 :     PP.cut strm;
161 :     ppList {
162 :     pp = fn e => (PP.openHBox strm; ppExp e; PP.closeBox strm),
163 :     sep = fn () => (str ","; sp()),
164 :     l = args
165 :     };
166 :     str ")";
167 :     PP.closeBox strm)
168 :     in
169 :     ppDecl decl
170 :     end
171 :    
172 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0