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

SCM Repository

[diderot] Diff of /branches/charisee/src/compiler/codegen/clang.sml
ViewVC logotype

Diff of /branches/charisee/src/compiler/codegen/clang.sml

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

revision 1368, Wed Jun 22 20:58:28 2011 UTC revision 2356, Sun Apr 7 14:45:25 2013 UTC
# Line 19  Line 19 
19        | T_Ptr of ty        | T_Ptr of ty
20        | T_Array of ty * int option        | T_Array of ty * int option
21        | T_Named of string        | T_Named of string
22          | T_Qual of attr * ty     (* qualified type *)
23    
24      datatype typed_var = V of ty * var      datatype typed_var = V of ty * var
25    
26      val voidTy = T_Named "void"      val voidTy = T_Named "void"
27        val voidPtr = T_Ptr voidTy
28      val charTy = T_Named "char"      val charTy = T_Named "char"
29      val boolTy = T_Named "bool"      val boolTy = T_Named "bool"
30      val charPtr = T_Ptr(charTy)      val charPtr = T_Ptr charTy
31      val charArrayPtr = T_Ptr(charPtr)      val charArrayPtr = T_Ptr charPtr
32      val intTy = T_Named "int"      val intTy = T_Named "int"
33        val int8 = T_Num(RawTypes.RT_Int8)
34        val uint8 = T_Num(RawTypes.RT_UInt8)
35      val int32 = T_Num(RawTypes.RT_Int32)      val int32 = T_Num(RawTypes.RT_Int32)
36      val uint32 = T_Num(RawTypes.RT_UInt32)      val uint32 = T_Num(RawTypes.RT_UInt32)
37      val int64 = T_Num(RawTypes.RT_Int64)      val int64 = T_Num(RawTypes.RT_Int64)
# Line 35  Line 39 
39      val double = T_Num(RawTypes.RT_Double)      val double = T_Num(RawTypes.RT_Double)
40    
41      datatype decl      datatype decl
42        = D_Comment of string list        = D_Pragma of string list
43          | D_Comment of string list
44      (* verbatim text (e.g., preprocessor directives) *)      (* verbatim text (e.g., preprocessor directives) *)
45        | D_Verbatim of string list        | D_Verbatim of string list
46      (* global variable declaration *)      (* global variable declaration *)
47        | D_Var of attr list * ty * var * initializer option        | D_Var of attr list * ty * var * initializer option
48        (* function prototype *)
49          | D_Proto of attr list * ty * string * param list
50      (* function definition *)      (* function definition *)
51        | D_Func of attr list * ty * string * param list * stm        | D_Func of attr list * ty * string * param list * stm
52      (* typedef of struct type *)      (* struct type declaration; if the second argument is SOME name, then a
53        | D_StructDef of (ty * string) list * string       * typedef is generated.
54         *)
55          | D_StructDef of string option * (ty * string) list * string option
56    
57      and initializer      and initializer
58        = I_Exp of exp        = I_Exp of exp
# Line 55  Line 64 
64      and stm      and stm
65        = S_Block of stm list             (* "{" stms "}" *)        = S_Block of stm list             (* "{" stms "}" *)
66        | S_Comment of string list        | S_Comment of string list
67          | S_Verbatim of string list
68        | S_Decl of attr list * ty * var * initializer option        | S_Decl of attr list * ty * var * initializer option
69                                          (* ty var [ '=' exp ]';' *)                                          (* ty var [ '=' exp ]';' *)
70        | S_Exp of exp                    (* exp ';' *)        | S_Exp of exp                    (* exp ';' *)
71        | S_If of exp * stm * stm         (* 'if' exp stm 'else' stm *)        | S_If of exp * stm * stm         (* 'if' exp stm 'else' stm *)
72        | S_While of exp * stm            (* 'while' exp stm *)        | S_While of exp * stm            (* 'while' exp stm *)
73          | S_DoWhile of stm * exp          (* 'do' stm 'while' exp *)
74        | S_For of (ty * var * exp) list * exp * exp list * stm        | S_For of (ty * var * exp) list * exp * exp list * stm
75                                          (* 'for' '(' inits ';' exp ';' incrs ')' stm *)                                          (* 'for' '(' inits ';' exp ';' incrs ')' stm *)
76        | S_Call of string * exp list     (* func '(' args ')' *)        | S_Call of string * exp list     (* func '(' args ')' *)
# Line 70  Line 81 
81      and exp      and exp
82        = E_Grp of exp                    (* "(" e ")" *)        = E_Grp of exp                    (* "(" e ")" *)
83        | E_AssignOp of exp * assignop * exp (* lvalue op= e *)        | E_AssignOp of exp * assignop * exp (* lvalue op= e *)
84          | E_Cond of exp * exp * exp       (* e "?" e ":" e *)
85        | E_BinOp of exp * binop * exp    (* e op e *)        | E_BinOp of exp * binop * exp    (* e op e *)
86        | E_UnOp of unop * exp            (* op e *)        | E_UnOp of unop * exp            (* op e *)
87        | E_PostOp of exp * postfix       (* e op *)        | E_PostOp of exp * postfix       (* e op *)
# Line 93  Line 105 
105      and binop      and binop
106        = #||        = #||
107        | #&&        | #&&
108          | #|
109          | #^
110          | #&
111        | #== | #!=        | #== | #!=
112        | #< | #<= | #>= | #>        | #< | #<= | #>= | #>
113        | #<< | #>>        | #<< | #>>
# Line 111  Line 126 
126        val lorP          = 3        val lorP          = 3
127        val landP         = 4        val landP         = 4
128        val borP          = 5        val borP          = 5
129        val bandP         = 6        val bxorP         = 6
130        val eqP           = 7        val bandP         = 7
131        val relP          = 8        val eqP           = 8
132        val shiftP        = 9        val relP          = 9
133        val addP          = 10        val shiftP        = 10
134        val mulP          = 11        val addP          = 11
135        val unaryP        = 12        val mulP          = 12
136        val preP          = 13        val castP         = 13
137        val compundP      = 14    (* compound literal *)        val unaryP        = 14
138        val postP         = 15        val preP          = 15
139        val callP         = 16        val compundP      = 16    (* compound literal *)
140        val subP          = 17        val postP         = 17
141        val atomP         = 18        val callP         = 18
142          val subP          = 19
143          val atomP         = 20
144        fun precOfBinop rator = (case rator        fun precOfBinop rator = (case rator
145               of #|| => lorP               of #|| => lorP
146                | #&& => landP                | #&& => landP
147                  | #| => borP
148                  | #^ => bxorP
149                  | #& => bandP
150                | #== => eqP | #!= => eqP                | #== => eqP | #!= => eqP
151                | #< => relP | #<= => relP | #>= => relP | #> => relP                | #< => relP | #<= => relP | #>= => relP | #> => relP
152                | #<< => shiftP | #>> => shiftP                | #<< => shiftP | #>> => shiftP
# Line 135  Line 155 
155              (* end case *))              (* end case *))
156        fun prec (E_Grp _) = atomP        fun prec (E_Grp _) = atomP
157          | prec (E_AssignOp _) = assignP          | prec (E_AssignOp _) = assignP
158            | prec (E_Cond _) = condP
159          | prec (E_BinOp(_, rator, _)) = precOfBinop rator          | prec (E_BinOp(_, rator, _)) = precOfBinop rator
160          | prec (E_UnOp _) = preP          | prec (E_UnOp _) = preP
161          | prec (E_PostOp _) = postP          | prec (E_PostOp _) = postP
# Line 142  Line 163 
163          | prec (E_Subscript _) = postP          | prec (E_Subscript _) = postP
164          | prec (E_Select _) = postP          | prec (E_Select _) = postP
165          | prec (E_Indirect _) = postP          | prec (E_Indirect _) = postP
166          | prec (E_Cast _) = unaryP          | prec (E_Cast _) = castP
167          | prec (E_Var _) = atomP          | prec (E_Var _) = atomP
168          | prec (E_Int _) = atomP          | prec (E_Int _) = atomP
169          | prec (E_Flt _) = atomP          | prec (E_Flt _) = atomP
# Line 157  Line 178 
178            in            in
179              E_AssignOp(e1', rator, e2')              E_AssignOp(e1', rator, e2')
180            end            end
181      (* note that we over-parenthesize here, but it makes nested conditionals easeier to read *)
182        fun mkCond (e1, e2, e3) = E_Cond(
183              if prec e1 <= condP then E_Grp e1 else e1,
184              if prec e2 <= condP then E_Grp e2 else e2,
185              if prec e3 < condP then E_Grp e3 else e3)
186    (* Note that all C binary operators are left associative. *)    (* Note that all C binary operators are left associative. *)
187      fun mkBinOp (e1, #-, e2 as E_UnOp(%-, _)) = let      fun mkBinOp (e1, #-, e2 as E_UnOp(%-, _)) = let
188            val e1' = if prec e1 < addP then E_Grp e1 else e1            val e1' = if prec e1 < addP then E_Grp e1 else e1
# Line 175  Line 201 
201        | mkUnOp (%-, e as E_UnOp(%--, _)) = E_UnOp(%-, E_Grp e)        | mkUnOp (%-, e as E_UnOp(%--, _)) = E_UnOp(%-, E_Grp e)
202        | mkUnOp (%--, e as E_UnOp(%-, _)) = E_UnOp(%--, E_Grp e)        | mkUnOp (%--, e as E_UnOp(%-, _)) = E_UnOp(%--, E_Grp e)
203        | mkUnOp (%--, e as E_UnOp(%--, _)) = E_UnOp(%--, E_Grp e)        | mkUnOp (%--, e as E_UnOp(%--, _)) = E_UnOp(%--, E_Grp e)
204          | mkUnOp (%&, E_UnOp(%*, e)) = e
205          | mkUnOp (%*, E_UnOp(%&, e)) = e
206        | mkUnOp (rator, e) = if prec e < unaryP        | mkUnOp (rator, e) = if prec e < unaryP
207            then E_UnOp(rator, E_Grp e)            then E_UnOp(rator, E_Grp e)
208            else E_UnOp(rator, e)            else E_UnOp(rator, e)
# Line 191  Line 219 
219      fun mkIndirect (e, f) = if prec e < postP      fun mkIndirect (e, f) = if prec e < postP
220            then E_Indirect(E_Grp e, f)            then E_Indirect(E_Grp e, f)
221            else E_Indirect(e, f)            else E_Indirect(e, f)
222      fun mkCast (ty, e) = E_Cast(ty, e)      fun mkCast (ty, e) = if prec e < castP
223              then E_Cast(ty, E_Grp e)
224              else E_Cast(ty, e)
225      val mkVar = E_Var      val mkVar = E_Var
226      fun mkIntTy (n, ty) = if n < 0 then E_UnOp(%-, E_Int(~n, ty)) else E_Int(n, ty)      fun mkIntTy (n, ty) = if n < 0 then E_UnOp(%-, E_Int(~n, ty)) else E_Int(n, ty)
227      fun mkInt n = mkIntTy(n, intTy)      fun mkInt n = mkIntTy(n, intTy)
# Line 212  Line 242 
242      val mkComment = S_Comment      val mkComment = S_Comment
243      fun mkBlock [stm] = stm      fun mkBlock [stm] = stm
244        | mkBlock stms = S_Block stms        | mkBlock stms = S_Block stms
245        fun unBlock (S_Block stms) = stms
246          | unBlock stm = [stm]
247        fun prependStm (stm, blk) = mkBlock(stm :: unBlock blk)
248        fun appendStm (blk, stm) = mkBlock(unBlock blk @ [stm])
249      fun mkDecl (ty, x, init) = S_Decl([], ty, x, init)      fun mkDecl (ty, x, init) = S_Decl([], ty, x, init)
250        fun mkDeclInit (ty, x, init) = S_Decl([], ty, x, SOME(I_Exp init))
251      val mkAttrDecl = S_Decl      val mkAttrDecl = S_Decl
252      val mkExpStm = S_Exp      val mkExpStm = S_Exp
253      fun mkAssign (e1, e2) = S_Exp(mkAssignOp(e1, $=, e2))      fun mkAssign (e1, e2) = S_Exp(mkAssignOp(e1, $=, e2))
# Line 220  Line 255 
255      fun mkIfThen (e, b) = mkIfThenElse (e, b, skip)      fun mkIfThen (e, b) = mkIfThenElse (e, b, skip)
256      val mkFor = S_For      val mkFor = S_For
257      fun mkWhile (e, b) = S_While(paren e, b)      fun mkWhile (e, b) = S_While(paren e, b)
258        fun mkDoWhile (b, e) = S_DoWhile(b, paren e)
259      val mkCall = S_Call      val mkCall = S_Call
260      val mkReturn = S_Return      val mkReturn = S_Return
261      val mkBreak = S_Break      val mkBreak = S_Break
# Line 247  Line 283 
283             of #|| => "||"             of #|| => "||"
284              | #&& => "&&"              | #&& => "&&"
285              | #== => "=="              | #== => "=="
286                | #| => "|"
287                | #^ => "^"
288                | #& => "&"
289              | #!= => "!="              | #!= => "!="
290              | #< => "<"              | #< => "<"
291              | #<= => "<="              | #<= => "<="
# Line 276  Line 315 
315              | ^-- => "--"              | ^-- => "--"
316            (* end case *))            (* end case *))
317    
318      (* generate verbatim text from a template string by substituting for placeholders
319       * Placeholders have the syntax @<id>@ and are replaced with the string associated
320       * with <id> in the list of substitutions.  If <id> is empty, then no substitution
321       * is applied, instead the "@@" is replaced by "@".
322       *)
323        local
324          structure SS = Substring
325          fun verbatim sl subs = let
326                fun scan (start, ss, n, frags) = (case SS.getc ss
327                       of SOME(#"@", rest) => let
328                            val frags = SS.slice(start, 0, SOME n) :: frags
329                            val (expansion, rest) = scanPlaceholder rest
330                            in
331                              scan (rest, rest, 0, expansion::frags)
332                            end
333                        | SOME(_, rest) => scan (start, rest, n+1, frags)
334                        | NONE => SS.concat(List.rev(start::frags))
335                      (* end case *))
336                and scanPlaceholder start = let
337                      fun scan (ss, n) = (case SS.getc ss
338                             of NONE => raise Fail "incomplete placeholder"
339                              | SOME(#"@", rest) => (SS.string(SS.slice(start, 0, SOME n)), rest)
340                              | SOME(_, rest) => scan (rest, n+1)
341                            (* end case *))
342                      val (placeholder, rest) = scan (start, 0)
343                      in
344                        if (placeholder = "")
345                          then (SS.full "@", rest)
346                          else (case List.find (fn (s, _) => (s = placeholder)) subs
347                             of SOME(_, expansion) => (SS.full expansion, rest)
348                              | NONE => raise Fail(concat["unknown placeholder @", placeholder, "@"])
349                            (* end case *))
350                      end
351                fun expand s = let
352                      val ss = SS.full s
353                      in
354                        scan (ss, ss, 0, [])
355                      end
356                in
357                  List.map expand sl
358                end
359        in
360        fun verbatimDcl sl subs = D_Verbatim(verbatim sl subs)
361        fun verbatimStm sl subs = S_Verbatim(verbatim sl subs)
362        end (* local *)
363    
364    (* for debugging (not syntactically correct!) *)    (* for debugging (not syntactically correct!) *)
365      fun expToString e = let      fun expToString e = let
366            fun e2s (e, l) = (case e            fun e2s (e, l) = (case e
367                 of E_Grp e => "(" :: e2s(e, ")"::l)                 of E_Grp e => "(" :: e2s(e, ")"::l)
368                  | E_AssignOp(e1, rator, e2) => e2s(e1, assignopToString rator :: e2s(e2, l))                  | E_AssignOp(e1, rator, e2) => e2s(e1, assignopToString rator :: e2s(e2, l))
369                    | E_Cond(e1, e2, e3) => "(" :: e2s(e1, "?" :: e2s(e2, ":" :: e2s (e3, ")" :: l)))
370                  | E_BinOp(e1, rator, e2) => e2s(e1, binopToString rator :: e2s(e2, l))                  | E_BinOp(e1, rator, e2) => e2s(e1, binopToString rator :: e2s(e2, l))
371                  | E_UnOp(rator, e) => unopToString rator :: e2s(e, l)                  | E_UnOp(rator, e) => unopToString rator :: e2s(e, l)
372                  | E_PostOp(e, rator) => e2s(e, postopToString rator :: l)                  | E_PostOp(e, rator) => e2s(e, postopToString rator :: l)
# Line 294  Line 380 
380                  | E_Subscript(e1, e2) => e2s(e1, "[" :: e2s(e2, "]"::l))                  | E_Subscript(e1, e2) => e2s(e1, "[" :: e2s(e2, "]"::l))
381                  | E_Select(e, f) => e2s(e, "." :: f :: l)                  | E_Select(e, f) => e2s(e, "." :: f :: l)
382                  | E_Indirect(e, f) => e2s(e, "->" :: f :: l)                  | E_Indirect(e, f) => e2s(e, "->" :: f :: l)
383                  | E_Cast(ty, e) => "(ty)" :: e2s(e, l)  (* FIXME *)                  | E_Cast(ty, e) => "(ty)" :: e2s(e, l)  (* FIXME: need tyToString *)
384                  | E_Var x => x::l                  | E_Var x => x::l
385                  | E_Int(n, _) => IntegerLit.toString n :: l                  | E_Int(n, _) => IntegerLit.toString n :: l
386                  | E_Flt(f, _) => FloatLit.toString f :: l                  | E_Flt(f, _) => FloatLit.toString f :: l

Legend:
Removed from v.1368  
changed lines
  Added in v.2356

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