Work on the 'member?' bug - (issue #8) -- which turns out to be assoc/interned.
Progress has been made, but this is not fixed.
This commit is contained in:
parent
7d0ce67373
commit
dc5cac0bd8
4 changed files with 52 additions and 10 deletions
|
|
@ -191,7 +191,7 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
|
||||||
for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair );
|
for ( struct cons_pointer pair = c_car( assoc ); !nilp( pair );
|
||||||
pair = c_car( assoc ) ) {
|
pair = c_car( assoc ) ) {
|
||||||
/* TODO: this is really hammering the memory management system, because
|
/* TODO: this is really hammering the memory management system, because
|
||||||
* it will make a new lone for every key/value pair added. Fix. */
|
* it will make a new clone for every key/value pair added. Fix. */
|
||||||
if ( consp( pair ) ) {
|
if ( consp( pair ) ) {
|
||||||
mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
|
mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
|
||||||
} else if ( hashmapp( pair ) ) {
|
} else if ( hashmapp( pair ) ) {
|
||||||
|
|
@ -338,6 +338,7 @@ struct cons_pointer search_store( struct cons_pointer key,
|
||||||
result =
|
result =
|
||||||
return_key ? c_car( entry_ptr )
|
return_key ? c_car( entry_ptr )
|
||||||
: c_cdr( entry_ptr );
|
: c_cdr( entry_ptr );
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case HASHTV:
|
case HASHTV:
|
||||||
|
|
@ -426,7 +427,7 @@ struct cons_pointer interned( struct cons_pointer key,
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief Implementation of `interned?` in C: predicate wrapped around interned.
|
* @brief Implementation of `interned?` in C.
|
||||||
*
|
*
|
||||||
* @param key the key to search for.
|
* @param key the key to search for.
|
||||||
* @param store the store to search in.
|
* @param store the store to search in.
|
||||||
|
|
@ -434,7 +435,36 @@ struct cons_pointer interned( struct cons_pointer key,
|
||||||
*/
|
*/
|
||||||
struct cons_pointer internedp( struct cons_pointer key,
|
struct cons_pointer internedp( struct cons_pointer key,
|
||||||
struct cons_pointer store ) {
|
struct cons_pointer store ) {
|
||||||
return nilp( interned( key, store ) ) ? NIL : TRUE;
|
struct cons_pointer result = NIL;
|
||||||
|
|
||||||
|
if ( consp( store ) ) {
|
||||||
|
for ( struct cons_pointer pair = c_car( store ); eq( result, NIL) && !nilp( pair );
|
||||||
|
pair = c_car( store ) ) {
|
||||||
|
if ( consp( pair ) ) {
|
||||||
|
if ( equal( c_car( pair), key)) {
|
||||||
|
// yes, this should be `eq`, but if symbols are correctly
|
||||||
|
// interned this will work efficiently, and if not it will
|
||||||
|
// still work.
|
||||||
|
result = TRUE;
|
||||||
|
}
|
||||||
|
} else if ( hashmapp( pair ) ) {
|
||||||
|
result=internedp( key, pair);
|
||||||
|
}
|
||||||
|
|
||||||
|
store = c_cdr( store );
|
||||||
|
}
|
||||||
|
} else if ( hashmapp( store ) ) {
|
||||||
|
struct vector_space_object *map = pointer_to_vso( store );
|
||||||
|
|
||||||
|
for ( int i = 0; i < map->payload.hashmap.n_buckets; i++ ) {
|
||||||
|
for ( struct cons_pointer c = map->payload.hashmap.buckets[i];
|
||||||
|
!nilp( c ); c = c_cdr( c ) ) {
|
||||||
|
result = internedp( key, c);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
|
||||||
|
|
@ -75,4 +75,7 @@ struct cons_pointer deep_bind( struct cons_pointer key,
|
||||||
struct cons_pointer intern( struct cons_pointer key,
|
struct cons_pointer intern( struct cons_pointer key,
|
||||||
struct cons_pointer environment );
|
struct cons_pointer environment );
|
||||||
|
|
||||||
|
struct cons_pointer internedp( struct cons_pointer key,
|
||||||
|
struct cons_pointer store );
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
|
|
@ -919,17 +919,26 @@ lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
||||||
struct cons_pointer c_keys( struct cons_pointer store ) {
|
struct cons_pointer c_keys( struct cons_pointer store ) {
|
||||||
struct cons_pointer result = NIL;
|
struct cons_pointer result = NIL;
|
||||||
|
|
||||||
if ( hashmapp( store ) ) {
|
if ( consp( store ) ) {
|
||||||
result = hashmap_keys( store );
|
for ( struct cons_pointer pair = c_car( store ); !nilp( pair );
|
||||||
} else if ( consp( store ) ) {
|
pair = c_car( store ) ) {
|
||||||
for ( struct cons_pointer c = store; !nilp( c ); c = c_cdr( c ) ) {
|
if ( consp( pair ) ) {
|
||||||
result = make_cons( c_car( c ), result );
|
result = make_cons( c_car( pair), result);
|
||||||
|
} else if ( hashmapp( pair ) ) {
|
||||||
|
result=c_append( hashmap_keys( pair), result);
|
||||||
|
}
|
||||||
|
|
||||||
|
store = c_cdr( store );
|
||||||
}
|
}
|
||||||
|
} else if ( hashmapp( store ) ) {
|
||||||
|
result = hashmap_keys( store );
|
||||||
}
|
}
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
struct cons_pointer lisp_keys( struct stack_frame *frame,
|
struct cons_pointer lisp_keys( struct stack_frame *frame,
|
||||||
struct cons_pointer frame_pointer,
|
struct cons_pointer frame_pointer,
|
||||||
struct cons_pointer env ) {
|
struct cons_pointer env ) {
|
||||||
|
|
|
||||||
|
|
@ -53,14 +53,14 @@ else
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
||||||
expected='nil'(CDR )
|
expected='nil'
|
||||||
output=`target/psse $1 <<EOF
|
output=`target/psse $1 <<EOF
|
||||||
(progn
|
(progn
|
||||||
(set! nil? (lambda (o) (= (type o) "NIL ")))
|
(set! nil? (lambda (o) (= (type o) "NIL ")))
|
||||||
(set! member?
|
(set! member?
|
||||||
(lambda
|
(lambda
|
||||||
(item collection)
|
(item collection)
|
||||||
(progn (print (list "In member; collection is:" collection)) (println))
|
;; (progn (print (list "In member; collection is:" collection)) (println))
|
||||||
(cond
|
(cond
|
||||||
((nil? collection) nil)
|
((nil? collection) nil)
|
||||||
((= item (car collection)) t)
|
((= item (car collection)) t)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue