65 lines
2 KiB
C
65 lines
2 KiB
C
/**
|
|
* ops/mapcar.c
|
|
*
|
|
* Post Scarcity Software Environment: mapcar.
|
|
*
|
|
* map a function across a sequence of forms.
|
|
*
|
|
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
|
*/
|
|
|
|
#include "debug.h"
|
|
|
|
#include "memory/node.h"
|
|
#include "memory/pointer.h"
|
|
#include "memory/pso.h"
|
|
#include "memory/pso4.h"
|
|
#include "memory/tags.h"
|
|
|
|
#include "ops/eval_apply.h"
|
|
#include "ops/reverse.h"
|
|
#include "payloads/stack.h"
|
|
#include "ops/truth.h"
|
|
|
|
#include "payloads/cons.h"
|
|
|
|
struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
|
|
struct pso_pointer result = nil;
|
|
struct pso4* frame = pointer_to_pso4(frame_pointer);
|
|
debug_print( U"Mapcar: ", DEBUG_EVAL, 0 );
|
|
debug_dump_object( frame_pointer, DEBUG_EVAL, 0 );
|
|
int i = 0;
|
|
|
|
for ( struct pso_pointer c = frame->payload.stack_frame.arg[1]; c_truep( c );
|
|
c = c_cdr( c ) ) {
|
|
struct pso_pointer expr =
|
|
push_local( frame_pointer,
|
|
make_cons( frame_pointer, frame->payload.stack_frame.arg[0],
|
|
make_cons( frame_pointer, c_car( c ), nil ) ) );
|
|
|
|
debug_printf( DEBUG_EVAL, 0, U"Mapcar %d, evaluating ", i );
|
|
debug_print_object( expr, DEBUG_EVAL, 0 );
|
|
debug_println( DEBUG_EVAL);
|
|
|
|
struct pso_pointer r = lisp_eval( push_local( frame_pointer, make_frame(1, frame_pointer, expr)));
|
|
|
|
if ( exceptionp( r ) ) {
|
|
result = r;
|
|
break;
|
|
} else {
|
|
result = push_local( frame_pointer, make_cons( frame_pointer, r, result ));
|
|
}
|
|
debug_printf( DEBUG_EVAL, 0, U"Mapcar %d, result is ", i++ );
|
|
debug_print_object( result, DEBUG_EVAL, 0 );
|
|
debug_println( DEBUG_EVAL);
|
|
}
|
|
|
|
result = consp( result ) ? c_reverse( frame_pointer, result ) : result;
|
|
|
|
debug_print( U"Mapcar returning: ", DEBUG_EVAL, 0 );
|
|
debug_print_object( result, DEBUG_EVAL, 0 );
|
|
debug_println( DEBUG_EVAL );
|
|
|
|
return result;
|
|
}
|