| 1 : |
dbm |
597 |
(* Copyright (c) 1998 by Lucent Technologies *)
|
| 2 : |
|
|
|
| 3 : |
|
|
(* The simplify transformation normalizes the C code by:
|
| 4 : |
|
|
* o getting rid of pre and post-increments
|
| 5 : |
|
|
* o getting rid of op='s
|
| 6 : |
|
|
* o getting rid of nested assignments w/in expressions
|
| 7 : |
|
|
* o getting rid of comma expressions
|
| 8 : |
|
|
* o getting rid of questioncolon expressions
|
| 9 : |
|
|
* o getting rid of arrows
|
| 10 : |
|
|
* o translating all breaks and continues into jumps
|
| 11 : |
|
|
* o translating all do, whiles, and fors into conditional jumps
|
| 12 : |
|
|
* o translating all Label (id,stmt) into sequences Label (id,emptyStmt); stmt
|
| 13 : |
|
|
* which allows for a more unified expression of control flow.
|
| 14 : |
|
|
* o translating all global/static variables without (or with only partial)
|
| 15 : |
|
|
* initializations into into explicit initializations to 0.
|
| 16 : |
|
|
* o translating all local variable initializations into explicit assignments.
|
| 17 : |
|
|
*
|
| 18 : |
|
|
* The transformation introduces new identifiers, expressions, and statements.
|
| 19 : |
|
|
* The pidtab and the aidtab are kept consistent but the opaidtab is not since it
|
| 20 : |
|
|
* shouldn't be needed after this transformation. The tidtab is not affected by
|
| 21 : |
|
|
* the transformation.
|
| 22 : |
|
|
*
|
| 23 : |
|
|
* The main transformation in the system is the simplicication of expressions into
|
| 24 : |
|
|
* non-sideffecting forms. All side effects (op==,pre/pos-increment,assignment)
|
| 25 : |
|
|
* expressions are lifted to statements. The grammar of expressions after this
|
| 26 : |
|
|
* transformation is:
|
| 27 : |
|
|
*
|
| 28 : |
|
|
* exp ::= id
|
| 29 : |
|
|
* | constant
|
| 30 : |
|
|
* | primapp exp* - where the primapp does not have a side-effect
|
| 31 : |
|
|
* | exp.exp
|
| 32 : |
|
|
* | exp->exp
|
| 33 : |
|
|
* | exp[exp]
|
| 34 : |
|
|
* | *exp
|
| 35 : |
|
|
* | &exp
|
| 36 : |
|
|
* | sizeof exp - sizeof should have already been eliminated
|
| 37 : |
|
|
* | {exp*}
|
| 38 : |
|
|
*
|
| 39 : |
|
|
* within the context of statements, where assignments and function calls must
|
| 40 : |
|
|
* occur, top level expression have the following syntax:
|
| 41 : |
|
|
*
|
| 42 : |
|
|
* topExp ::= exp - ie the new, restricted form of expressions
|
| 43 : |
|
|
* | exp (exp* ) - function calls
|
| 44 : |
|
|
* | exp := exp - simple assignments
|
| 45 : |
|
|
* | exp := exp (exp* ) - assignments of function call values
|
| 46 : |
|
|
*
|
| 47 : |
|
|
*
|
| 48 : |
|
|
* Issues:
|
| 49 : |
|
|
* Consider the following code:
|
| 50 : |
|
|
*
|
| 51 : |
|
|
* x->y->m += 12;
|
| 52 : |
|
|
*
|
| 53 : |
|
|
* This gets translated into:
|
| 54 : |
|
|
*
|
| 55 : |
|
|
* x->y->m = x->y->m + 12;
|
| 56 : |
|
|
*
|
| 57 : |
|
|
* by copying the arbitraily complex expression (x->y->m).
|
| 58 : |
|
|
* The alternative is to introduce a temporary variable:
|
| 59 : |
|
|
*
|
| 60 : |
|
|
* temp = x->y
|
| 61 : |
|
|
* temp->m = temp->m + 12;
|
| 62 : |
|
|
*
|
| 63 : |
|
|
* but this transformation is subtle as you can't write:
|
| 64 : |
|
|
*
|
| 65 : |
|
|
* temp = x->y->m
|
| 66 : |
|
|
* temp = temp + 12;
|
| 67 : |
|
|
*
|
| 68 : |
|
|
*)
|
| 69 : |
|
|
|
| 70 : |
|
|
structure SimplifyAst : SIMPLIFYAST =
|
| 71 : |
|
|
struct
|
| 72 : |
|
|
|
| 73 : |
|
|
structure Ast = Ast
|
| 74 : |
|
|
structure Copy = CopyAst
|
| 75 : |
|
|
open Ast
|
| 76 : |
|
|
|
| 77 : |
|
|
exception simplifyExn
|
| 78 : |
|
|
|
| 79 : |
|
|
fun warn msg = print msg
|
| 80 : |
|
|
|
| 81 : |
|
|
fun fail msg = (print msg; raise simplifyExn)
|
| 82 : |
|
|
|
| 83 : |
|
|
val strictlyPrintable = ref true (* try to make it acceptable C code: see handling of casts *)
|
| 84 : |
|
|
|
| 85 : |
|
|
val sizeOf = Sizeof.byteSizeOf {warn=warn,err=fail, bug=fail}
|
| 86 : |
|
|
|
| 87 : |
|
|
fun lookup looker id =
|
| 88 : |
|
|
case looker id
|
| 89 : |
|
|
of NONE => fail "trying to lookup id"
|
| 90 : |
|
|
| SOME v => v
|
| 91 : |
|
|
|
| 92 : |
|
|
fun simplifyAst (edecls,tidtab,aidtab,opaidtab) =
|
| 93 : |
|
|
let
|
| 94 : |
|
|
val esctab = Pidtab.uidtab () : unit Pidtab.uidtab
|
| 95 : |
|
|
val getTid = lookup (fn tid => Tidtab.find (tidtab,tid))
|
| 96 : |
|
|
val getOpAid = lookup (fn aid => Aidtab.find (opaidtab,aid))
|
| 97 : |
|
|
|
| 98 : |
|
|
fun copyExp exp = Copy.copyExpr aidtab exp
|
| 99 : |
|
|
|
| 100 : |
|
|
fun newLabel name =
|
| 101 : |
|
|
{ name=Symbol.label name
|
| 102 : |
|
|
, uid = Pid.new ()
|
| 103 : |
|
|
, location=SourceMap.UNKNOWN
|
| 104 : |
|
|
}
|
| 105 : |
|
|
|
| 106 : |
|
|
fun newId name ctype =
|
| 107 : |
|
|
{ name=Symbol.object name
|
| 108 : |
|
|
, uid=Pid.new()
|
| 109 : |
|
|
, location=SourceMap.UNKNOWN
|
| 110 : |
|
|
, ctype=ctype
|
| 111 : |
|
|
, stClass=Ast.DEFAULT,
|
| 112 : |
|
|
global=false,
|
| 113 : |
|
|
status=DECLARED
|
| 114 : |
|
|
, kind= if TypeUtil.isFunction tidtab ctype then Ast.FUNCTION{hasFunctionDef=false}
|
| 115 : |
|
|
else Ast.NONFUN
|
| 116 : |
|
|
}
|
| 117 : |
|
|
|
| 118 : |
|
|
fun addEscape pid =
|
| 119 : |
|
|
Pidtab.insert(esctab,pid,())
|
| 120 : |
|
|
|
| 121 : |
|
|
(* fix: this code is incomplete ... *)
|
| 122 : |
|
|
(* lval ::= id | id.field | expr[expr'] | expr->field | *expr *)
|
| 123 : |
|
|
fun escapes (EXPR (Id {uid=pid,...},_,_)) = addEscape pid
|
| 124 : |
|
|
| escapes (EXPR (Member (expr, _))) = escapes expr
|
| 125 : |
|
|
| escapes _ = ()
|
| 126 : |
|
|
|
| 127 : |
|
|
(* Generate a new aid, bind it to ty in aidtab, and return it *)
|
| 128 : |
|
|
fun bindAid ctype =
|
| 129 : |
|
|
let val aid = Aid.new ()
|
| 130 : |
|
|
in Aidtab.insert(aidtab,aid,ctype);
|
| 131 : |
|
|
aid
|
| 132 : |
|
|
end
|
| 133 : |
|
|
|
| 134 : |
|
|
fun id2ctype (id: Ast.id) = #ctype id
|
| 135 : |
|
|
|
| 136 : |
|
|
fun isStaticOrGlobal ({stClass=Ast.STATIC,...}: Ast.id) = true
|
| 137 : |
|
|
| isStaticOrGlobal {global=true,...} = true
|
| 138 : |
|
|
| isStaticOrGlobal _ = false
|
| 139 : |
|
|
|
| 140 : |
|
|
fun aid2ctype aid =
|
| 141 : |
|
|
case Aidtab.find (aidtab,aid)
|
| 142 : |
|
|
of NONE => ( print "unknown type for aid "
|
| 143 : |
|
|
; print (Aid.toString aid)
|
| 144 : |
|
|
; print ",assuming its void\n"
|
| 145 : |
|
|
; Ast.Void
|
| 146 : |
|
|
)
|
| 147 : |
|
|
| SOME ctype => ctype
|
| 148 : |
|
|
|
| 149 : |
|
|
fun exp2ctype (EXPR (_,aid,_)) = aid2ctype aid
|
| 150 : |
|
|
|
| 151 : |
|
|
fun coreExp2exp ctype coreExp = EXPR (coreExp,bindAid ctype,SourceMap.UNKNOWN)
|
| 152 : |
|
|
|
| 153 : |
|
|
fun coreStmt2stmt coreStmt = STMT (coreStmt,Aid.new (),SourceMap.UNKNOWN)
|
| 154 : |
|
|
|
| 155 : |
|
|
fun exp2stmt exp = coreStmt2stmt (Expr (SOME exp))
|
| 156 : |
|
|
|
| 157 : |
|
|
fun coreExp2stmt ctype coreExp = exp2stmt (coreExp2exp ctype coreExp)
|
| 158 : |
|
|
|
| 159 : |
|
|
fun mkId id =
|
| 160 : |
|
|
coreExp2exp (id2ctype id) (Id id)
|
| 161 : |
|
|
|
| 162 : |
|
|
fun label id =
|
| 163 : |
|
|
coreStmt2stmt (Labeled (id,coreStmt2stmt (Expr NONE)))
|
| 164 : |
|
|
|
| 165 : |
|
|
fun assign id exp =
|
| 166 : |
|
|
let val ctype = id2ctype id
|
| 167 : |
|
|
in coreExp2stmt ctype (Assign (mkId id,exp)) end
|
| 168 : |
|
|
|
| 169 : |
|
|
(* dpo: eqCtype this is potentially expensive, should we do this? *)
|
| 170 : |
|
|
fun cast ctype exp =
|
| 171 : |
|
|
if CTypeEq.eqCType(ctype, (exp2ctype exp)) then exp
|
| 172 : |
|
|
else coreExp2exp ctype (Cast (ctype,exp))
|
| 173 : |
|
|
|
| 174 : |
|
|
fun decl id =
|
| 175 : |
|
|
let val ctype = id2ctype id
|
| 176 : |
|
|
in VarDecl (id,NONE) end
|
| 177 : |
|
|
|
| 178 : |
|
|
fun compound decls stmts =
|
| 179 : |
|
|
let fun filter [] = ([],[])
|
| 180 : |
|
|
| filter (stmt::stmts) =
|
| 181 : |
|
|
let val (decls,stmts) = filter stmts
|
| 182 : |
|
|
in case stmt
|
| 183 : |
|
|
of STMT (Compound (cmpDecls,cmpStmts),_,_) => (cmpDecls@decls,cmpStmts@stmts)
|
| 184 : |
|
|
| STMT (Expr NONE,_,_) => (decls,stmts)
|
| 185 : |
|
|
| _ => (decls,stmt::stmts)
|
| 186 : |
|
|
end
|
| 187 : |
|
|
val (decls',stmts') = filter stmts
|
| 188 : |
|
|
in Compound (decls@decls',stmts') end
|
| 189 : |
|
|
|
| 190 : |
|
|
fun noEffect (EXPR (coreExpr,_,_)) =
|
| 191 : |
|
|
case coreExpr
|
| 192 : |
|
|
of IntConst _ => true
|
| 193 : |
|
|
| RealConst _ => true
|
| 194 : |
|
|
| StringConst _ => true
|
| 195 : |
|
|
| Id _ => true
|
| 196 : |
|
|
| _ => false
|
| 197 : |
|
|
|
| 198 : |
|
|
fun stmts2stmt [] [stmt] = stmt
|
| 199 : |
|
|
| stmts2stmt decls stmts = STMT (compound decls stmts,Aid.new (),
|
| 200 : |
|
|
SourceMap.UNKNOWN)
|
| 201 : |
|
|
|
| 202 : |
|
|
val intCt = Ast.Numeric (Ast.NONSATURATE,Ast.WHOLENUM,Ast.SIGNED,Ast.INT, Ast.SIGNASSUMED)
|
| 203 : |
|
|
|
| 204 : |
|
|
val charCt = Ast.Numeric (Ast.NONSATURATE,Ast.WHOLENUM,Ast.UNSIGNED,Ast.CHAR, Ast.SIGNASSUMED)
|
| 205 : |
|
|
|
| 206 : |
|
|
fun mkInt i = coreExp2exp intCt (IntConst (i:LargeInt.int))
|
| 207 : |
|
|
|
| 208 : |
|
|
fun mkChr c = coreExp2exp charCt (IntConst (Int32.fromInt (ord c)))
|
| 209 : |
|
|
|
| 210 : |
|
|
fun simplifyExtDecls edecls =
|
| 211 : |
|
|
map simplifyExtDecl edecls
|
| 212 : |
|
|
|
| 213 : |
|
|
and simplifyExtDecl (DECL (coreExtDecl,aid,loc)) =
|
| 214 : |
|
|
DECL (simplifyCoreExtDecl coreExtDecl,aid,loc)
|
| 215 : |
|
|
|
| 216 : |
|
|
and simplifyCoreExtDecl coreExtDecl =
|
| 217 : |
|
|
case coreExtDecl
|
| 218 : |
|
|
of ExternalDecl decl => ExternalDecl decl
|
| 219 : |
|
|
| FunctionDef (id,ids,stmt) =>
|
| 220 : |
|
|
(case simplifyStmt (NONE,NONE) stmt
|
| 221 : |
|
|
of {decs=[],stmts=[stmt]} => FunctionDef (id,ids,stmt)
|
| 222 : |
|
|
| {decs,stmts} =>
|
| 223 : |
|
|
FunctionDef (id,ids,coreStmt2stmt (compound decs stmts)))
|
| 224 : |
|
|
| ExternalDeclExt ext =>
|
| 225 : |
|
|
SimplifyAstExt.simplifyExtDeclExt
|
| 226 : |
|
|
(tidtab,aidtab,opaidtab)
|
| 227 : |
|
|
(simplifyNestedExp, simplifyStmt (NONE,NONE))
|
| 228 : |
|
|
ext
|
| 229 : |
|
|
|
| 230 : |
|
|
and simplifyDecls [] = {decs=[],stmts=[]}
|
| 231 : |
|
|
| simplifyDecls (decl::decls) =
|
| 232 : |
|
|
let val {decs=decs0,stmts=stmts0} = simplifyDecl decl
|
| 233 : |
|
|
val {decs=decs1,stmts=stmts1} = simplifyDecls decls
|
| 234 : |
|
|
in {decs=decs0@decs1,stmts=stmts0@stmts1} end
|
| 235 : |
|
|
|
| 236 : |
|
|
and simplifyDecl decl =
|
| 237 : |
|
|
case decl
|
| 238 : |
|
|
of TypeDecl tid => {decs=[decl],stmts=[]}
|
| 239 : |
|
|
| VarDecl (id,NONE) => {decs=[decl],stmts=[]}
|
| 240 : |
|
|
| VarDecl (id,SOME initExpr) =>
|
| 241 : |
|
|
if isStaticOrGlobal id
|
| 242 : |
|
|
then {decs=[VarDecl (id,SOME initExpr)],stmts=[]}
|
| 243 : |
|
|
else let val ctype = id2ctype id
|
| 244 : |
|
|
val dec = VarDecl (id, NONE)
|
| 245 : |
|
|
val {decs,stmts} = simplifyAutoInit (mkId id) ctype initExpr
|
| 246 : |
|
|
in {decs=decs@[dec],stmts=stmts} end
|
| 247 : |
|
|
|
| 248 : |
|
|
and simplifyStmts pair [] = {decs=[],stmts=[]}
|
| 249 : |
|
|
| simplifyStmts pair (stmt::stmts) =
|
| 250 : |
|
|
let val {decs=decs0,stmts=stmts0} = simplifyStmt pair stmt
|
| 251 : |
|
|
val {decs=decs1,stmts=stmts1} = simplifyStmts pair stmts
|
| 252 : |
|
|
in {decs=decs0@decs1,stmts=stmts0@stmts1} end
|
| 253 : |
|
|
|
| 254 : |
|
|
|
| 255 : |
|
|
and simplifyStmt (pair as (contOpt,brkOpt))
|
| 256 : |
|
|
(stmt as STMT (coreStmt,aid,loc)) =
|
| 257 : |
|
|
let fun mkStmt coreStmt = STMT (coreStmt,aid,loc)
|
| 258 : |
|
|
fun cs2stmt coreStmt = STMT (coreStmt,Aid.new (),loc)
|
| 259 : |
|
|
in case coreStmt
|
| 260 : |
|
|
of Expr expOpt =>
|
| 261 : |
|
|
let val {decs,pre,expOpt} = simplifyTopExpOpt expOpt
|
| 262 : |
|
|
val stmt = mkStmt (Expr expOpt)
|
| 263 : |
|
|
in {decs=decs,stmts=pre@[stmt]} end
|
| 264 : |
|
|
| Compound (decls,stmts) =>
|
| 265 : |
|
|
let val {decs=decs0,stmts=stmts0}= simplifyDecls decls
|
| 266 : |
|
|
val {decs=decs1,stmts=stmts1} = simplifyStmts pair stmts
|
| 267 : |
|
|
in {decs=decs0@decs1,stmts=[mkStmt (compound [] (stmts0@stmts1))]} end
|
| 268 : |
|
|
(* The translation of while minimizes the number of jumps
|
| 269 : |
|
|
* in the body of the loop.
|
| 270 : |
|
|
*
|
| 271 : |
|
|
* while (exp,stmt) =>
|
| 272 : |
|
|
* goto startLabel
|
| 273 : |
|
|
* topLabel: stmt
|
| 274 : |
|
|
* start&contLabel: preExp
|
| 275 : |
|
|
* if exp then goto topLabel
|
| 276 : |
|
|
* brkLabel:
|
| 277 : |
|
|
*
|
| 278 : |
|
|
* NOTE: the brk label is added only if is used.
|
| 279 : |
|
|
*)
|
| 280 : |
|
|
| While (exp,stmt) =>
|
| 281 : |
|
|
let val topLab = newLabel "whileTop"
|
| 282 : |
|
|
val contLab = newLabel "whileCont"
|
| 283 : |
|
|
val brkLab = newLabel "whileBrk"
|
| 284 : |
|
|
val contUsed = ref true
|
| 285 : |
|
|
val brkUsed = ref false
|
| 286 : |
|
|
val pair = (SOME (contUsed,contLab),SOME (brkUsed,brkLab))
|
| 287 : |
|
|
val {decs=expDecs,pre=preExp,exp=exp} = simplifyTopExp exp
|
| 288 : |
|
|
val {decs=bodyDecs,stmts} = simplifyStmt pair stmt
|
| 289 : |
|
|
val stmts = [cs2stmt (Goto contLab),
|
| 290 : |
|
|
label topLab
|
| 291 : |
|
|
]
|
| 292 : |
|
|
@ stmts
|
| 293 : |
|
|
@ [label contLab]
|
| 294 : |
|
|
@ preExp
|
| 295 : |
|
|
@ [mkStmt (IfThen (exp,cs2stmt (Goto topLab)))]
|
| 296 : |
|
|
@ (if !brkUsed then [label brkLab] else [])
|
| 297 : |
|
|
in {decs=expDecs@bodyDecs,stmts=stmts} end
|
| 298 : |
|
|
(* The translation of do minimizes the number of jumps
|
| 299 : |
|
|
* in the body of the loop.
|
| 300 : |
|
|
*
|
| 301 : |
|
|
* do (exp,stmt) =>
|
| 302 : |
|
|
* topLabel: stmt
|
| 303 : |
|
|
* contLabel: preExp
|
| 304 : |
|
|
* if exp then goto topLabel
|
| 305 : |
|
|
* brkLabel:
|
| 306 : |
|
|
*
|
| 307 : |
|
|
* NOTE: cont and brk labels are added only if they are used.
|
| 308 : |
|
|
*)
|
| 309 : |
|
|
| Do (exp,stmt) =>
|
| 310 : |
|
|
let val topLab = newLabel "doTop"
|
| 311 : |
|
|
val contLab = newLabel "doCont"
|
| 312 : |
|
|
val brkLab = newLabel "doBrk"
|
| 313 : |
|
|
val contUsed = ref false
|
| 314 : |
|
|
val brkUsed = ref false
|
| 315 : |
|
|
val pair = (SOME (contUsed,contLab),SOME (brkUsed,brkLab))
|
| 316 : |
|
|
val {decs=expDecs,pre=preExp,exp} = simplifyTopExp exp
|
| 317 : |
|
|
val {decs=bodyDecs,stmts} = simplifyStmt pair stmt
|
| 318 : |
|
|
val stmts = [label topLab]
|
| 319 : |
|
|
@ stmts
|
| 320 : |
|
|
@ (if !contUsed then [label contLab] else [])
|
| 321 : |
|
|
@ preExp
|
| 322 : |
|
|
@ [mkStmt (IfThen (exp,mkStmt (Goto topLab)))]
|
| 323 : |
|
|
@ (if !brkUsed then [label brkLab] else [])
|
| 324 : |
|
|
in {decs=expDecs@bodyDecs,stmts=stmts} end
|
| 325 : |
|
|
(* The translation of for minimizes the number of jumps
|
| 326 : |
|
|
* in the body of the loop.
|
| 327 : |
|
|
*
|
| 328 : |
|
|
* for (e0,e1,e2,stmt) =>
|
| 329 : |
|
|
* preE0
|
| 330 : |
|
|
* e0
|
| 331 : |
|
|
* goto startLabel
|
| 332 : |
|
|
* topLabel: stmt
|
| 333 : |
|
|
* contLabel: preE2
|
| 334 : |
|
|
* e2
|
| 335 : |
|
|
* startLabel: preE1
|
| 336 : |
|
|
* if e1 then goto topLabel
|
| 337 : |
|
|
* brkLabel:
|
| 338 : |
|
|
*
|
| 339 : |
|
|
* NOTE: cont and brk labels are added only if they are used.
|
| 340 : |
|
|
*)
|
| 341 : |
|
|
| For (eOpt0,eOpt1,eOpt2,stmt) =>
|
| 342 : |
|
|
let val topLab = newLabel "forTop"
|
| 343 : |
|
|
val startLab = newLabel "forStart"
|
| 344 : |
|
|
val contLab = newLabel "forCont"
|
| 345 : |
|
|
val brkLab = newLabel "forBrk"
|
| 346 : |
|
|
val contUsed = ref false
|
| 347 : |
|
|
val brkUsed = ref false
|
| 348 : |
|
|
val pair = (SOME (contUsed,contLab),SOME (brkUsed,brkLab))
|
| 349 : |
|
|
val {decs=e0Decs,pre=preE0,expOpt=eOpt0} = simplifyTopExpOpt eOpt0
|
| 350 : |
|
|
val {decs=e1Decs,pre=preE1,expOpt=eOpt1} = simplifyTopExpOpt eOpt1
|
| 351 : |
|
|
val {decs=e2Decs,pre=preE2,expOpt=eOpt2} = simplifyTopExpOpt eOpt2
|
| 352 : |
|
|
val {decs=bodyDecs,stmts} = simplifyStmt pair stmt
|
| 353 : |
|
|
fun expOpt2stmt NONE = []
|
| 354 : |
|
|
| expOpt2stmt (SOME exp) =
|
| 355 : |
|
|
if noEffect exp then [] else [exp2stmt exp]
|
| 356 : |
|
|
|
| 357 : |
|
|
val stmts = preE0
|
| 358 : |
|
|
@ expOpt2stmt eOpt0
|
| 359 : |
|
|
@ [cs2stmt (Goto startLab)
|
| 360 : |
|
|
,label topLab
|
| 361 : |
|
|
]
|
| 362 : |
|
|
@ stmts
|
| 363 : |
|
|
@ (if !contUsed then [label contLab] else [])
|
| 364 : |
|
|
@ preE2
|
| 365 : |
|
|
@ expOpt2stmt eOpt2
|
| 366 : |
|
|
@ [label startLab]
|
| 367 : |
|
|
@ preE1
|
| 368 : |
|
|
@ (case eOpt1
|
| 369 : |
|
|
of SOME e1 => [mkStmt (IfThen (e1,cs2stmt (Goto topLab)))]
|
| 370 : |
|
|
| NONE => [])
|
| 371 : |
|
|
@ (if !brkUsed then [label brkLab] else [])
|
| 372 : |
|
|
in {decs=e0Decs@e1Decs@e2Decs@bodyDecs,stmts=stmts} end
|
| 373 : |
|
|
| Labeled (label,stmt) =>
|
| 374 : |
|
|
let val {decs,stmts} = simplifyStmt pair stmt
|
| 375 : |
|
|
val stmt = mkStmt (Labeled (label,cs2stmt (Expr NONE)))
|
| 376 : |
|
|
in {decs=decs,stmts=stmt::stmts} end
|
| 377 : |
|
|
| CaseLabel (li,stmt) =>
|
| 378 : |
|
|
let val {decs,stmts} = simplifyStmt pair stmt
|
| 379 : |
|
|
in {decs=decs,stmts=[mkStmt (CaseLabel (li,stmts2stmt [] stmts))]}
|
| 380 : |
|
|
end
|
| 381 : |
|
|
| DefaultLabel stmt =>
|
| 382 : |
|
|
let val {decs,stmts} = simplifyStmt pair stmt
|
| 383 : |
|
|
in {decs=decs,stmts=[mkStmt (DefaultLabel (stmts2stmt [] stmts))]}
|
| 384 : |
|
|
end
|
| 385 : |
|
|
| Goto label => {decs=[],stmts=[mkStmt (Goto label)]}
|
| 386 : |
|
|
| Break =>
|
| 387 : |
|
|
(case brkOpt
|
| 388 : |
|
|
of NONE => fail "invalid context for break"
|
| 389 : |
|
|
| SOME (brkUsed,label) =>
|
| 390 : |
|
|
( brkUsed := true
|
| 391 : |
|
|
; {decs=[],stmts=[mkStmt (Goto label)]}
|
| 392 : |
|
|
))
|
| 393 : |
|
|
| Continue =>
|
| 394 : |
|
|
(case contOpt
|
| 395 : |
|
|
of NONE => fail "invalid context for continue"
|
| 396 : |
|
|
| SOME (contUsed,label) =>
|
| 397 : |
|
|
(contUsed := true;
|
| 398 : |
|
|
{decs=[],stmts=[mkStmt (Goto label)]}))
|
| 399 : |
|
|
| Return expOpt =>
|
| 400 : |
|
|
let val {decs,pre,expOpt} = simplifyTopExpOpt expOpt
|
| 401 : |
|
|
in {decs=decs,stmts=pre@[mkStmt (Return expOpt)]}
|
| 402 : |
|
|
end
|
| 403 : |
|
|
| IfThen (exp,stmt) =>
|
| 404 : |
|
|
let val {decs=decs0,pre,exp} = simplifyTopExp exp
|
| 405 : |
|
|
val {decs=decs1,stmts} = simplifyStmt pair stmt
|
| 406 : |
|
|
val stmts = pre@[mkStmt (IfThen (exp,stmts2stmt [] stmts))]
|
| 407 : |
|
|
in {decs=decs0@decs1,stmts=stmts}
|
| 408 : |
|
|
end
|
| 409 : |
|
|
| IfThenElse (exp,stmt0,stmt1) =>
|
| 410 : |
|
|
let val {decs,pre,exp} = simplifyTopExp exp
|
| 411 : |
|
|
val {decs=decs0,stmts=stmts0} = simplifyStmt pair stmt0
|
| 412 : |
|
|
val {decs=decs1,stmts=stmts1} = simplifyStmt pair stmt1
|
| 413 : |
|
|
val stmts =
|
| 414 : |
|
|
pre@[mkStmt(IfThenElse(exp,stmts2stmt [] stmts0,
|
| 415 : |
|
|
stmts2stmt [] stmts1))]
|
| 416 : |
|
|
in {decs=decs@decs0@decs1,stmts=stmts} end
|
| 417 : |
|
|
| Switch (exp,stmt) =>
|
| 418 : |
|
|
let val {decs=decs0,pre,exp} = simplifyTopExp exp
|
| 419 : |
|
|
val brkLab = newLabel "switchBrk"
|
| 420 : |
|
|
val brkUsed = ref false
|
| 421 : |
|
|
val {decs=decs1,stmts} =
|
| 422 : |
|
|
simplifyStmt (contOpt,SOME (brkUsed,brkLab)) stmt
|
| 423 : |
|
|
val stmts = pre
|
| 424 : |
|
|
@ [mkStmt (Switch (exp,stmts2stmt [] stmts))]
|
| 425 : |
|
|
@ (if !brkUsed then [label brkLab] else [])
|
| 426 : |
|
|
in {decs=decs0@decs1,stmts=stmts}
|
| 427 : |
|
|
end
|
| 428 : |
|
|
| ErrorStmt => {decs=nil, stmts=[mkStmt ErrorStmt]}
|
| 429 : |
|
|
| StatExt ext =>
|
| 430 : |
|
|
let val {decs,coreStmt} =
|
| 431 : |
|
|
SimplifyAstExt.simplifyStmtExt
|
| 432 : |
|
|
(tidtab,aidtab,opaidtab)
|
| 433 : |
|
|
(simplifyNestedExp,simplifyStmt (NONE,NONE))
|
| 434 : |
|
|
ext
|
| 435 : |
|
|
in {decs=decs,stmts=[mkStmt coreStmt]}
|
| 436 : |
|
|
end
|
| 437 : |
|
|
end
|
| 438 : |
|
|
|
| 439 : |
|
|
|
| 440 : |
|
|
and simplifyAutoInit lhs ctype initExp =
|
| 441 : |
|
|
case initExp
|
| 442 : |
|
|
of (Aggregate initExps) =>
|
| 443 : |
|
|
let val {stmts} = autoInit lhs ctype initExp
|
| 444 : |
|
|
in {decs=[],stmts=stmts} end
|
| 445 : |
|
|
| (Simple exp) =>
|
| 446 : |
|
|
let val {decs,pre,exp} = simplifyTopExp exp
|
| 447 : |
|
|
val stmt = coreExp2stmt ctype (Assign (lhs,exp))
|
| 448 : |
|
|
in {decs=decs,stmts=pre@[stmt]} end
|
| 449 : |
|
|
|
| 450 : |
|
|
and autoInit lhs ctype initExp =
|
| 451 : |
|
|
let fun feed initer (Aggregate initExps) = initer initExps
|
| 452 : |
|
|
| feed initer _ = fail "bad form for initializer"
|
| 453 : |
|
|
|
| 454 : |
|
|
fun arrInit lhs ctype i [] = {stmts=[]}
|
| 455 : |
|
|
| arrInit lhs ctype i (initExp::initExps) =
|
| 456 : |
|
|
let val intConst = mkInt i
|
| 457 : |
|
|
val arrLhs = coreExp2exp ctype (Sub (lhs,intConst))
|
| 458 : |
|
|
val {stmts} = autoInit arrLhs ctype initExp
|
| 459 : |
|
|
val {stmts=stmts'} = arrInit lhs ctype (i+1) initExps
|
| 460 : |
|
|
in {stmts=stmts@stmts'} end
|
| 461 : |
|
|
|
| 462 : |
|
|
fun structInit lhs [] [] = {stmts=[]}
|
| 463 : |
|
|
| structInit lhs [] initExps = fail "initializer too big"
|
| 464 : |
|
|
| structInit lhs fields [] = fail "initializer too small"
|
| 465 : |
|
|
| structInit lhs ((ctype,NONE,liOpt)::fields) initExps =
|
| 466 : |
|
|
(* according to the standard, unnamed fields don't
|
| 467 : |
|
|
* get initialized.
|
| 468 : |
|
|
*)
|
| 469 : |
|
|
structInit lhs fields initExps
|
| 470 : |
|
|
| structInit lhs ((ctype,SOME mem,liOpt)::fields) (initExp::initExps) =
|
| 471 : |
|
|
let val memLhs = coreExp2exp ctype (Member (lhs,mem))
|
| 472 : |
|
|
val {stmts} = autoInit memLhs ctype initExp
|
| 473 : |
|
|
val {stmts=stmts'} = structInit lhs fields initExps
|
| 474 : |
|
|
in {stmts=stmts@stmts'} end
|
| 475 : |
|
|
|
| 476 : |
|
|
fun unionInit lhs [] initExps = {stmts=[]}
|
| 477 : |
|
|
| unionInit lhs ((ctype,mem)::_) ([initExp]) =
|
| 478 : |
|
|
let val lhs = coreExp2exp ctype (Member (lhs,mem))
|
| 479 : |
|
|
in autoInit lhs ctype initExp end
|
| 480 : |
|
|
| unionInit lhs fields exp = fail "bad form for union"
|
| 481 : |
|
|
|
| 482 : |
|
|
fun scalarInit lhs ctype (Simple exp) =
|
| 483 : |
|
|
{stmts=[coreExp2stmt ctype (Assign (lhs,exp))]}
|
| 484 : |
|
|
| scalarInit lhs ctype _ =
|
| 485 : |
|
|
fail "bad form for initializer"
|
| 486 : |
|
|
|
| 487 : |
|
|
in case ctype
|
| 488 : |
|
|
of Ast.Qual (_,ctype) => autoInit lhs ctype initExp
|
| 489 : |
|
|
| Ast.TypeRef tid =>
|
| 490 : |
|
|
(case getTid tid
|
| 491 : |
|
|
of {ntype=SOME (Bindings.Typedef (tid,ctype)),...} =>
|
| 492 : |
|
|
autoInit lhs ctype initExp
|
| 493 : |
|
|
| _ => fail "bad type for initializer")
|
| 494 : |
|
|
| Ast.Array (_,ctype) => feed (arrInit lhs ctype 0) initExp
|
| 495 : |
|
|
| Ast.StructRef tid =>
|
| 496 : |
|
|
(case getTid tid
|
| 497 : |
|
|
of {ntype=SOME (Bindings.Struct (tid,fields)),...} =>
|
| 498 : |
|
|
feed (structInit lhs fields) initExp
|
| 499 : |
|
|
| _ => fail "bad type for initializer")
|
| 500 : |
|
|
| Ast.UnionRef tid =>
|
| 501 : |
|
|
(case getTid tid
|
| 502 : |
|
|
of {ntype=SOME (Bindings.Union (tid,fields)),...} =>
|
| 503 : |
|
|
feed (unionInit lhs fields) initExp
|
| 504 : |
|
|
| _ => fail "bad type for initializer")
|
| 505 : |
|
|
| Ast.Numeric _ => scalarInit lhs ctype initExp
|
| 506 : |
|
|
| Ast.Pointer _ => scalarInit lhs ctype initExp
|
| 507 : |
|
|
| Ast.Function _ => scalarInit lhs ctype initExp
|
| 508 : |
|
|
| Ast.EnumRef _ => scalarInit lhs ctype initExp
|
| 509 : |
|
|
| _ => fail "bad type for initializer"
|
| 510 : |
|
|
end
|
| 511 : |
|
|
|
| 512 : |
|
|
and simplifyExps [] = {decs=[],pre=[],exps=[]}
|
| 513 : |
|
|
| simplifyExps (exp::exps) =
|
| 514 : |
|
|
let val {decs,pre,exp} = simplifyExp {nested=true} exp
|
| 515 : |
|
|
val {decs=decs',pre=pre',exps} = simplifyExps exps
|
| 516 : |
|
|
in {decs=decs@decs',pre=pre@pre',exps=exp::exps} end
|
| 517 : |
|
|
|
| 518 : |
|
|
and simplifyNestedExp exp = simplifyExp {nested=true} exp
|
| 519 : |
|
|
|
| 520 : |
|
|
and simplifyTopExp exp = simplifyExp {nested=false} exp
|
| 521 : |
|
|
|
| 522 : |
|
|
and simplifyTopExpOpt NONE = {decs=[],pre=[],expOpt=NONE}
|
| 523 : |
|
|
| simplifyTopExpOpt (SOME exp) =
|
| 524 : |
|
|
let val {decs,pre,exp} = simplifyTopExp exp
|
| 525 : |
|
|
in {decs=decs,pre=pre,expOpt=SOME exp} end
|
| 526 : |
|
|
|
| 527 : |
|
|
|
| 528 : |
|
|
and simplifyExp {nested} (exp as EXPR (coreExp,aid,loc)) =
|
| 529 : |
|
|
let fun mkExp coreExp = EXPR (coreExp,aid,loc)
|
| 530 : |
|
|
val ctype = aid2ctype aid
|
| 531 : |
|
|
in case coreExp
|
| 532 : |
|
|
of IntConst _ => {decs=[],pre=[],exp=exp}
|
| 533 : |
|
|
| RealConst _ => {decs=[],pre=[],exp=exp}
|
| 534 : |
|
|
| StringConst _ => {decs=[],pre=[],exp=exp}
|
| 535 : |
|
|
| Call (exp,exps) =>
|
| 536 : |
|
|
let val {decs=decs0,pre=pre0,exp} = simplifyNestedExp exp
|
| 537 : |
|
|
val {decs=decs1,pre=pre1,exps} = simplifyExps exps
|
| 538 : |
|
|
val callExp = mkExp (Call (exp,exps))
|
| 539 : |
|
|
in if nested
|
| 540 : |
|
|
then let val id = newId "call" ctype
|
| 541 : |
|
|
val dec = decl id
|
| 542 : |
|
|
val stmt = assign id callExp
|
| 543 : |
|
|
val exp = mkId id
|
| 544 : |
|
|
in {decs=dec::decs0@decs1,pre=pre0@pre1@[stmt],exp=exp} end
|
| 545 : |
|
|
else {decs=decs0@decs1,pre=pre0@pre1,exp=callExp}
|
| 546 : |
|
|
end
|
| 547 : |
|
|
| QuestionColon (exp0,exp1,exp2) =>
|
| 548 : |
|
|
let val id = newId "quesCol" ctype
|
| 549 : |
|
|
val dec = decl id
|
| 550 : |
|
|
val {decs=decs0,pre=pre0,exp=exp0} = simplifyNestedExp exp0
|
| 551 : |
|
|
val {decs=decs1,pre=pre1,exp=exp1} = simplifyTopExp exp1
|
| 552 : |
|
|
val {decs=decs2,pre=pre2,exp=exp2} = simplifyTopExp exp2
|
| 553 : |
|
|
val stmt = coreStmt2stmt
|
| 554 : |
|
|
(IfThenElse
|
| 555 : |
|
|
( exp0
|
| 556 : |
|
|
, stmts2stmt decs1 (pre1@[assign id exp1])
|
| 557 : |
|
|
, stmts2stmt decs2 (pre2@[assign id exp2])
|
| 558 : |
|
|
)
|
| 559 : |
|
|
)
|
| 560 : |
|
|
val exp = mkId id
|
| 561 : |
|
|
in {decs=dec::decs0,pre=pre0@[stmt],exp=exp} end
|
| 562 : |
|
|
| Assign (exp0,exp1) =>
|
| 563 : |
|
|
let val {decs=decs0,pre=pre0,exp=exp0} = simplifyNestedExp exp0
|
| 564 : |
|
|
val {decs=decs1,pre=pre1,exp=exp1} = simplifyNestedExp exp1
|
| 565 : |
|
|
val exp = mkExp (Assign (exp0,exp1))
|
| 566 : |
|
|
in if nested
|
| 567 : |
|
|
then {decs=decs0@decs1,pre=pre0@pre1@[exp2stmt exp],exp=exp0}
|
| 568 : |
|
|
else{decs=decs0@decs1,pre=pre0@pre1,exp=exp}
|
| 569 : |
|
|
end
|
| 570 : |
|
|
| Comma (exp0,exp1) =>
|
| 571 : |
|
|
let val {decs=decs0,pre=pre0,exp=exp0} = simplifyNestedExp exp0
|
| 572 : |
|
|
val {decs=decs1,pre=pre1,exp=exp1} = simplifyNestedExp exp1
|
| 573 : |
|
|
val pre = if noEffect exp0 then pre0@pre1 else pre0@[exp2stmt exp0]@pre1
|
| 574 : |
|
|
in {decs=decs0@decs1,pre=pre,exp=exp1} end
|
| 575 : |
|
|
| Sub (exp0,exp1) =>
|
| 576 : |
|
|
let val {decs=decs0,pre=pre0,exp=exp0} = simplifyNestedExp exp0
|
| 577 : |
|
|
val {decs=decs1,pre=pre1,exp=exp1} = simplifyNestedExp exp1
|
| 578 : |
|
|
val exp = mkExp (Sub (exp0,exp1))
|
| 579 : |
|
|
in {decs=decs0@decs1,pre=pre0@pre1,exp=exp} end
|
| 580 : |
|
|
| Member (exp,mem) =>
|
| 581 : |
|
|
let val {decs,pre,exp} = simplifyNestedExp exp
|
| 582 : |
|
|
val exp = mkExp (Member (exp,mem))
|
| 583 : |
|
|
in {decs=decs,pre=pre,exp=exp} end
|
| 584 : |
|
|
| Arrow (exp,mem) =>
|
| 585 : |
|
|
(case exp2ctype exp
|
| 586 : |
|
|
of Ast.Pointer ctype =>
|
| 587 : |
|
|
let val {decs,pre,exp} = simplifyNestedExp exp
|
| 588 : |
|
|
val exp = coreExp2exp ctype (Deref exp)
|
| 589 : |
|
|
val exp = mkExp (Member (exp,mem))
|
| 590 : |
|
|
in {decs=decs,pre=pre,exp=exp} end
|
| 591 : |
|
|
| _ => fail "Arrow: type error")
|
| 592 : |
|
|
| Deref exp =>
|
| 593 : |
|
|
let val {decs,pre,exp} = simplifyNestedExp exp
|
| 594 : |
|
|
val exp = mkExp (Deref exp)
|
| 595 : |
|
|
in {decs=decs,pre=pre,exp=exp} end
|
| 596 : |
|
|
(***
|
| 597 : |
|
|
| AddrOf exp =>
|
| 598 : |
|
|
let val {decs,pre,exp} = simplifyNestedExp exp
|
| 599 : |
|
|
val exp = mkExp (AddrOf exp)
|
| 600 : |
|
|
in (escapes exp; {decs=decs,pre=pre,exp=exp}) end
|
| 601 : |
|
|
***)
|
| 602 : |
|
|
|
| 603 : |
|
|
(* notes on addrOf:
|
| 604 : |
|
|
s: effect of simplifyNestedExp
|
| 605 : |
|
|
a: effect of adrf
|
| 606 : |
|
|
1. x =s=> x =a=> &x
|
| 607 : |
|
|
2. x->field =s=> *(x+k) =a=> x+k where k is offset of field
|
| 608 : |
|
|
3. x.field =s=> *((&x)+k) =a=> &x+k where k is offset of field
|
| 609 : |
|
|
4. e[i] =s=> *(e+i*k) =a=> e+i*k where k is scaling for ( *e)
|
| 610 : |
|
|
5. x[i] =s=> *(&x+i*k)
|
| 611 : |
|
|
**)
|
| 612 : |
|
|
| AddrOf exp =>
|
| 613 : |
|
|
let
|
| 614 : |
|
|
val {decs, pre, exp} = simplifyNestedExp exp
|
| 615 : |
|
|
fun adrf(expr as EXPR(coreExpr, aid, loc)) =
|
| 616 : |
|
|
(case coreExpr of
|
| 617 : |
|
|
Id{uid=pid, ...} =>
|
| 618 : |
|
|
(addEscape pid;
|
| 619 : |
|
|
exp=EXPR(AddrOf expr, aid, loc))
|
| 620 : |
|
|
| Member(memExpr, field) =>
|
| 621 : |
|
|
let val expr = adrf(memExpr)
|
| 622 : |
|
|
val ctype = exp2ctype(memExpr)
|
| 623 : |
|
|
fun nullErr _ = ()
|
| 624 : |
|
|
val errs = {err=nullErr, warn=nullErr, bug=nullErr}
|
| 625 : |
|
|
val fieldOffs = Sizeof.fieldOffsets errs tidtab ctype
|
| 626 : |
|
|
val byteOffset = #bitOffset(Sizeof.getField errs (field, fieldOffs))
|
| 627 : |
|
|
in
|
| 628 : |
|
|
EXPR(Binop(Plus(exp, byteOffset)), aid, loc)
|
| 629 : |
|
|
end
|
| 630 : |
|
|
| Deref expr => expr
|
| 631 : |
|
|
| (Sub _ | Arrow _) => fail "simplifyNestedExp returned Sub or Arrow")
|
| 632 : |
|
|
(* x[4] -> *(x+16) -> x+16 *)
|
| 633 : |
|
|
in
|
| 634 : |
|
|
{decs=decs, pre=pre, exp=adrf exp}
|
| 635 : |
|
|
end
|
| 636 : |
|
|
|
| 637 : |
|
|
let val {decs,pre,exp} = simplifyNestedExp exp
|
| 638 : |
|
|
val exp = mkExp (AddrOf exp)
|
| 639 : |
|
|
in (escapes exp; {decs=decs,pre=pre,exp=exp}) end
|
| 640 : |
|
|
|
| 641 : |
|
|
| Binop trip =>
|
| 642 : |
|
|
simplifyBinop mkExp {nested=nested} ctype trip
|
| 643 : |
|
|
| Unop pair =>
|
| 644 : |
|
|
let val {decs,pre,coreExp} = simplifyUnop {nested=nested} ctype pair
|
| 645 : |
|
|
in {decs=decs,pre=pre,exp=mkExp coreExp} end
|
| 646 : |
|
|
| Cast (ctype,exp) =>
|
| 647 : |
|
|
let val {decs,pre,exp} = simplifyNestedExp exp
|
| 648 : |
|
|
in
|
| 649 : |
|
|
{decs=decs, pre=pre, exp= mkExp(Cast(ctype, exp))}
|
| 650 : |
|
|
end
|
| 651 : |
|
|
| Id _ => {decs=[],pre=[],exp=exp}
|
| 652 : |
|
|
| EnumId _ => {decs=[],pre=[],exp=exp}
|
| 653 : |
|
|
| SizeOf _ => {decs=[],pre=[],exp=exp} (* should not appear in compiler mode *)
|
| 654 : |
|
|
| ExprExt ext =>
|
| 655 : |
|
|
let val {decs,pre,coreExp} =
|
| 656 : |
|
|
SimplifyAstExt.simplifyExpExt
|
| 657 : |
|
|
(tidtab,aidtab,opaidtab)
|
| 658 : |
|
|
(simplifyNestedExp, simplifyStmt(NONE,NONE))
|
| 659 : |
|
|
ext
|
| 660 : |
|
|
in {decs=decs,pre=pre,exp=mkExp coreExp}
|
| 661 : |
|
|
end
|
| 662 : |
|
|
| ErrorExpr => {decs=[],pre=[],exp=exp}
|
| 663 : |
|
|
end
|
| 664 : |
|
|
|
| 665 : |
|
|
and scale ctype i =
|
| 666 : |
|
|
case ctype
|
| 667 : |
|
|
of Ast.Qual (_,ctype) => scale ctype i
|
| 668 : |
|
|
| Ast.Pointer ctype => let val {bytes,...} = sizeOf tidtab ctype
|
| 669 : |
|
|
in LargeInt.fromInt (bytes * i) end
|
| 670 : |
|
|
| _ => LargeInt.fromInt i
|
| 671 : |
|
|
|
| 672 : |
|
|
and simplifyUnop {nested} ctype (unop,exp as EXPR (_,aid,_)) =
|
| 673 : |
|
|
let val {decs,pre,exp} = simplifyNestedExp exp
|
| 674 : |
|
|
fun mkUnop unop = {decs=decs,pre=pre,coreExp=Unop (unop,exp)}
|
| 675 : |
|
|
fun mkAssign {prefixOp} binop =
|
| 676 : |
|
|
(* opArgTy is type to which arg is converted
|
| 677 : |
|
|
e.g. e++ where e has type ctype and opArgTy newTy
|
| 678 : |
|
|
becomes e = (ctype)( (newTy)e + (newTy)1 )
|
| 679 : |
|
|
and if ctype is a pointer, then 1 gets scaled by sizeof( *ctype )
|
| 680 : |
|
|
*)
|
| 681 : |
|
|
let val id = newId (if prefixOp then "pref" else "post") ctype
|
| 682 : |
|
|
val dec = decl id
|
| 683 : |
|
|
val newTy = getOpAid aid
|
| 684 : |
|
|
val argExp = cast newTy exp
|
| 685 : |
|
|
val one = cast newTy
|
| 686 : |
|
|
(coreExp2exp intCt (IntConst (scale ctype 1)))
|
| 687 : |
|
|
val binExp = coreExp2exp newTy (Binop (binop,argExp,one))
|
| 688 : |
|
|
val incrStmt = coreExp2stmt ctype
|
| 689 : |
|
|
(Assign(copyExp exp, cast ctype binExp))
|
| 690 : |
|
|
val assignStmt =
|
| 691 : |
|
|
coreExp2stmt ctype (Assign (mkId id,copyExp exp))
|
| 692 : |
|
|
val pre = if prefixOp then pre@[incrStmt,assignStmt]
|
| 693 : |
|
|
else pre@[assignStmt,incrStmt]
|
| 694 : |
|
|
in {decs=dec::decs, pre=pre, coreExp=Id id}
|
| 695 : |
|
|
end
|
| 696 : |
|
|
in case unop
|
| 697 : |
|
|
(* the ++, --, cases are no longer dealt with in here;
|
| 698 : |
|
|
there is now code in build-ast (which is
|
| 699 : |
|
|
enabled when insert_explicit_coersions is set)
|
| 700 : |
|
|
that simplifies ++ and -- *)
|
| 701 : |
|
|
of PreInc => mkAssign {prefixOp=true} Plus
|
| 702 : |
|
|
| PreDec => mkAssign {prefixOp=true} Minus
|
| 703 : |
|
|
| PostInc => mkAssign {prefixOp=false} Plus
|
| 704 : |
|
|
| PostDec => mkAssign {prefixOp=false} Minus
|
| 705 : |
|
|
| _ => mkUnop unop
|
| 706 : |
|
|
end
|
| 707 : |
|
|
|
| 708 : |
|
|
and simplifyBinop mkExp {nested} ctype (binop,exp0 as EXPR (_,aid,_),exp1) =
|
| 709 : |
|
|
let val {decs=decs0,pre=pre0,exp=exp0} = simplifyNestedExp exp0
|
| 710 : |
|
|
val {decs=decs1,pre=pre1,exp=exp1} = simplifyNestedExp exp1
|
| 711 : |
|
|
val decs = decs0@decs1
|
| 712 : |
|
|
val pre = pre0@pre1
|
| 713 : |
|
|
fun mkBinop binop =
|
| 714 : |
|
|
{decs=decs,pre=pre,exp=mkExp (Binop (binop,exp0,exp1))}
|
| 715 : |
|
|
fun mkAssign binop =
|
| 716 : |
|
|
(* for e0 += e1, e0 -= e1 and their friends, opArgTy specifies
|
| 717 : |
|
|
the type that e0 must be converted to
|
| 718 : |
|
|
e.g. e0 += e1 becomes e0 = (ctype(e0)) ( (opArgTy e0) + e1 )
|
| 719 : |
|
|
*)
|
| 720 : |
|
|
let val opArgTy = getOpAid aid
|
| 721 : |
|
|
val binExp = coreExp2exp opArgTy
|
| 722 : |
|
|
(Binop (binop,cast opArgTy exp0,exp1))
|
| 723 : |
|
|
val assign = mkExp (Assign (copyExp exp0,cast ctype binExp))
|
| 724 : |
|
|
in if nested
|
| 725 : |
|
|
then {decs=decs,pre=pre@[exp2stmt assign],exp=copyExp exp0}
|
| 726 : |
|
|
else {decs=decs,pre=pre,exp=assign}
|
| 727 : |
|
|
end
|
| 728 : |
|
|
in case binop
|
| 729 : |
|
|
(* the +=, -=, etc., cases are no longer dealt with in here;
|
| 730 : |
|
|
there is now code in build-ast (which is
|
| 731 : |
|
|
enabled when insert_explicit_coersions is set)
|
| 732 : |
|
|
that simplifies +=, -=, ... *)
|
| 733 : |
|
|
of PlusAssign => mkAssign Plus
|
| 734 : |
|
|
| MinusAssign => mkAssign Minus
|
| 735 : |
|
|
| TimesAssign => mkAssign Times
|
| 736 : |
|
|
| DivAssign => mkAssign Divide
|
| 737 : |
|
|
| ModAssign => mkAssign Mod
|
| 738 : |
|
|
| XorAssign => mkAssign BitXor
|
| 739 : |
|
|
| OrAssign => mkAssign Or
|
| 740 : |
|
|
| AndAssign => mkAssign And
|
| 741 : |
|
|
| LshiftAssign => mkAssign Lshift
|
| 742 : |
|
|
| RshiftAssign => mkAssign Rshift
|
| 743 : |
|
|
| _ => mkBinop binop
|
| 744 : |
|
|
end
|
| 745 : |
|
|
in {ast=simplifyExtDecls edecls, escapetab = esctab}
|
| 746 : |
|
|
end
|
| 747 : |
|
|
end
|
Parent Directory
| 
Revision Log
