Initial import of l4c

[snipe.git] / parse / astutils.sml

signature ASTUTILS =
sig	
  structure Program :
  sig
    val append_typedef : Ast.program -> (Ast.ident * Ast.typedef) -> Ast.program
    val append_function : Ast.program -> (Ast.ident * Ast.function) -> Ast.program
  end
  
  structure Typedef :
  sig
    val data : Ast.typedef -> Ast.typedef
    val mark : Ast.typedef -> Mark.ext option
  end
  
  structure Function :
  sig
    val data : Ast.function -> Ast.function
    val mark : Ast.function -> Mark.ext option
    val returntype : Ast.function -> Ast.vtype
    val params : Ast.function -> Ast.variable list
  end
  
  structure Type :
  sig
    val size : Ast.vtype -> int
    val issmall : Ast.vtype -> bool
  end
end

structure AstUtils :> ASTUTILS =
struct
  structure A = Ast

  structure Program =
  struct
    fun append_typedef (tds, fns) (i, td) =
      let
        val mark = case td
                   of A.MarkedTypedef m => Mark.ext m
                    | _ => NONE
        val _ = case (Symbol.look tds i)
                of SOME (A.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 Typedef =
  struct
    fun data (A.MarkedTypedef m) = data (Mark.data m)
      | data m = m
    
    fun mark (A.MarkedTypedef m) = Mark.ext m
      | mark _ = NONE
  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
  
  structure Type =
  struct
    fun size A.Int = 4
      | size (A.Typedef _) = raise ErrorMsg.InternalError "AU.Type.size on non-small type?"
      | size (A.Pointer _) = 8
      | size (A.Array _) = 8
      | size A.TNull = 8
    
    fun issmall A.Int = true
      | issmall (A.Pointer _) = true
      | issmall (A.Array _) = true
      | issmall _ = false
  end
end