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

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/cxx-util/print-as-cxx.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/cxx-util/print-as-cxx.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 5583, Mon Jul 30 19:23:12 2018 UTC revision 5584, Sun Aug 5 19:54:36 2018 UTC
# Line 20  Line 20 
20      structure PP = TextIOPP      structure PP = TextIOPP
21    
22      val indent0 = (PP.Abs 0)      val indent0 = (PP.Abs 0)
23        val indent2 = (PP.Abs 2)
24      val indent = (PP.Abs 4)     (* standard indentation amount *)      val indent = (PP.Abs 4)     (* standard indentation amount *)
25    
26      fun rawTyName rty = (case rty      fun rawTyName rty = (case rty
# Line 35  Line 36 
36              | RawTypes.RT_Double => "double"              | RawTypes.RT_Double => "double"
37            (* end case *))            (* end case *))
38    
39      (* convert a qualified name to a string *)
40        fun qNameToS (scopes, name) = let
41              fun ppQ [] = [name]
42                | ppQ (CL.SC_Namespace ns :: scopes) = ns :: "::" :: ppQ scopes
43                | ppQ (CL.SC_Type ty :: scopes) = tyToS' ty :: "::" :: ppQ scopes
44              in
45                String.concat(ppQ scopes)
46              end
47    
48      (* convert a type plus optional varaible to a string *)
49        and tyToS (ty, optVar)= let
50              fun prefix (s, "") = s
51                | prefix (s1, s2) = concat[s1, " ", s2]
52              fun wrapArray (tyOp, CL.T_Array(ty', sz), acc) = let
53                    val suffix = (case sz
54                           of NONE => "[]"
55                            | SOME n => concat["[", Int.toString n, "]"]
56                          (* end case *))
57                    in
58                      toS (ty', concat[tyOp, "(", acc, suffix, ")"])
59                    end
60                | wrapArray (tyOp, ty, acc) = toS (ty, prefix(tyOp, acc))
61              and toS (ty, acc) = (case ty
62                     of CL.T_Num nty => prefix(rawTyName nty, acc)
63                      | CL.T_Const ty => toS (ty, prefix("const", acc))
64                      | CL.T_Ptr ty => wrapArray ("*", ty, acc)
65                      | CL.T_Ref ty => wrapArray ("&", ty, acc)
66                      | CL.T_RestrictPtr _ => wrapArray ("* __restrict__", ty, acc)
67                      | CL.T_Array(ty, NONE) => toS (ty, acc ^ "[]")
68                      | CL.T_Array(ty, SOME n) =>
69                          toS (ty, concat[acc, "[", Int.toString n, "]"])
70                      | CL.T_Named ty => prefix(ty, acc)
71                      | CL.T_Template(ty, tyArgs) => let
72                          val args = String.concatWithMap "," tyToS' tyArgs
73                          val suffix = if acc = "" then [] else [" ", acc]
74                          in
75                            concat(
76                              ty :: "<" :: args ::
77                              (if String.isSuffix ">" args then " >" else ">") ::
78                              suffix)
79                          end
80                      | CL.T_Qual(attr, ty) => concat[attr, " ", toS(ty, acc)]
81                      | CL.T_Member(ty as CL.T_Template _, ty') => let
82                          val suffix = if acc = "" then [] else [" ", acc]
83                          in
84                            concat(tyToS' ty :: "::" :: ty' :: suffix)
85                          end
86                      | CL.T_Member _ => raise Fail "ill-formed type member"
87                    (* end case *))
88              in
89                case optVar
90                 of SOME x => toS (ty, qNameToS x)
91                  | NONE => toS (ty, "")
92                (* end case *)
93              end
94    
95      (* convert a type to a string *)
96        and tyToS' ty = tyToS (ty, NONE)
97    
98      fun output (_, CL.D_Verbatim[]) = ()      fun output (_, CL.D_Verbatim[]) = ()
99        | output (strm, decl) = let        | output (strm, decl) = let
100            val str = PP.string strm            val str = PP.string strm
101            fun sp () = PP.space strm 1            fun sp () = PP.space strm 1
102              fun nl () = PP.newline strm
103            fun inHBox f = (PP.openHBox strm; f(); PP.closeBox strm)            fun inHBox f = (PP.openHBox strm; f(); PP.closeBox strm)
104            fun ppCom s = inHBox (fn () => (str "// "; str s))            fun ppCom s = inHBox (fn () => (str "// "; str s))
           fun ppComLn s = (ppCom s; PP.newline strm)  
105            fun ppList {pp, sep, l} = let            fun ppList {pp, sep, l} = let
106                  fun ppList' [] = ()                  fun ppList' [] = ()
107                    | ppList' [x] = pp x                    | ppList' [x] = pp x
# Line 50  Line 110 
110                    ppList' l                    ppList' l
111                  end                  end
112            fun ppCommaList {pp, l} = ppList {pp = pp, sep = fn () => (str ","; sp()), l = l}            fun ppCommaList {pp, l} = ppList {pp = pp, sep = fn () => (str ","; sp()), l = l}
113            fun ppQName (scopes, name) = let            fun ppQName name = str(qNameToS name)
114                  fun ppQ [] = str name            fun ppTyAndVar (ty, x) = str (tyToS (ty, SOME x))
115                    | ppQ (CL.SC_Namespace ns :: scopes) = (str ns; str "::"; ppQ scopes)            fun ppTy ty = str (tyToS (ty, NONE))
                   | ppQ (CL.SC_Type ty :: scopes) = (ppTy (ty, NONE); str "::"; ppQ scopes)  
                 in  
                   inHBox (fn () => ppQ scopes)  
                 end  
           and ppTy (ty, optVar) = let  
                 fun getBaseTy (CL.T_Num rty) = rawTyName rty  
                   | getBaseTy (CL.T_Const(CL.T_Num rty)) = "const " ^ rawTyName rty  
                   | getBaseTy (CL.T_Const(CL.T_Named ty)) = "const " ^ ty  
                   | getBaseTy (CL.T_Const ty) = getBaseTy ty  
                   | getBaseTy (CL.T_Ptr ty) = getBaseTy ty  
                   | getBaseTy (CL.T_RestrictPtr ty) = getBaseTy ty  
                   | getBaseTy (CL.T_Array(ty, _)) = getBaseTy ty  
                   | getBaseTy (CL.T_Named ty) = ty  
 (* FIXME: this isn't right *)  
                   | getBaseTy (CL.T_Template(name, tys)) = concat[  
                         name, "< ", String.concatWith ", " (List.map getBaseTy tys), " >"  
                       ]  
                   | getBaseTy (CL.T_Qual(attr, ty)) = concat[attr, " ", getBaseTy ty]  
                   | getBaseTy (CL.T_Member(CL.T_Named ty, ty')) = concat[ty, "::", ty']  
                   | getBaseTy (CL.T_Member(ty as CL.T_Template _, ty')) =  
                       concat[getBaseTy ty, "::", ty']  
                   | getBaseTy (CL.T_Member _) = raise Fail "ill-formed type member in C++"  
                 fun ppVar (isFirst, SOME x) = (  
                       if isFirst then sp() else ();  
                       ppQName x)  
                   | ppVar _ = ()  
                 fun pp (isFirst, CL.T_Const(CL.T_Num _), optVar) = ppVar (isFirst, optVar)  
                   | pp (isFirst, CL.T_Const(CL.T_Named _), optVar) = ppVar (isFirst, optVar)  
                   | pp (isFirst, CL.T_Const(CL.T_Template _), optVar) = ppVar (isFirst, optVar)  
                   | pp (isFirst, CL.T_Const(CL.T_Member _), optVar) = ppVar (isFirst, optVar)  
                   | pp (isFirst, CL.T_Const ty, optVar) = raise Fail "FIXME"  
                   | pp (isFirst, CL.T_Ptr ty, optVar) = (  
                       if isFirst then sp() else ();  
                       case ty  
                        of CL.T_Array _ => (  
                             str "(*"; pp(false, ty, optVar); str ")")  
                         | _ => (str "*"; pp(false, ty, optVar))  
                       (* end case *))  
                   | pp (isFirst, CL.T_RestrictPtr ty, optVar) = (  
                       if isFirst then sp() else ();  
                       case ty  
                        of CL.T_Array _ => (  
                             str "(*"; sp(); str "__restrict__"; sp(); pp(false, ty, optVar); str ")")  
                         | _ => (str "*"; sp(); str "__restrict__"; sp(); pp(false, ty, optVar))  
                       (* end case *))  
                   | pp (isFirst, CL.T_Array(ty, optN), optVar) = (  
                       pp (isFirst, ty, optVar);  
                       case optN  
                        of NONE => str "[]"  
                         | SOME n => (str "["; str(Int.toString n); str "]")  
                       (* end case *))  
                   | pp (isFirst, CL.T_Qual(_, ty), optVar) =  
                       pp (isFirst, ty, optVar)  
                   | pp (isFirst, _, optVar) = ppVar (isFirst, optVar)  
                 in  
                   str (getBaseTy ty);  
                   pp (true, ty, optVar)  
                 end  
           fun ppTy' ty = ppTy (ty, NONE)  
116            fun ppAttrs [] = ()            fun ppAttrs [] = ()
117              | ppAttrs attrs = (              | ppAttrs attrs = (
118                  ppList {pp=str, sep=sp, l = attrs};                  ppList {pp=str, sep=sp, l = attrs};
119                  sp())                  sp())
120            fun ppDecl (inClass, dcl) = (case dcl            fun ppDecl (inClass, dcl) = (case dcl
121                   of CL.D_Pragma l => (                   of CL.D_Pragma l => (
122                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
123                        inHBox (fn () => (                        inHBox (fn () => (
124                          str "#pragma";                          str "#pragma";
125                          List.app (fn s => (sp(); str s)) l)))                          List.app (fn s => (sp(); str s)) l)))
126                    | CL.D_Comment l => List.app ppComLn l                    | CL.D_Comment[] => ()
127                      | CL.D_Comment(com::coms) => (
128                          ppCom com;
129                          List.app (fn com => (nl(); ppCom com)) coms)
130                    | CL.D_Verbatim [] => ()                    | CL.D_Verbatim [] => ()
131                    | CL.D_Verbatim l => (if inClass then PP.newline strm else (); List.app str l)                    | CL.D_Verbatim l => (if inClass then nl() else (); List.app str l)
132                    | CL.D_Var(attrs, ty, scopes, x, optInit) => (                    | CL.D_Var(attrs, ty, scopes, x, optInit) => (
133                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
134                        inHBox (fn () => (                        inHBox (fn () => (
135                          ppAttrs attrs;                          ppAttrs attrs;
136                          ppTy (ty, SOME(scopes, x));                          ppTyAndVar (ty, (scopes, x));
137                          case optInit                          case optInit
138                           of SOME init => (sp(); str "="; sp(); ppInit init)                           of SOME init => (sp(); str "="; sp(); ppInit init)
139                            | NONE => ()                            | NONE => ()
140                          (* end case *);                          (* end case *);
141                          str ";")))                          str ";")))
142                    | CL.D_Proto(attrs, ty, f, params) => (                    | CL.D_Proto(attrs, ty, f, params) => (
143                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
144                        inHBox (fn () => (                        inHBox (fn () => (
145                          ppAttrs attrs;                          ppAttrs attrs;
146                          ppTy(ty, SOME([], f));                          ppTyAndVar(ty, ([], f));
147                          sp(); str "(";                          sp(); str "(";
148                          ppCommaList {pp=ppParam, l=params};                          ppCommaList {pp=ppParam, l=params};
149                          str ");")))                          str ");")))
150                    | CL.D_Func(attrs, ty, scopes, f, params, body) => (                    | CL.D_Func(attrs, ty, scopes, f, params, body) => (
151                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
152                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
153                          inHBox (fn () => (                          inHBox (fn () => (
154                            ppAttrs attrs;                            ppAttrs attrs;
155                            ppTy' ty;                            ppTy ty;
156                            sp (); ppQName (scopes, f);                            sp (); ppQName (scopes, f);
157                            sp(); str "(";                            sp(); str "(";
158                            ppCommaList {pp=ppParam, l=params};                            ppCommaList {pp=ppParam, l=params};
159                            str ")"));                            str ")"));
160                          PP.newline strm;                          nl();
161                          ppBody body;                          ppBody body;
162                        PP.closeBox strm)                        PP.closeBox strm)
163                    | CL.D_Constr(attrs, scopes, cls, params, initsAndBody) => (                    | CL.D_Constr(attrs, scopes, cls, params, initsAndBody) => (
164                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
165                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
166                          PP.openHBox strm;                          PP.openHBox strm;
167                            ppAttrs attrs;                            ppAttrs attrs;
# Line 174  Line 178 
178                                    else (                                    else (
179                                      PP.closeBox strm;                                      PP.closeBox strm;
180                                      PP.openBox strm indent;                                      PP.openBox strm indent;
181                                        PP.newline strm;                                        nl();
182                                        str ":"; sp();                                        str ":"; sp();
183                                        ppCommaList {pp = ppExp, l = inits};                                        ppCommaList {pp = ppExp, l = inits};
184                                      PP.closeBox strm;                                      PP.closeBox strm;
185                                      PP.newline strm;                                      nl();
186                                      str"{ }"))                                      str"{ }"))
187                              | SOME(inits, body) => (                              | SOME(inits, body) => (
188                                  PP.closeBox strm;                                  PP.closeBox strm;
# Line 186  Line 190 
190                                    then ()                                    then ()
191                                    else (                                    else (
192                                      PP.openBox strm indent;                                      PP.openBox strm indent;
193                                        PP.newline strm;                                        nl();
194                                        str ":"; sp();                                        str ":"; sp();
195                                        ppCommaList {pp = ppExp, l = inits};                                        ppCommaList {pp = ppExp, l = inits};
196                                      PP.closeBox strm);                                      PP.closeBox strm);
197                                  PP.newline strm;                                  nl();
198                                  ppBody body)                                  ppBody body)
199                              | NONE => (str ";"; PP.closeBox strm)                              | NONE => (str ";"; PP.closeBox strm)
200                            (* end case *);                            (* end case *);
201                          (* NOTE: HBox has been closed *)                          (* NOTE: HBox has been closed *)
202                        PP.closeBox strm)                        PP.closeBox strm)
203                    | CL.D_Destr(attrs, scopes, cls, body) => (                    | CL.D_Destr(attrs, scopes, cls, body) => (
204                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
205                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
206                          PP.openHBox strm;                          PP.openHBox strm;
207                            ppAttrs attrs;                            ppAttrs attrs;
# Line 209  Line 213 
213                             of NONE => (str "();"; PP.closeBox strm)                             of NONE => (str "();"; PP.closeBox strm)
214                              | SOME(CL.S_Block[]) => (str "() { }"; PP.closeBox strm)                              | SOME(CL.S_Block[]) => (str "() { }"; PP.closeBox strm)
215                              | SOME body => (                              | SOME body => (
216                                  str "()"; PP.closeBox strm; PP.newline strm; ppBody body)                                  str "()"; PP.closeBox strm; nl(); ppBody body)
217                            (* end case *);                            (* end case *);
218                          (* NOTE: HBox has been closed *)                          (* NOTE: HBox has been closed *)
219                        PP.closeBox strm)                        PP.closeBox strm)
220                    | CL.D_StructDef(SOME name, fields, NONE) => (                    | CL.D_StructDef(SOME name, fields, NONE) => (
221                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
222                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
223                          inHBox (fn () => (str "struct"; sp(); str name; sp(); str "{"));                          inHBox (fn () => (str "struct"; sp(); str name; sp(); str "{"));
224                          PP.openVBox strm indent;                          PP.openVBox strm indent;
225                            List.app (fn (ty, x) => (                            List.app (fn (ty, x) => (
226                                PP.newline strm;                                nl();
227                                inHBox (fn () => (ppTy(ty, SOME([], x)); str ";"))))                                inHBox (fn () => (ppTyAndVar(ty, ([], x)); str ";"))))
228                              fields;                              fields;
229                          PP.closeBox strm;                          PP.closeBox strm;
230                          PP.newline strm;                          nl();
231                          str "};";                          str "};";
232                        PP.closeBox strm)                        PP.closeBox strm)
233                    | CL.D_StructDef(optStruct, fields, SOME tyName) => (                    | CL.D_StructDef(optStruct, fields, SOME tyName) => (
234                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
235                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
236                          str "typedef struct {";                          str "typedef struct {";
237                          PP.openVBox strm indent;                          PP.openVBox strm indent;
238                            List.app (fn (ty, x) => (                            List.app (fn (ty, x) => (
239                                PP.newline strm;                                nl();
240                                inHBox (fn () => (ppTy(ty, SOME([], x)); str ";"))))                                inHBox (fn () => (ppTyAndVar(ty, ([], x)); str ";"))))
241                              fields;                              fields;
242                          PP.closeBox strm;                          PP.closeBox strm;
243                          PP.newline strm;                          nl();
244                          inHBox (fn () => (str "}"; sp(); str tyName; str ";"));                          inHBox (fn () => (str "}"; sp(); str tyName; str ";"));
245                        PP.closeBox strm)                        PP.closeBox strm)
246                    | CL.D_StructDef(NONE, _, NONE) => raise Fail "unamed struct"                    | CL.D_StructDef(NONE, _, NONE) => raise Fail "unamed struct"
247                    | CL.D_ClassDef{name, args, from, public, protected=[], private=[]} => (                    | CL.D_ClassDef{name, args, from, public, protected, private} => let
248                        if inClass then PP.newline strm else ();                        fun ppStart kind = inHBox (fn () => (
249                        PP.openVBox strm indent0;                              str kind; sp(); str name;
                         inHBox (fn () => (  
                           str "struct"; sp(); str name;  
250                            Option.map                            Option.map
251                              (fn tys => (str "<"; ppCommaList {pp=ppTy', l=tys}; str ">"))                                (fn tys => (str "<"; ppCommaList {pp=ppTy, l=tys}; str ">"))
252                                args;                                args;
253                            Option.map (fn base => (sp(); str ":"; sp(); str base)) from;                            Option.map (fn base => (sp(); str ":"; sp(); str base)) from;
254                            sp(); str "{"));                              sp(); str "{"))
255                          in
256                            if inClass then nl() else ();
257                            PP.openVBox strm indent0;
258                              case (protected, private)
259                               of ([], []) => (
260                                    ppStart "struct";
261                          PP.openVBox strm indent;                          PP.openVBox strm indent;
262                            List.app (fn dcl => ppDecl (true, dcl)) public;                            List.app (fn dcl => ppDecl (true, dcl)) public;
263                                    PP.closeBox strm)
264                                | _ => let
265                                    fun ppDecls (vis, []) = ()
266                                      | ppDecls (vis, dcls) = (
267                                          PP.openVBox strm indent2;
268                                            nl(); str vis; str ":";
269                                            PP.openVBox strm indent2;
270                                              List.app (fn dcl => ppDecl (true, dcl)) dcls;
271                          PP.closeBox strm;                          PP.closeBox strm;
                         PP.newline strm;  
                         str "};";  
272                        PP.closeBox strm)                        PP.closeBox strm)
273                    | CL.D_ClassDef{name, args, from, public, protected, private} =>                                  in
274                        raise Fail "FIXME: ClassDef"                                    ppStart "class";
275                                      ppDecls ("public", public);
276                                      ppDecls ("protected", protected);
277                                      ppDecls ("private", private)
278                                    end
279                              (* end case *);
280                              nl();
281                              str "};";
282                            PP.closeBox strm
283                          end
284                      | CL.D_EnumDef{isClass, name, repTy, cons=[]} => (
285                          if inClass then nl() else ();
286                            inHBox (fn () => (
287                              str "enum"; sp();
288                              if isClass then (str "class"; sp()) else ();
289                              str name; sp();
290                              case repTy
291                               of NONE => ()
292                                | SOME ty => (str ":"; sp(); ppTy ty)
293                              (* end case *);
294                              str ";")))
295                      | CL.D_EnumDef{isClass, name, repTy, cons=con::conr} => let
296                          fun ppCon (name, NONE) = str name
297                            | ppCon (name, SOME e) = inHBox (fn () => (
298                                str name; sp(); str "="; sp(); ppExp e))
299                          in
300                            if inClass then nl() else ();
301                            PP.openVBox strm indent0;
302                              inHBox (fn () => (
303                                str "enum"; sp();
304                                if isClass then (str "class"; sp()) else ();
305                                str name; sp();
306                                case repTy
307                                 of NONE => ()
308                                  | SOME ty => (str ":"; sp(); ppTy ty)
309                                (* end case *);
310                                str "{"));
311                              PP.openHVBox strm indent;
312                                ppCon con;
313                                List.app (fn c => (str ","; sp(); ppCon con)) conr;
314                              PP.closeBox strm;
315                              str "};";
316                            PP.closeBox strm
317                          end
318                    | CL.D_Template(params, dcl) => let                    | CL.D_Template(params, dcl) => let
319                        fun ppParam (CL.TypeParam name) = (str "typename"; sp(); str name)                        fun ppParam (CL.TypeParam name) = (str "typename"; sp(); str name)
320                          | ppParam (CL.ConstParam(ty, name)) = (                          | ppParam (CL.ConstParam(ty, name)) = (
321                              str "const"; sp(); ppTy' ty; sp(); str name)                              str "const"; sp(); ppTy ty; sp(); str name)
322                        in                        in
323                          if inClass then PP.newline strm else ();                          if inClass then nl() else ();
324                          PP.openVBox strm indent0;                          PP.openVBox strm indent0;
325                            inHBox (fn () => (                            inHBox (fn () => (
326                              str "template"; sp(); str "<";                              str "template"; sp(); str "<";
327                              ppCommaList {pp = ppParam, l = params};                              ppCommaList {pp = ppParam, l = params};
328                              str ">"));                              str ">"));
329                            PP.newline strm;                            nl();
330                            ppDecl (inClass, dcl);                            ppDecl (inClass, dcl);
331                          PP.closeBox strm                          PP.closeBox strm
332                        end                        end
333                    | CL.D_Typedef(name, ty) => (                    | CL.D_Typedef(name, ty) => (
334                        if inClass then PP.newline strm else ();                        if inClass then nl() else ();
335                        inHBox (fn () => (                        inHBox (fn () => (
336                          str "using"; sp(); str name; sp(); str"="; sp(); ppTy' ty; str ";")))                          str "using"; sp(); str name; sp(); str"="; sp(); ppTy ty; str ";")))
337                    | CL.D_Namespace(name, dcls) => (                    | CL.D_Namespace(name, dcls) => (
338                        if inClass then raise Fail "unexpected namespace inside class decl" else ();                        if inClass then raise Fail "unexpected namespace inside class decl" else ();
339                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
# Line 284  Line 341 
341                          PP.openVBox strm indent;                          PP.openVBox strm indent;
342                            List.app                            List.app
343                              (fn CL.D_Verbatim[] => ()                              (fn CL.D_Verbatim[] => ()
344                                | dcl => (PP.newline strm; ppDecl(false, dcl))                                | dcl => (nl(); ppDecl(false, dcl))
345                              ) dcls;                              ) dcls;
346                          PP.closeBox strm;                          PP.closeBox strm;
347                          PP.newline strm;                          nl();
348                          inHBox (fn () => (str "}"; sp(); str("// namespace " ^ name)));                          inHBox (fn () => (str "}"; sp(); str("// namespace " ^ name)));
349                        PP.closeBox strm)                        PP.closeBox strm)
350                  (* end case *))                  (* end case *))
# Line 295  Line 352 
352              | ppBody stm = ppBlock [stm]              | ppBody stm = ppBlock [stm]
353            and ppParam (CL.PARAM(attrs, ty, x)) = (            and ppParam (CL.PARAM(attrs, ty, x)) = (
354                  ppAttrs attrs;                  ppAttrs attrs;
355                  ppTy(ty, SOME([], CL.varToString x)))                  ppTyAndVar(ty, ([], CL.varToString x)))
356            and ppInit init = (case init            and ppInit init = (case init
357                   of CL.I_Exp e => ppExp e                   of CL.I_Exp e => ppExp e
358                    | CL.I_Exps fields => (                    | CL.I_Exps fields => (
# Line 330  Line 387 
387                        str "}")                        str "}")
388                    | CL.I_Cons(ty, args) => (                    | CL.I_Cons(ty, args) => (
389                        PP.openHVBox strm indent;                        PP.openHVBox strm indent;
390                          ppTy' ty; ppArgs args; str ";";                          ppTy ty; ppArgs args; str ";";
391                        PP.closeBox strm)                        PP.closeBox strm)
392                  (* end case *))                  (* end case *))
393            and ppBlock stms = (            and ppBlock stms = (
394                  str "{";                  str "{";
395                  PP.openVBox strm indent;                  PP.openVBox strm indent;
396                    List.app (fn stm => (PP.newline strm; ppStm stm)) stms;                    List.app (fn stm => (nl(); ppStm stm)) stms;
397                  PP.closeBox strm;                  PP.closeBox strm;
398                  PP.newline strm;                  nl();
399                  str "}")                  str "}")
400            and ppStm stm = (case stm            and ppStm stm = (case stm
401                   of CL.S_Block stms => ppBlock stms                   of CL.S_Block stms => ppBlock stms
# Line 346  Line 403 
403                    | CL.S_Verbatim [] => ()                    | CL.S_Verbatim [] => ()
404                    | CL.S_Verbatim (stm::stms) => (                    | CL.S_Verbatim (stm::stms) => (
405                        str stm;                        str stm;
406                        List.app (fn stm => (PP.newline strm; str stm)) stms)                        List.app (fn stm => (nl(); str stm)) stms)
407                    | CL.S_Decl(attrs, ty, x, NONE) => inHBox (fn () => (                    | CL.S_Decl(attrs, ty, x, NONE) => inHBox (fn () => (
408                        ppAttrs attrs;                        ppAttrs attrs;
409                        ppTy(ty, SOME([], x)); str ";"))                        ppTyAndVar(ty, ([], x)); str ";"))
410                    | CL.S_Decl(attrs, ty, x, SOME e) => inHBox (fn () => (                    | CL.S_Decl(attrs, ty, x, SOME e) => inHBox (fn () => (
411                        ppAttrs attrs;                        ppAttrs attrs;
412                        ppTy(ty, SOME([], x)); sp(); str "="; sp(); ppInit e; str ";"))                        ppTyAndVar(ty, ([], x)); sp(); str "="; sp(); ppInit e; str ";"))
413                    | CL.S_Exp e => inHBox (fn () => (ppExp e; str ";"))                    | CL.S_Exp e => inHBox (fn () => (ppExp e; str ";"))
414                    | CL.S_If(e, blk, CL.S_Block[]) =>                    | CL.S_If(e, blk, CL.S_Block[]) =>
415                        inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk))                        inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk))
416                    | CL.S_If(e, blk1, stm as CL.S_If _) => (                    | CL.S_If(e, blk1, stm as CL.S_If _) => (
417                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
418                          inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk1));                          inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk1));
419                          PP.newline strm;                          nl();
420                        PP.closeBox strm;                        PP.closeBox strm;
421                        inHBox (fn () => (str "else"; sp(); ppStm stm)))                        inHBox (fn () => (str "else"; sp(); ppStm stm)))
422                    | CL.S_If(e, blk1, blk2) => (                    | CL.S_If(e, blk1, blk2) => (
423                        PP.openVBox strm indent0;                        PP.openVBox strm indent0;
424                          inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk1));                          inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk1));
425                          PP.newline strm;                          nl();
426                          inHBox (fn () => (str "else"; ppStmAsBlock blk2));                          inHBox (fn () => (str "else"; ppStmAsBlock blk2));
427                        PP.closeBox strm)                        PP.closeBox strm)
428                      | CL.S_Switch(e, cases) => let
429                          fun ppCase (labels, stms) = (
430                                if List.null labels
431                                  then (nl(); str "default:")
432                                  else List.app
433                                    (fn lab => inHBox(fn () => (
434                                        nl(); str "case"; sp(); str lab; str ":")))
435                                      labels;
436                                PP.openVBox strm indent2;
437                                  List.app (fn stm => (nl(); ppStm stm)) stms;
438                                PP.closeBox strm)
439                          in
440                            PP.openVBox strm indent0;
441                              inHBox (fn () => (str "switch"; sp(); ppExp e; sp(); str "{"));
442                              PP.openVBox strm indent2;
443                                List.app ppCase cases;
444                              PP.closeBox strm;
445                              nl (); str "}";
446                            PP.closeBox strm
447                          end
448                    | CL.S_While(e, blk) =>                    | CL.S_While(e, blk) =>
449                        inHBox (fn () => (str "while"; sp(); ppExp e; ppStmAsBlock blk))                        inHBox (fn () => (str "while"; sp(); ppExp e; ppStmAsBlock blk))
450                    | CL.S_DoWhile(blk, e) =>                    | CL.S_DoWhile(blk, e) =>
# Line 377  Line 454 
454                        str "for"; sp(); str "(";                        str "for"; sp(); str "(";
455                        case dcls                        case dcls
456                         of (x, e)::rest => (                         of (x, e)::rest => (
457                              ppTy(ty, SOME([], x)); sp(); str "="; sp(); ppExp e;                              ppTyAndVar(ty, ([], x)); sp(); str "="; sp(); ppExp e;
458                              List.app                              List.app
459                                (fn (x, e) => (str ","; sp(); str x; sp(); str "="; sp(); ppExp e))                                (fn (x, e) => (str ","; sp(); str x; sp(); str "="; sp(); ppExp e))
460                                  rest)                                  rest)
# Line 414  Line 491 
491                    | CL.E_TApply(prefix, f, tys, args) => (                    | CL.E_TApply(prefix, f, tys, args) => (
492                        ppQName(prefix, f); str "<";                        ppQName(prefix, f); str "<";
493                        ppCommaList {                        ppCommaList {
494                            pp = fn ty => (PP.openHBox strm; ppTy' ty; PP.closeBox strm),                            pp = fn ty => (PP.openHBox strm; ppTy ty; PP.closeBox strm),
495                            l = tys                            l = tys
496                          };                          };
497                        str ">"; ppArgs args)                        str ">"; ppArgs args)
498                    | CL.E_QId(prefix, id) => ppQName(prefix, id)                    | CL.E_QId(prefix, id) => ppQName(prefix, id)
499                    | CL.E_Cons(ty, args) => (ppTy' ty; ppArgs args)                    | CL.E_Cons(ty, args) => (ppTy ty; ppArgs args)
500                    | CL.E_New(ty, args) => (                    | CL.E_New(ty, args) => (
501                        str "new"; sp(); ppTy' ty;                        str "new"; sp(); ppTy ty;
502                        case (ty, args)                        case (ty, args)
503                         of (CL.T_Named ty, []) => str ty                         of (CL.T_Named ty, []) => str ty
504                          | (CL.T_Template _, []) => ppTy' ty                          | (CL.T_Template _, []) => ppTy ty
505                          | (CL.T_Named ty, args) => (str ty; ppArgs args)                          | (CL.T_Named ty, args) => (str ty; ppArgs args)
506                          | (CL.T_Template _, args) => (ppTy' ty; ppArgs args)                          | (CL.T_Template _, args) => (ppTy ty; ppArgs args)
507                          | (ty, []) => ppTy' ty                          | (ty, []) => ppTy ty
508                          | _ => raise Fail "bogus new"                          | _ => raise Fail "bogus new"
509                        (* end case *))                        (* end case *))
510                    | CL.E_Subscript(e1, e2) => (ppExp e1; str "["; ppExp e2; str "]")                    | CL.E_Subscript(e1, e2) => (ppExp e1; str "["; ppExp e2; str "]")
511                    | CL.E_Select(e, f) => (ppExp e; str "."; str f)                    | CL.E_Select(e, f) => (ppExp e; str "."; str f)
512                    | CL.E_Indirect(e, f) => (ppExp e; str "->"; str f)                    | CL.E_Indirect(e, f) => (ppExp e; str "->"; str f)
513                    | CL.E_Cast(ty, e) => (str "("; ppTy' ty; str ")"; ppExp e)                    | CL.E_Cast(ty, e) => (str "("; ppTy ty; str ")"; ppExp e)
514                    | CL.E_XCast(c, ty, e) => (                    | CL.E_XCast(c, ty, e) => (
515                        str c; str "<"; ppTy' ty; str ">("; ppExp e; str ")")                        str c; str "<"; ppTy ty; str ">("; ppExp e; str ")")
516                    | CL.E_Vec(ty, args) => (                    | CL.E_Vec(ty, args) => (
517                      (* GCC vector syntax: "__extension__ (ty){a, b, ...}" *)                      (* GCC vector syntax: "__extension__ (ty){a, b, ...}" *)
518                        str "__extension__"; sp(); str "("; ppTy' ty; str ")";                        str "__extension__"; sp(); str "("; ppTy ty; str ")";
519                        str "{";                        str "{";
520                        PP.openHOVBox strm indent;                        PP.openHOVBox strm indent;
521                          PP.cut strm;                          PP.cut strm;
# Line 484  Line 561 
561                    | CL.E_Bool b => str(Bool.toString b)                    | CL.E_Bool b => str(Bool.toString b)
562                    | CL.E_Str s => str(concat["\"", String.toCString s, "\""])                    | CL.E_Str s => str(concat["\"", String.toCString s, "\""])
563                    | CL.E_Char c => str(concat["'", Char.toCString c, "'"])                    | CL.E_Char c => str(concat["'", Char.toCString c, "'"])
564                    | CL.E_Sizeof ty => (str "sizeof("; ppTy' ty; str ")")                    | CL.E_Sizeof ty => (str "sizeof("; ppTy ty; str ")")
565                  (* end case *))                  (* end case *))
566            and ppArgs args = (            and ppArgs args = (
567                  str "(";                  str "(";
# Line 499  Line 576 
576            in            in
577              PP.openVBox strm indent0;              PP.openVBox strm indent0;
578                ppDecl (false, decl);                ppDecl (false, decl);
579                PP.newline strm;                nl();
580              PP.closeBox strm              PP.closeBox strm
581            end            end
582    

Legend:
Removed from v.5583  
changed lines
  Added in v.5584

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