## note.pkg
#
# User definable annotations.
#
# Note: annotations will henceforth be used
# extensively in all parts of the optimizer.
#
# Idea is stolen from Stephen Weeks
#
# -- Allen Leung
#
# See also comments in
#
# src/lib/std/standard.lib# Compiled by:
# src/lib/std/standard.libpackage note
: (weak) Note # Note is from src/lib/src/note.api{
Note = Exception;
Notes = List( Note );
exception NO_NOTE_FOUND;
Notekind(X)
=
{ get: Notes -> Null_Or(X),
peek: Note -> Null_Or(X),
lookup: Notes -> X,
is_in: Notes -> Bool,
set: (X, Notes) -> Notes,
rmv: Notes -> Notes,
x_to_note: X -> Note
};
Flag = Notekind( Void );
prettyprinters
=
REF []: Ref( List( Note -> String ) ); # XXX BUGGO FIXME icky thread-hostile mutable global state.
fun attach_prettyprinter p
=
prettyprinters
:=
p ! *prettyprinters;
fun to_string a
=
print *prettyprinters
where
fun print ([]) => "";
print (p ! ps) => (p a except _ = print ps);
end;
end;
# Look ma, a real use of generative exceptions!
#
fun make_notekind to_string
=
{ exception NOTE(X);
fun get [] => NULL;
get (NOTE x ! _) => THE x;
get (_ ! l) => get l;
end;
fun peek (NOTE x) => THE x;
peek _ => NULL;
end;
fun lookup [] => raise exception NO_NOTE_FOUND;
lookup (NOTE x ! _) => x;
lookup (_ ! l) => lookup l;
end;
fun is_in [] => FALSE;
is_in (NOTE _ ! _) => TRUE;
is_in ( _ ! l) => is_in l;
end;
fun set (x,[]) => [NOTE x];
set (x, NOTE _ ! l) => NOTE x ! l;
set (x, y ! l) => y ! set (x, l);
end;
fun rmv [] => [];
rmv (NOTE _ ! l) => rmv l;
rmv (x ! l) => x ! rmv l;
end;
case to_string
#
THE f => attach_prettyprinter
\\ NOTE x => f x;
e => raise exception e;
end;
#
NULL => ();
esac;
{ get, peek, lookup, is_in, set, rmv, x_to_note => NOTE };
};
fun make_notekind' { x_to_note, to_string, get=>get' }
=
{ fun get [] => NULL;
get (x ! l) => THE (get' x)
except
_ = get l;
end;
fun peek x
=
THE (get' x)
except
_ = NULL;
fun lookup [] => raise exception NO_NOTE_FOUND;
lookup (x ! l) => get' x
except
_ = lookup l;
end;
fun is_in [] => FALSE;
is_in (x ! l) => { get' x; TRUE; }
except
_ = is_in l;
end;
fun set (x,[]) => [x_to_note x];
set (x, a ! l) => { get' a; x_to_note x ! l;}
except
_ = a ! set (x, l);
end;
fun rmv [] => [];
rmv (x ! l) => { get' x; rmv l; }
except
_ = x ! rmv l;
end;
attach_prettyprinter (to_string o get');
{ get, peek, lookup, is_in, set, rmv, x_to_note };
};
};