763 |
Ast.Simple(#2(cnvExpression expr)) |
Ast.Simple(#2(cnvExpression expr)) |
764 |
|
|
765 |
and processDecr (ty,sc,topLevel0) (decr,expr) = |
and processDecr (ty,sc,topLevel0) (decr,expr) = |
766 |
let val (ty,varNameOpt) = mungeTyDecr (ty, decr) |
let val (ty,varNameOpt,loc) = mungeTyDecr (ty, decr) |
767 |
val varName = |
val varName = |
768 |
case varNameOpt |
case varNameOpt |
769 |
of SOME name => name |
of SOME name => name |
856 |
val uid = case uidOpt of |
val uid = case uidOpt of |
857 |
SOME uid => uid |
SOME uid => uid |
858 |
| NONE => Pid.new() |
| NONE => Pid.new() |
859 |
val id = {name = varSym, uid = uid, location = getLoc(), |
val id = {name = varSym, uid = uid, location = loc, |
860 |
ctype = newTy, stClass = sc, status = status, global = true, |
ctype = newTy, stClass = sc, status = status, global = true, |
861 |
kind = Ast.FUNCTION{hasFunctionDef=false}} |
kind = Ast.FUNCTION{hasFunctionDef=false}} |
862 |
val binding = ID id |
val binding = ID id |
871 |
checkIdRebinding(varSym, ty, status, {globalBinding=hasExtern}) |
checkIdRebinding(varSym, ty, status, {globalBinding=hasExtern}) |
872 |
val uid = case uidOpt of SOME uid => uid | NONE => Pid.new() |
val uid = case uidOpt of SOME uid => uid | NONE => Pid.new() |
873 |
|
|
874 |
val id = {name = varSym, uid = uid, location = getLoc(), |
val id = {name = varSym, uid = uid, location = loc, |
875 |
ctype = ty, stClass = sc, status = status, global = topLevel() orelse hasExtern, |
ctype = ty, stClass = sc, status = status, global = topLevel() orelse hasExtern, |
876 |
kind = Ast.NONFUN} |
kind = Ast.NONFUN} |
877 |
(* always rebind, even if there was a previous binding in |
(* always rebind, even if there was a previous binding in |
951 |
and processTypedef ty decr = |
and processTypedef ty decr = |
952 |
if !multi_file_mode then (* version of processTypede for multi_file_mode *) |
if !multi_file_mode then (* version of processTypede for multi_file_mode *) |
953 |
let |
let |
954 |
val (ty,nameOpt) = mungeTyDecr (ty, decr) |
val (ty,nameOpt,loc) = mungeTyDecr (ty, decr) |
955 |
val name = |
val name = |
956 |
case nameOpt |
case nameOpt |
957 |
of SOME name => name |
of SOME name => name |
999 |
(* store actual typdef symbol mapped to named type id *) |
(* store actual typdef symbol mapped to named type id *) |
1000 |
val _ = checkNonIdRebinding(sym, ty', "typedef ") |
val _ = checkNonIdRebinding(sym, ty', "typedef ") |
1001 |
|
|
1002 |
val binding = TYPEDEF{name = sym, uid = Pid.new(), location = getLoc(), |
val binding = TYPEDEF{name = sym, uid = Pid.new(), location = loc, |
1003 |
ctype = ty'} |
ctype = ty'} |
1004 |
|
|
1005 |
(* store named type id mapped to typedef in named-type table *) |
(* store named type id mapped to typedef in named-type table *) |
1010 |
end |
end |
1011 |
else (* standard version of processTypedef *) |
else (* standard version of processTypedef *) |
1012 |
(* In time the two version should be combined. *) |
(* In time the two version should be combined. *) |
1013 |
let val (ty,nameOpt) = mungeTyDecr (ty, decr) |
let val (ty,nameOpt,loc) = mungeTyDecr (ty, decr) |
1014 |
val name = |
val name = |
1015 |
case nameOpt |
case nameOpt |
1016 |
of SOME name => name |
of SOME name => name |
1026 |
|
|
1027 |
val _ = checkNonIdRebinding(sym, ty', "typedef ") |
val _ = checkNonIdRebinding(sym, ty', "typedef ") |
1028 |
|
|
1029 |
val binding = TYPEDEF{name = sym, uid = Pid.new(), location = getLoc(), |
val binding = TYPEDEF{name = sym, uid = Pid.new(), location = loc, |
1030 |
ctype = ty'} |
ctype = ty'} |
1031 |
|
|
1032 |
(* store named type id mapped to typedef in named-type table *) |
(* store named type id mapped to typedef in named-type table *) |
1039 |
|
|
1040 |
(* like processDeclarator, except it munges a Ast.ctype with |
(* like processDeclarator, except it munges a Ast.ctype with |
1041 |
* a PT.declarator *) |
* a PT.declarator *) |
1042 |
and mungeTyDecr (ty: Ast.ctype, decr : PT.declarator) : Ast.ctype * string option = |
and mungeTyDecr (ty: Ast.ctype, decr : PT.declarator) |
1043 |
|
: Ast.ctype * string option * SourceMap.location = |
1044 |
case decr |
case decr |
1045 |
of PT.VarDecr str => (ty,SOME str) |
of PT.VarDecr str => (ty,SOME str,getLoc()) |
1046 |
| PT.PointerDecr decr => mungeTyDecr (Ast.Pointer ty, decr) |
| PT.PointerDecr decr => mungeTyDecr (Ast.Pointer ty, decr) |
1047 |
| PT.ArrayDecr (decr,PT.EmptyExpr) => mungeTyDecr(Ast.Array (NONE, ty), decr) |
| PT.ArrayDecr (decr,PT.EmptyExpr) => mungeTyDecr(Ast.Array (NONE, ty), decr) |
1048 |
| PT.ArrayDecr (decr,sz) => |
| PT.ArrayDecr (decr,sz) => |
1084 |
else (); |
else (); |
1085 |
mungeTyDecr (ty', decr) |
mungeTyDecr (ty', decr) |
1086 |
end |
end |
1087 |
| PT.EllipsesDecr => (Ast.Ellipses, SOME "**ellipses**") |
| PT.EllipsesDecr => (Ast.Ellipses, SOME "**ellipses**", getLoc()) |
1088 |
| PT.EmptyDecr => (ty, NONE) |
| PT.EmptyDecr => (ty, NONE, getLoc()) |
1089 |
| PT.MARKdeclarator(loc, decr) => |
| PT.MARKdeclarator(loc, decr) => |
1090 |
(pushLoc loc; |
(pushLoc loc; |
1091 |
mungeTyDecr(ty, decr) |
mungeTyDecr(ty, decr) |
1092 |
before popLoc ()) |
before popLoc ()) |
1093 |
| PT.DecrExt ext => CNVDeclarator (ty, ext) |
| PT.DecrExt ext => |
1094 |
|
let val (t,n) = CNVDeclarator (ty, ext) in (t,n,getLoc()) end |
1095 |
|
|
1096 |
|
|
1097 |
(* -------------------------------------------------------------------- |
(* -------------------------------------------------------------------- |
1163 |
funDecr, krParams: PT.declaration list, body}) = |
funDecr, krParams: PT.declaration list, body}) = |
1164 |
(* function definitions *) |
(* function definitions *) |
1165 |
let |
let |
1166 |
val (funTy, tagOpt, _) = processDeclarator (retType, funDecr) |
val (funTy, tagOpt, funLoc) = processDeclarator (retType, funDecr) |
1167 |
val funName = case tagOpt |
val funName = case tagOpt |
1168 |
of SOME tag => tag |
of SOME tag => tag |
1169 |
| NONE => |
| NONE => |
1257 |
else let val decrs = List.map (declExprToDecl "initializer in function declaration") decrExprs |
else let val decrs = List.map (declExprToDecl "initializer in function declaration") decrExprs |
1258 |
val (ty,sc) = cnvType (false, decltype) |
val (ty,sc) = cnvType (false, decltype) |
1259 |
fun folder' (decr, argMap) = |
fun folder' (decr, argMap) = |
1260 |
let val (ty, sOpt) = mungeTyDecr (ty, decr) |
let val (ty, sOpt, loc) = mungeTyDecr (ty, decr) |
1261 |
val s = |
val s = |
1262 |
case sOpt |
case sOpt |
1263 |
of SOME s => |
of SOME s => |
1274 |
(error "Unnamed K&R style parameter - \ |
(error "Unnamed K&R style parameter - \ |
1275 |
\filling with unnamed_KR_parameter"; |
\filling with unnamed_KR_parameter"; |
1276 |
"<unnamed_KR_parameter>") |
"<unnamed_KR_parameter>") |
1277 |
val argMap = IdMap.insert (argMap, s, ((ty,sc),true, getLoc())) |
val argMap = IdMap.insert |
1278 |
|
(argMap, s, ((ty,sc),true,loc)) |
1279 |
in argMap |
in argMap |
1280 |
end |
end |
1281 |
in List.foldl folder' argMap decrs |
in List.foldl folder' argMap decrs |
1312 |
val uid = case uidOpt of |
val uid = case uidOpt of |
1313 |
SOME uid => uid |
SOME uid => uid |
1314 |
| NONE => Pid.new() |
| NONE => Pid.new() |
1315 |
val funId = {name = funSym, uid = uid, location = getLoc(), |
val funId = {name = funSym, uid = uid, location = funLoc, |
1316 |
ctype = funTy', stClass = sc, status = status, |
ctype = funTy', stClass = sc, status = status, |
1317 |
kind = Ast.FUNCTION{hasFunctionDef = true}, global = true} |
kind = Ast.FUNCTION{hasFunctionDef = true}, global = true} |
1318 |
val binding = ID funId |
val binding = ID funId |
1463 |
processDecls(rest, processDeclaration decl) |
processDecls(rest, processDeclaration decl) |
1464 |
end |
end |
1465 |
|
|
1466 |
| processDecls( (PT.MARKstatement (newloc,stmt)) :: rest, astdecls ) = |
| processDecls((PT.MARKstatement (newloc,stmt as PT.Decl _)) :: rest, |
1467 |
|
astdecls) = |
1468 |
(pushLoc newloc; |
(pushLoc newloc; |
1469 |
processDecls(stmt :: rest, astdecls) |
processDecls(stmt :: rest, astdecls) |
1470 |
before popLoc ()) |
before popLoc ()) |
1471 |
|
|
1472 |
|
| processDecls((PT.MARKstatement (newloc,stmt as PT.MARKstatement _)) :: rest, |
1473 |
|
astdecls ) = |
1474 |
|
processDecls(stmt :: rest, astdecls) |
1475 |
|
|
1476 |
| processDecls (rest, astdecls) = (List.concat(rev astdecls), rest) |
| processDecls (rest, astdecls) = (List.concat(rev astdecls), rest) |
1477 |
|
|
1478 |
(* cnvStatement : PT.statement -> Ast.statement *) |
(* cnvStatement : PT.statement -> Ast.statement *) |
2727 |
fun process2 (decr,expr) |
fun process2 (decr,expr) |
2728 |
: Ast.ctype * Ast.member option * Int32.int option = |
: Ast.ctype * Ast.member option * Int32.int option = |
2729 |
let |
let |
2730 |
val (ty', memNameOpt) = mungeTyDecr (ty, decr) |
val (ty', memNameOpt, loc) = mungeTyDecr (ty, decr) |
2731 |
val sizeOpt = |
val sizeOpt = |
2732 |
case expr of |
case expr of |
2733 |
PT.EmptyExpr => NONE |
PT.EmptyExpr => NONE |
2760 |
else (); |
else (); |
2761 |
val member = {name = sym, |
val member = {name = sym, |
2762 |
uid = Pid.new(), |
uid = Pid.new(), |
2763 |
location = getLoc(), |
location = loc, |
2764 |
ctype = ty', |
ctype = ty', |
2765 |
kind = if isStruct |
kind = if isStruct |
2766 |
then Ast.STRUCTmem |
then Ast.STRUCTmem |
3018 |
|
|
3019 |
val _ = |
val _ = |
3020 |
let val coreFuns = {stateFuns=stateFuns, |
let val coreFuns = {stateFuns=stateFuns, |
3021 |
mungeTyDecr=mungeTyDecr, |
mungeTyDecr=(fn (ty, decr) => |
3022 |
|
let val (ctype, name, _) = |
3023 |
|
mungeTyDecr(ty,decr) |
3024 |
|
in (ctype, name) end), |
3025 |
|
(* since we added location in the output of mungeTyDecr and |
3026 |
|
* we don't want to change the extension interface *) |
3027 |
cnvType=cnvType, |
cnvType=cnvType, |
3028 |
cnvExpression=cnvExpression, |
cnvExpression=cnvExpression, |
3029 |
cnvStatement=cnvStatement, |
cnvStatement=cnvStatement, |