00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #ifndef __GENERIC_OBJECT_HPP
00014 #define __GENERIC_OBJECT_HPP
00015 #include <basix/glue.hpp>
00016 namespace mmx {
00017
00018 nat define_user_type (const generic& name);
00019 nat get_user_type (const generic& name);
00020
00021
00022
00023
00024
00025 class generic_object_rep: public generic_rep {
00026 public:
00027 generic rep;
00028 nat id;
00029
00030 protected:
00031 nat get_type () const { return id; }
00032 bool same_type (const generic& g) const { return type (g) == id; }
00033 nat get_symbolic_type () const { return SYMBOLIC_UNSPECIFIED; }
00034 nat get_species_type () const { return SPECIES_DEFAULT; }
00035 nat get_length () const { return 0; }
00036 generic get_child (nat i) const { ERROR ("invalid child"); return 0; }
00037 nat get_hard_hash_value () const { return hard_hash (rep); }
00038 nat get_exact_hash_value () const { return exact_hash (rep); }
00039 nat get_hash_value () const { return hash (rep); }
00040 bool is_hard_eq (const generic& g) const {
00041 if (type (g) != id) return false;
00042 return hard_eq (rep, ((generic_object_rep*) inspect (g)) -> rep); }
00043 bool is_exact_eq (const generic& g) const {
00044 if (type (g) != id) return false;
00045 return exact_eq (rep, ((generic_object_rep*) inspect (g)) -> rep); }
00046 bool is_equal (const generic& g) const {
00047 if (type (g) != id) return false;
00048 return rep == ((generic_object_rep*) inspect (g)) -> rep; }
00049 generic duplicate_me () const {
00050 return as_object (duplicate (rep), id); }
00051 syntactic expression () const {
00052 if (is_alias_type (id))
00053 return flatten (get_alias (as<alias<generic> > (rep)));
00054 else {
00055
00056 generic r= current_ev->apply (GEN_FLATTEN, as_object (rep, id));
00057 return as<syntactic> (r); } }
00058 generic binary_type () const {
00059 ERROR ("binary type not implemented for user objects"); }
00060 generic binary_disassemble () const {
00061 ERROR ("binary disassemble not implemented for user objects"); }
00062 void binary_write (const port& p) const {
00063 ERROR ("binary write not implemented for user objects"); }
00064 generic make_abstract_vector () const {
00065 ERROR ("invalid abstraction"); }
00066 generic make_concrete_vector (const generic& v) const {
00067 ERROR ("invalid concretization"); }
00068
00069 public:
00070 generic_object_rep (const generic& rep2, nat id2):
00071 rep (rep2), id (id2) {}
00072 };
00073
00074 static bool object_equal (const generic& x, const generic& y) {
00075 return x == y; }
00076 static bool object_unequal (const generic& x, const generic& y) {
00077 return x != y; }
00078 static syntactic object_flatten (const generic& x) {
00079 nat id= type (x);
00080 generic rep= as_generic (x, id);
00081 return apply ("object", flatten (rep), flatten (type_name (id))); }
00082
00083 static generic object_alias (const generic& x) {
00084 nat alias_id= scalar_to_alias (type (x));
00085 return as_object (as<generic> (new_alias<generic> (x)), alias_id); }
00086 static generic object_get_alias (const generic& x) {
00087 nat alias_id= type (x);
00088 return get_alias (as<alias<generic> > (as_generic (x, alias_id))); }
00089 static generic object_set_alias (const generic& x, const generic& y) {
00090 nat alias_id= type (x);
00091 return set_alias (as<alias<generic> > (as_generic (x, alias_id)), y); }
00092 static generic object_specialize_alias (const alias<generic>& x) {
00093 nat alias_id= scalar_to_alias (type (get_alias (x)));
00094 return as_object (as<generic> (x), alias_id); }
00095 static alias<generic> object_generalize_alias (const generic& x) {
00096 nat alias_id= type (x);
00097 return as<alias<generic> > (as_generic (x, alias_id)); }
00098
00099
00100
00101
00102
00103 nat
00104 define_user_type (const generic& name) {
00105 nat id= new_type_id ();
00106 nat alias_id= new_alias_type_id (id);
00107 nat tuple_id= new_tuple_type_id (id);
00108 define_type_sub (name, id);
00109 define_type_sub (gen (GEN_ALIAS_TYPE, name), alias_id);
00110 define_type_sub (gen (GEN_TUPLE_TYPE, name), tuple_id);
00111
00112 {
00113 vector<nat> sig= vec<nat> (alias_id, id);
00114 routine r = unary_routine (GEN_ALIAS, object_alias);
00115 routine r2= change_signature (r, sig);
00116 current_ev->overload (GEN_ALIAS, as<generic> (r2), PENALTY_INCLUSION);
00117 }
00118
00119 {
00120 vector<nat> sig= vec<nat> (id, alias_id);
00121 routine r = unary_routine (GEN_UNALIAS, object_get_alias);
00122 routine r2= change_signature (r, sig);
00123 alias_getter (alias_id, r2);
00124 }
00125
00126 {
00127 vector<nat> sig= vec<nat> (id, alias_id, id);
00128 routine r = binary_routine (GEN_UNALIAS, object_set_alias);
00129 routine r2= change_signature (r, sig);
00130 alias_setter (alias_id, r2);
00131 }
00132
00133 {
00134 vector<nat> sig= vec<nat> (alias_id, type_id<alias<generic> > ());
00135 routine r = unary_routine (GEN_SPECIALIZE, object_specialize_alias);
00136 routine r2= change_signature (r, sig);
00137 alias_specializer (id, r2);
00138 }
00139
00140 {
00141 vector<nat> sig= vec<nat> (id, alias_id);
00142 generic cv= gen (GEN_INTO, name, gen (GEN_ALIAS_TYPE, name));
00143 routine r = unary_routine (cv, object_get_alias);
00144 routine r2= change_signature (r, sig);
00145 current_ev->overload (GEN_REWRITE, as<generic> (r2), PENALTY_INCLUSION);
00146 }
00147
00148 {
00149 vector<nat> sig= vec<nat> (type_id<alias<generic> > (), alias_id);
00150 generic cv= gen (GEN_INTO, gen (GEN_ALIAS_TYPE, GEN_GENERIC_TYPE),
00151 gen (GEN_ALIAS_TYPE, name));
00152 routine r = unary_routine (cv, object_generalize_alias);
00153 routine r2= change_signature (r, sig);
00154 current_ev->overload (GEN_REWRITE, as<generic> (r2), PENALTY_INCLUSION);
00155 }
00156
00157 {
00158 vector<nat> sig= vec<nat> (type_id<bool> (), id, id);
00159 routine r = binary_routine (GEN_EQUAL, object_equal);
00160 routine r2= change_signature (r, sig);
00161 current_ev->overload (GEN_EQUAL, as<generic> (r2), PENALTY_INCLUSION);
00162 }
00163
00164 {
00165 vector<nat> sig= vec<nat> (type_id<bool> (), id, id);
00166 routine r = binary_routine (GEN_UNEQUAL, object_unequal);
00167 routine r2= change_signature (r, sig);
00168 current_ev->overload (GEN_UNEQUAL, as<generic> (r2), PENALTY_INCLUSION);
00169 }
00170
00171 {
00172 vector<nat> sig= vec<nat> (type_id<syntactic> (), id);
00173 routine r = unary_routine (GEN_FLATTEN, object_flatten);
00174 routine r2= change_signature (r, sig);
00175 current_ev->overload (GEN_FLATTEN, as<generic> (r2), PENALTY_INCLUSION);
00176 }
00177
00178 return id;
00179 }
00180
00181 nat
00182 get_user_type (const generic& name) {
00183 nat r= type_id (name);
00184 if (r == 1) {
00185 generic tp= name;
00186 if (is_func (tp, GEN_TUPLE_TYPE, 1)) tp= tp[1];
00187 if (is_func (tp, GEN_ALIAS_TYPE, 1)) tp= tp[1];
00188 if (is_func (tp, GEN_GENERIC_ALIAS_TYPE, 1)) tp= tp[1];
00189 define_user_type (tp);
00190 r= type_id (name);
00191 }
00192 return r;
00193 }
00194
00195
00196
00197
00198
00199 generic
00200 as_object (const generic& g, nat tp_id) {
00201 return new generic_object_rep (g, tp_id);
00202 };
00203
00204 generic
00205 as_object (const generic& g, const generic& tp) {
00206 return new generic_object_rep (g, get_user_type (tp));
00207 };
00208
00209 generic
00210 as_generic (const generic& g, nat tp_id) {
00211 ASSERT (type (g) == tp_id, "type mismatch");
00212 return ((generic_object_rep*) inspect (g)) -> rep;
00213 };
00214
00215 generic
00216 as_generic (const generic& g, const generic& tp) {
00217 ASSERT (type (g) == get_user_type (tp), "type mismatch");
00218 return ((generic_object_rep*) inspect (g)) -> rep;
00219 };
00220
00221 }
00222 #endif // __GENERIC_OBJECT_HPP