parse/astutils.sml

   1 signature ASTUTILS =
   2 sig
   3   structure Program :
   4   sig
   5     val append_typedef : Ast.program -> (Ast.ident * Ast.typedef) -> Ast.program
   6     val append_function : Ast.program -> (Ast.ident * Ast.function) -> Ast.program
   7   end
   8
   9   structure Typedef :
  10   sig
  11     val data : Ast.typedef -> Ast.typedef
  12     val mark : Ast.typedef -> Mark.ext option
  13   end
  14
  15   structure Function :
  16   sig
  17     val data : Ast.function -> Ast.function
  18     val mark : Ast.function -> Mark.ext option
  19     val returntype : Ast.function -> Ast.vtype
  20     val params : Ast.function -> Ast.variable list
  21   end
  22
  23   structure Type :
  24   sig
  25     val size : Ast.vtype -> int
  26     val issmall : Ast.vtype -> bool
  27   end
  28 end
  29
  30 structure AstUtils :> ASTUTILS =
  31 struct
  32   structure A = Ast
  33
  34   structure Program =
  35   struct
  36     fun append_typedef (tds, fns) (i, td) =
  37       let
  38         val mark = case td
  39                    of A.MarkedTypedef m => Mark.ext m
  40                     | _ => NONE
  41         val _ = case (Symbol.look tds i)
  42                 of SOME (A.MarkedTypedef m) => (ErrorMsg.error mark ("Redefining typedef " ^ Symbol.name i) ;
  43                                                 ErrorMsg.error (Mark.ext m) "(was originally defined here)" ;
  44                                                 raise ErrorMsg.Error)
  45                  | SOME _ => (ErrorMsg.error mark ("Redefining typedef " ^ Symbol.name i) ;
  46                               raise ErrorMsg.Error)
  47                  | _ => ()
  48      in
  49        (Symbol.bind tds (i, td), fns)
  50      end
  51     fun append_function (tds, fns) (i, func) =
  52       let
  53         val mark = case func
  54                    of A.MarkedFunction m => Mark.ext m
  55                     | _ => NONE
  56         val _ = case (Symbol.look fns i)
  57                 of SOME (A.MarkedFunction m) => (ErrorMsg.error mark ("Redefining function " ^ Symbol.name i) ;
  58                                                  ErrorMsg.error (Mark.ext m) "(was originally defined here)" ;
  59                                                  raise ErrorMsg.Error)
  60                  | SOME _ => (ErrorMsg.error mark ("Redefining function " ^ Symbol.name i) ;
  61                               raise ErrorMsg.Error)
  62                  | _ => ()
  63      in
  64        (tds, Symbol.bind fns (i, func))
  65      end
  66   end
  67
  68   structure Typedef =
  69   struct
  70     fun data (A.MarkedTypedef m) = data (Mark.data m)
  71       | data m = m
  72
  73     fun mark (A.MarkedTypedef m) = Mark.ext m
  74       | mark _ = NONE
  75   end
  76
  77   structure Function =
  78   struct
  79     fun data (A.MarkedFunction m) = data (Mark.data m)
  80       | data m = m
  81
  82     fun mark (A.MarkedFunction m) = Mark.ext m
  83       | mark _ = NONE
  84
  85     fun returntype (A.MarkedFunction m) = returntype (Mark.data m)
  86       | returntype (A.Function (r, _, _, _)) = r
  87       | returntype (A.Extern (r, _)) = r
  88
  89     fun params (A.MarkedFunction m) = params (Mark.data m)
  90       | params (A.Function (_, pl, _, _)) = pl
  91       | params (A.Extern (_, pl)) = pl
  92   end
  93
  94   structure Type =
  95   struct
  96     fun size A.Int = 4
  97       | size (A.Typedef _) = raise ErrorMsg.InternalError "AU.Type.size on non-small type?"
  98       | size (A.Pointer _) = 8
  99       | size (A.Array _) = 8
 100       | size A.TNull = 8
 101
 102     fun issmall A.Int = true
 103       | issmall (A.Pointer _) = true
 104       | issmall (A.Array _) = true
 105       | issmall _ = false
 106   end
 107 end