Fix some stupid bugs in code generation.

[snipe.git] / parse / astutils.sml

signature ASTUTILS =
sig	
  structure Program :
  sig
    val append_typedef : Ast.program -> (Ast.ident * Type.typedef) -> Ast.program
    val append_function : Ast.program -> (Ast.ident * Ast.function) -> Ast.program
  end

  structure Function :
  sig
    val data : Ast.function -> Ast.function
    val mark : Ast.function -> Mark.ext option
    val returntype : Ast.function -> Type.vtype
    val params : Ast.function -> Type.variable list
  end
end

structure AstUtils :> ASTUTILS =
struct
  structure T = Type
  structure A = Ast

  structure Program =
  struct
    fun append_typedef (tds, fns) (i, td) =
      let
        val mark = case td
                   of T.MarkedTypedef m => Mark.ext m
                    | _ => NONE
        val _ = case (Symbol.look tds i)
                of SOME (T.MarkedTypedef m) => (ErrorMsg.error mark ("Redefining typedef " ^ Symbol.name i) ;
                                                ErrorMsg.error (Mark.ext m) "(was originally defined here)" ;
                                                raise ErrorMsg.Error)
                 | SOME _ => (ErrorMsg.error mark ("Redefining typedef " ^ Symbol.name i) ;
                              raise ErrorMsg.Error)
                 | _ => ()
     in
       (Symbol.bind tds (i, td), fns)
     end
    fun append_function (tds, fns) (i, func) =
      let
        val mark = case func
                   of A.MarkedFunction m => Mark.ext m
                    | _ => NONE
        val _ = case (Symbol.look fns i)
                of SOME (A.MarkedFunction m) => (ErrorMsg.error mark ("Redefining function " ^ Symbol.name i) ;
                                                 ErrorMsg.error (Mark.ext m) "(was originally defined here)" ;
                                                 raise ErrorMsg.Error)
                 | SOME _ => (ErrorMsg.error mark ("Redefining function " ^ Symbol.name i) ;
                              raise ErrorMsg.Error)
                 | _ => ()
     in
       (tds, Symbol.bind fns (i, func))
     end
  end

  structure Function =
  struct
    fun data (A.MarkedFunction m) = data (Mark.data m)
      | data m = m
    
    fun mark (A.MarkedFunction m) = Mark.ext m
      | mark _ = NONE
    
    fun returntype (A.MarkedFunction m) = returntype (Mark.data m)
      | returntype (A.Function (r, _, _, _)) = r
      | returntype (A.Extern (r, _)) = r
    
    fun params (A.MarkedFunction m) = params (Mark.data m)
      | params (A.Function (_, pl, _, _)) = pl
      | params (A.Extern (_, pl)) = pl
  end

end