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

SCM Repository

[smlnj] View of /sml/branches/SMLNJ/src/MLRISC/library/annotations.sml
ViewVC logotype

View of /sml/branches/SMLNJ/src/MLRISC/library/annotations.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (download) (annotate)
Fri Sep 3 00:25:03 1999 UTC (20 years, 9 months ago) by monnier
File size: 1253 byte(s)
version 110.19
(*
 *  User definable annotations.
 *
 *  Note: annotations will now be used extensively in all part of
 *  the optimizer.
 *
 *  Idea is stolen from Stephen Weeks
 * 
 *  -- Allen
 *)

structure Annotations : ANNOTATIONS =
struct

   type annotation = exn
   type annotations = annotation list

   val prettyPrinters = ref [] : (annotation -> string) list ref 

   fun attachPrettyPrinter p = prettyPrinters := p :: !prettyPrinters

   fun toString a =
   let fun pr([]) = "<"^exnName a^">"
         | pr(p::ps) = (p a handle _ => pr ps)
   in  pr(!prettyPrinters) end

   (*
    * Look ma, a real use of generative exceptions!
    *)
   fun 'a new() =
   let exception Annotation of 'a
       fun get [] = NONE
         | get (Annotation x::_) = SOME x
         | get (_::l) = get l
       fun put(x,[]) = [Annotation x]
         | put(x,Annotation _::l) = Annotation x::l
         | put(x,y::l) = y::put(x,l)
       fun rmv [] = []
         | rmv (Annotation _::l) = rmv l
         | rmv (x::l) = x::rmv l
   in  { get=get, put=put, rmv=rmv }
   end

   fun get f []     = NONE
     | get f (x::l) = case f x of NONE => get f l | x => x  

   fun rmv f [] = []
     | rmv f (x::l) = if f x then rmv f l else x::rmv f l

   fun put(x,l) = x::l 

end


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