Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/ckit/src/ast/build-ast.sml
ViewVC logotype

Diff of /sml/trunk/ckit/src/ast/build-ast.sml

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

revision 638, Tue May 2 19:35:33 2000 UTC revision 639, Tue May 2 21:44:37 2000 UTC
# Line 763  Line 763 
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
# Line 856  Line 856 
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
# Line 871  Line 871 
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
# Line 951  Line 951 
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
# Line 999  Line 999 
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 *)
# Line 1010  Line 1010 
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
# Line 1026  Line 1026 
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 *)
# Line 1039  Line 1039 
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) =>
# Line 1083  Line 1084 
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    (* --------------------------------------------------------------------    (* --------------------------------------------------------------------
# Line 1161  Line 1163 
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 =>
# Line 1255  Line 1257 
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 =>
# Line 1272  Line 1274 
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
# Line 1309  Line 1312 
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
# Line 1460  Line 1463 
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 *)
# Line 2719  Line 2727 
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
# Line 2752  Line 2760 
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
# Line 3010  Line 3018 
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,

Legend:
Removed from v.638  
changed lines
  Added in v.639

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