EXFUN (Fread_from_string, 3);
+EXFUN (Fconcord_decode_object, 4);
+EXFUN (Fconcord_object_put, 3);
+EXFUN (Fconcord_object_get, 2);
+
Lisp_Object Qconcord;
Lisp_Object Qconcord_object;
Lisp_Object Qgenre, Q_id;
Lisp_Object Vconcord_ds_hash_table;
Lisp_Object Vconcord_genre_hash_table;
+Lisp_Object Vconcord_genre_object_hash_table;
typedef struct Lisp_CONCORD_DS Lisp_CONCORD_DS;
concord_object_description,
Lisp_CONCORD_Object);
-DEFUN ("concord-make-object",
- Fconcord_make_object, 1, 3, 0, /*
+static Lisp_Object
+concord_genre_cache_get_object (Lisp_Object genre, Lisp_Object id)
+{
+ Lisp_Object obj_hash;
+
+ obj_hash = Fgethash (genre, Vconcord_genre_object_hash_table, Qunbound);
+ if (UNBOUNDP (obj_hash))
+ return Qunbound;
+ return Fgethash (id, obj_hash, Qunbound);
+}
+
+static Lisp_Object
+concord_genre_cache_put_object (Lisp_Object genre, Lisp_Object id,
+ Lisp_Object object)
+{
+ Lisp_Object obj_hash;
+
+ obj_hash = Fgethash (genre, Vconcord_genre_object_hash_table, Qunbound);
+ if (UNBOUNDP (obj_hash))
+ {
+ obj_hash
+ = make_lisp_hash_table (256, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+ Fputhash (genre, obj_hash, Vconcord_genre_object_hash_table);
+ }
+ return Fputhash (id, object, obj_hash);
+}
+
+DEFUN ("concord-make-object", Fconcord_make_object, 1, 3, 0, /*
Make and return a Concord-object from ID and GENRE.
Optional argument DS specifies the data-source of the GENRE.
*/
- (id, genre, ds))
+ (genre, id, ds))
{
Lisp_CONCORD_DS* lds;
- char* genre_name;
+ Lisp_Object genre_string;
+ char* genre_name_str;
CONCORD_Genre c_genre;
Lisp_CONCORD_Object* lcobj;
Lisp_Object retval;
+ if (!NILP (id))
+ {
+ retval = concord_genre_cache_get_object (genre, id);
+ if (!UNBOUNDP (retval))
+ {
+ return retval;
+ }
+ }
if (NILP (ds))
ds = Fconcord_genre_ds (genre);
CHECK_CONCORD_DS (ds);
lds = XCONCORD_DS (ds);
if (lds->ds == NULL)
return Qnil;
- if ( !STRINGP(genre) )
- genre = Fsymbol_name (genre);
- TO_EXTERNAL_FORMAT (LISP_STRING, genre,
- C_STRING_ALLOCA, genre_name,
+ if ( STRINGP(genre) )
+ genre_string = genre;
+ else
+ genre_string = Fsymbol_name (genre);
+ TO_EXTERNAL_FORMAT (LISP_STRING, genre_string,
+ C_STRING_ALLOCA, genre_name_str,
Qfile_name);
- c_genre = concord_ds_get_genre (lds->ds, genre_name);
+ c_genre = concord_ds_get_genre (lds->ds, genre_name_str);
if (c_genre == NULL)
return Qnil;
lcobj = allocate_concord_object ();
lcobj->genre = c_genre;
lcobj->id = id;
XSET_CONCORD_OBJECT (retval, lcobj);
+ if (!NILP (id))
+ {
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ GCPRO4 (retval, id, genre, ds);
+ concord_genre_cache_put_object (genre, id, retval);
+#if 1
+ if (!EQ (Fconcord_object_get (retval, Q_id), id))
+ Fconcord_object_put (retval, Q_id, id);
+#endif
+ UNGCPRO;
+ }
return retval;
}
-DEFUN ("concord-object-p",
- Fconcord_object_p, 1, 1, 0, /*
+DEFUN ("concord-object-p", Fconcord_object_p, 1, 1, 0, /*
Return t if OBJECT is a concord-object.
*/
(object))
return CONCORD_OBJECT_P (object) ? Qt : Qnil;
}
-DEFUN ("concord-object-id",
- Fconcord_object_id, 1, 1, 0, /*
+DEFUN ("concord-object-id", Fconcord_object_id, 1, 1, 0, /*
Return an id of Concord-object OBJECT.
*/
(object))
return XCONCORD_OBJECT_ID (object);
}
-DEFUN ("concord-decode-object",
- Fconcord_decode_object, 2, 4, 0, /*
+DEFUN ("concord-decode-object", Fconcord_decode_object, 2, 4, 0, /*
Make and return a Concord-object from FEATURE and VALUE.
Optional argument GENRE specifies the GENRE of the object.
Optional argument DS specifies the data-source of the GENRE.
CONCORD_String_Tank st_id;
int status;
Lisp_Object obj;
+ int previous_print_readably;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
if (NILP (ds))
return Qnil;
}
+ previous_print_readably = print_readably;
+ print_readably = 1;
GCPRO5 (feature, value, genre, ds, value_string);
value_string = Fprin1_to_string (value, Qnil);
UNGCPRO;
+ print_readably = previous_print_readably;
TO_EXTERNAL_FORMAT (LISP_STRING,
value_string, C_STRING_ALLOCA, strid,
Qfile_name);
status = concord_index_strid_get_obj_string (c_index, strid, &st_id);
if (!status)
{
- GCPRO3 (genre, ds, obj);
+ Lisp_Object retval;
+
+ GCPRO4 (genre, ds, obj, retval);
#if 0
obj = read_from_c_string (CONCORD_String_data (&st_id),
CONCORD_String_size (&st_id) );
Qfile_name),
Qnil, Qnil));
#endif
+ retval = Fconcord_make_object (genre, obj, ds);
UNGCPRO;
- return Fconcord_make_object (obj, genre, ds);
+ return retval;
}
return Qnil;
}
-DEFUN ("concord-object-get",
- Fconcord_object_get, 2, 2, 0, /*
+DEFUN ("concord-object-get", Fconcord_object_get, 2, 2, 0, /*
Return the value of OBJECT's FEATURE.
*/
(object, feature))
{
struct gcpro gcpro1, gcpro2;
+ int previous_print_readably;
Lisp_Object obj_string;
char* c_obj;
CONCORD_Genre c_genre;
CHECK_CONCORD_OBJECT (object);
if ( !STRINGP(feature) )
feature = Fsymbol_name (feature);
+ previous_print_readably = print_readably;
+ print_readably = 1;
GCPRO2 (object, feature);
obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
UNGCPRO;
+ print_readably = previous_print_readably;
TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
C_STRING_ALLOCA, c_obj, Qfile_name);
c_genre = XCONCORD_OBJECT_GENRE(object);
return Qnil;
}
-DEFUN ("concord-object-put",
- Fconcord_object_put, 3, 3, 0, /*
-Store a VALUE of OBJECT's FEATURE.
-*/
- (object, feature, value))
+static Lisp_Object
+concord_object_put (Lisp_Object object, Lisp_Object feature,
+ Lisp_Object value)
{
struct gcpro gcpro1, gcpro2, gcpro3;
+ int previous_print_readably;
Lisp_Object obj_string;
char* c_obj;
CONCORD_Genre c_genre;
Lisp_Object value_string;
char* c_value;
- CHECK_CONCORD_OBJECT (object);
if ( !STRINGP(feature) )
feature = Fsymbol_name (feature);
+ previous_print_readably = print_readably;
+ print_readably = 1;
GCPRO3 (object, feature, value);
obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
UNGCPRO;
+ print_readably = previous_print_readably;
TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
C_STRING_ALLOCA, c_obj, Qfile_name);
c_genre = XCONCORD_OBJECT_GENRE(object);
{
return Qnil;
}
+ previous_print_readably = print_readably;
+ print_readably = 1;
GCPRO3 (object, feature, value);
value_string = Fprin1_to_string (value, Qnil);
UNGCPRO;
+ print_readably = previous_print_readably;
TO_EXTERNAL_FORMAT (LISP_STRING, value_string,
C_STRING_ALLOCA, c_value,
Qfile_name);
status = chise_feature_sync (c_feature);
if (status)
return Qnil;
+ if (XSTRING_DATA(feature)[0] == '=')
+ {
+ CONCORD_INDEX c_index
+ = concord_genre_get_index (c_genre, feature_name);
+
+ concord_index_strid_put_obj (c_index, c_value, c_obj);
+ concord_index_sync (c_index);
+ }
+ return Qt;
+}
+
+DEFUN ("concord-object-put", Fconcord_object_put, 3, 3, 0, /*
+Store a VALUE of OBJECT's FEATURE.
+*/
+ (object, feature, value))
+{
+ Lisp_String* name;
+ Bufbyte *name_str;
+
+ CHECK_CONCORD_OBJECT (object);
+ name = symbol_name (XSYMBOL (feature));
+ name_str = string_data (name);
+ if ( NILP (concord_object_put (object, feature, value)) )
+ return Qnil;
+ if ( EQ (feature, Q_subsumptive) ||
+ EQ (feature, Q_subsumptive_from) ||
+ EQ (feature, Q_denotational) ||
+ EQ (feature, Q_denotational_from) ||
+ ( ( ((name_str[0] == '-') && (name_str[1] == '>')) ||
+ ((name_str[0] == '<') && (name_str[1] == '-')) )
+ && (memchr (name_str, '*', name->size) == NULL) ) )
+ {
+ Lisp_Object rest = value;
+ Lisp_Object ret;
+ Lisp_Object rev_feature = Qnil;
+ struct gcpro gcpro1;
+
+ GCPRO1 (rev_feature);
+ if (EQ (feature, Q_subsumptive))
+ rev_feature = Q_subsumptive_from;
+ else if (EQ (feature, Q_subsumptive_from))
+ rev_feature = Q_subsumptive;
+ else if (EQ (feature, Q_denotational))
+ rev_feature = Q_denotational_from;
+ else if (EQ (feature, Q_denotational_from))
+ rev_feature = Q_denotational;
+ else
+ {
+ Bytecount length = string_length (name);
+ Bufbyte *rev_name_str = alloca (length + 1);
+
+ memcpy (rev_name_str + 2, name_str + 2, length - 2);
+ if (name_str[0] == '<')
+ {
+ rev_name_str[0] = '-';
+ rev_name_str[1] = '>';
+ }
+ else
+ {
+ rev_name_str[0] = '<';
+ rev_name_str[1] = '-';
+ }
+ rev_name_str[length] = 0;
+ rev_feature = intern (rev_name_str);
+ }
+
+ while (CONSP (rest))
+ {
+ ret = XCAR (rest);
+
+ if ( CONCORD_OBJECT_P (ret) && !EQ (ret, object) )
+ {
+ Lisp_Object ffv;
+
+ ffv = Fconcord_object_get (ret, rev_feature);
+ if (!CONSP (ffv))
+ concord_object_put (ret, rev_feature, list1 (object));
+ else if (NILP (Fmemq (object, ffv)))
+ concord_object_put
+ (ret, rev_feature,
+ nconc2 (Fcopy_sequence (ffv), list1 (object)));
+ Fsetcar (rest, ret);
+ }
+ rest = XCDR (rest);
+ }
+ UNGCPRO;
+ }
return Qt;
}
char* c_obj;
CONCORD_Genre c_genre;
struct gcpro gcpro1, gcpro2;
+ int previous_print_readably;
CHECK_CONCORD_OBJECT (object);
+ previous_print_readably = print_readably;
+ print_readably = 1;
GCPRO1 (object);
obj_string = Fprin1_to_string (XCONCORD_OBJECT_ID(object), Qnil);
UNGCPRO;
+ print_readably = previous_print_readably;
TO_EXTERNAL_FORMAT (LISP_STRING, obj_string,
C_STRING_ALLOCA, c_obj, Qfile_name);
c_genre = XCONCORD_OBJECT_GENRE(object);
return concord_object_spec_closure->spec;
}
+DEFUN ("concord-define-object", Fconcord_define_object, 2, 3, 0, /*
+Define an object of which spec is a set of features SPEC.
+*/
+ (spec, genre, ds))
+{
+ Lisp_Object id = Fcdr (Fassq (Q_id, spec));
+ Lisp_Object obj;
+
+ if (!NILP (id))
+ {
+ Lisp_Object rest = spec;
+ Lisp_Object cell;
+
+ obj = Fconcord_make_object (genre, id, ds);
+ while (!NILP (rest))
+ {
+ cell = Fcar (rest);
+ Fconcord_object_put (obj, Fcar (cell), Fcdr (cell));
+ rest = Fcdr (rest);
+ }
+ return obj;
+ }
+ return Qnil;
+}
+
struct closure_for_each_object
{
Lisp_Object function;
CONCORD_Feature feature,
CONCORD_String value)
{
+ struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object obj, val, ret;
#if 0
Qfile_name),
Qnil, Qnil));
#endif
- obj = Fconcord_make_object (obj,
- for_each_object_closure->genre,
+ GCPRO1 (obj);
+ obj = Fconcord_make_object (for_each_object_closure->genre,
+ obj,
for_each_object_closure->ds);
+ UNGCPRO;
#if 0
val = read_from_c_string (CONCORD_String_data (value),
CONCORD_String_size (value) );
Qfile_name),
Qnil, Qnil));
#endif
+ GCPRO3 (obj, val, ret);
ret = call2 (for_each_object_closure->function, obj, val);
+ UNGCPRO;
for_each_object_closure->ret = ret;
return !NILP (ret);
}
*/
(function, feature, genre, ds))
{
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_CONCORD_DS* lds;
char* genre_name;
CONCORD_Genre c_genre;
for_each_object_closure->genre = genre;
for_each_object_closure->ds = ds;
for_each_object_closure->ret = Qnil;
+ GCPRO4 (for_each_object_closure->function,
+ for_each_object_closure->genre,
+ for_each_object_closure->ds,
+ for_each_object_closure->ret);
concord_feature_foreach_obj_string (c_feature, func_for_each_object);
+ UNGCPRO;
/* return Qt; */
return for_each_object_closure->ret;
}
static int
concord_object_validate (Lisp_Object data, Error_behavior errb)
{
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object retval;
Lisp_Object valw = Qnil;
Lisp_Object genre = Qnil;
Lisp_Object oid = Qnil;
return 0;
}
- if (NILP (Fconcord_make_object (oid, genre, Qnil)))
+ GCPRO3 (genre, oid, retval);
+ retval = Fconcord_make_object (genre, oid, Qnil);
+ UNGCPRO;
+ if (NILP (retval))
{
maybe_signal_simple_error_2 ("No such Concord-object",
oid, genre, Qconcord_object, errb);
static Lisp_Object
concord_object_instantiate (Lisp_Object data)
{
- return Fconcord_make_object (Fplist_get (data, Q_id, Qnil),
- Fplist_get (data, Qgenre, Qnil),
- Qnil);
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object retval;
+
+ GCPRO2 (data, retval);
+ retval = Fconcord_make_object (Fplist_get (data, Qgenre, Qnil),
+ Fplist_get (data, Q_id, Qnil),
+ Qnil);
+ UNGCPRO;
+ return retval;
}
DEFSUBR (Fconcord_decode_object);
DEFSUBR (Fconcord_object_get);
DEFSUBR (Fconcord_object_put);
+ DEFSUBR (Fconcord_define_object);
DEFSUBR (Fconcord_object_spec);
DEFSUBR (Fconcord_foreach_object_in_feature);
}
staticpro (&Vconcord_genre_hash_table);
Vconcord_genre_hash_table
= make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+
+ staticpro (&Vconcord_genre_object_hash_table);
+ Vconcord_genre_object_hash_table
+ = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
}