parse/astutils.sml

   1 signature ASTUTILS =
   2 sig
   3   structure Program :
   4   sig
   5     val append_typedef : Ast.program -> (Ast.ident * Type.typedef) -> Ast.program
   6     val append_function : Ast.program -> (Ast.ident * Ast.function) -> Ast.program
   7   end
   8
   9   structure Function :
  10   sig
  11     val data : Ast.function -> Ast.function
  12     val mark : Ast.function -> Mark.ext option
  13     val returntype : Ast.function -> Type.vtype
  14     val params : Ast.function -> Type.variable list
  15   end
  16 end
  17
  18 structure AstUtils :> ASTUTILS =
  19 struct
  20   structure T = Type
  21   structure A = Ast
  22
  23   structure Program =
  24   struct
  25     fun append_typedef (tds, fns) (i, td) =
  26       let
  27         val mark = case td
  28                    of T.MarkedTypedef m => Mark.ext m
  29                     | _ => NONE
  30         val _ = case (Symbol.look tds i)
  31                 of SOME (T.MarkedTypedef m) => (ErrorMsg.error mark ("Redefining typedef " ^ Symbol.name i) ;
  32                                                 ErrorMsg.error (Mark.ext m) "(was originally defined here)" ;
  33                                                 raise ErrorMsg.Error)
  34                  | SOME _ => (ErrorMsg.error mark ("Redefining typedef " ^ Symbol.name i) ;
  35                               raise ErrorMsg.Error)
  36                  | _ => ()
  37      in
  38        (Symbol.bind tds (i, td), fns)
  39      end
  40     fun append_function (tds, fns) (i, func) =
  41       let
  42         val mark = case func
  43                    of A.MarkedFunction m => Mark.ext m
  44                     | _ => NONE
  45         val _ = case (Symbol.look fns i)
  46                 of SOME (A.MarkedFunction m) => (ErrorMsg.error mark ("Redefining function " ^ Symbol.name i) ;
  47                                                  ErrorMsg.error (Mark.ext m) "(was originally defined here)" ;
  48                                                  raise ErrorMsg.Error)
  49                  | SOME _ => (ErrorMsg.error mark ("Redefining function " ^ Symbol.name i) ;
  50                               raise ErrorMsg.Error)
  51                  | _ => ()
  52      in
  53        (tds, Symbol.bind fns (i, func))
  54      end
  55   end
  56
  57   structure Function =
  58   struct
  59     fun data (A.MarkedFunction m) = data (Mark.data m)
  60       | data m = m
  61
  62     fun mark (A.MarkedFunction m) = Mark.ext m
  63       | mark _ = NONE
  64
  65     fun returntype (A.MarkedFunction m) = returntype (Mark.data m)
  66       | returntype (A.Function (r, _, _, _)) = r
  67       | returntype (A.Extern (r, _)) = r
  68
  69     fun params (A.MarkedFunction m) = params (Mark.data m)
  70       | params (A.Function (_, pl, _, _)) = pl
  71       | params (A.Extern (_, pl)) = pl
  72   end
  73
  74 end