## highcode-dictionary.pkg
# Compiled by:
# src/lib/compiler/core.sublib### "I will not go so far as to say that to construct
### a history of thought without profound study of
### the mathematical ideas of successive epochs is
### like omitting Hamlet from the play which is
### named after him.
###
### "But it is certainly analogous to cutting out
### the part of Ophelia. This simile is singularly exact.
### For Ophelia is quite essential to the play,
### she is very charming -- and a little mad."
###
### -- Alfred North Whitehead (1861-1947)
### [English philosopher and mathematician]
stipulate
package hut = highcode_uniq_types;
herein
api Highcode_Dictionary {
#
Uniqtype = hut::Uniqtype;
Uniqtypoid = hut::Uniqtypoid;
tmemo_fn: { tcf: (Uniqtype -> X) -> (Uniqtype -> X),
ltf: (Uniqtype -> X, Uniqtypoid -> Y) -> (Uniqtypoid -> Y)
}
->
{ tc_map: Uniqtype -> X,
lt_map: Uniqtypoid -> Y
};
wmemo_fn: { tc_wmap: (Uniqtype -> X, Uniqtype -> X) -> (Uniqtype -> X),
tc_umap: (Uniqtype -> X, Uniqtype -> X) -> (Uniqtype -> X),
lt_umap: (Uniqtype -> X, Uniqtypoid -> Y) -> (Uniqtypoid -> Y)
}
->
{ tc_wmap: Uniqtype -> X,
tc_umap: Uniqtype -> X,
lt_umap: Uniqtypoid -> Y,
cleanup: Void -> Void
};
};
end;
stipulate
package hut = highcode_uniq_types;
herein
package highcode_dictionary: (weak) Highcode_Dictionary { # Highcode_Dictionary is from src/lib/compiler/back/top/highcode/highcode-dictionary.pkg fun bug s
=
error_message::impossible ("LtyDict: " + s);
say = global_controls::print::say;
package tc_dictionary
=
red_black_map_g ( # red_black_map_g is from src/lib/src/red-black-map-g.pkg #
Key = hut::Uniqtype;
compare = hut::compare_uniqtypes;
);
package lt_dictionary
=
red_black_map_g (
#
Key = hut::Uniqtypoid;
compare = hut::compare_uniqtypoids;
);
Uniqtype = hut::Uniqtype;
Uniqtypoid = hut::Uniqtypoid;
fun tmemo_fn { tcf, ltf }
=
{ tc_map => tc_look,
lt_map => lt_look
}
where
m1 = REF (tc_dictionary::empty);
m2 = REF (lt_dictionary::empty);
fun tc_look t
=
case (tc_dictionary::get (*m1, t))
#
THE t' => t';
#
NULL => { x = (tcf tc_look) t;
m1 := tc_dictionary::set (*m1, t, x);
x;
};
esac
also
fun lt_look t
=
case (lt_dictionary::get (*m2, t))
#
THE t' => t';
#
NULL => { x = ltf (tc_look, lt_look) t;
m2 := lt_dictionary::set (*m2, t, x);
x;
};
esac;
end; # fun tmemo_fn
fun wmemo_fn { tc_wmap, tc_umap, lt_umap }
=
{ tc_wmap => tcw_look,
tc_umap => tcu_look,
lt_umap => ltu_look,
cleanup
}
where
m1 = REF (tc_dictionary::empty);
m2 = REF (tc_dictionary::empty);
m3 = REF (lt_dictionary::empty);
fun tcw_look t
=
case (tc_dictionary::get (*m1, t))
#
THE t' => t';
#
NULL => { x = (tc_wmap (tcw_look, tcu_look)) t;
m1 := tc_dictionary::set (*m1, t, x);
x;
};
esac
also
fun tcu_look t
=
case (tc_dictionary::get (*m2, t))
#
THE t' => t';
#
NULL => { x = (tc_umap (tcu_look, tcw_look)) t;
m2 := tc_dictionary::set (*m2, t, x);
x;
};
esac
also
fun ltu_look t
=
case (lt_dictionary::get (*m3, t))
#
THE t' => t';
#
NULL => { x = lt_umap (tcu_look, ltu_look) t;
m3 := lt_dictionary::set (*m3, t, x);
x;
};
esac;
fun cleanup () = ();
end; # fun wmemo_fn
}; # package highcode_dictionary
end; # toplevel stipulate