74 lines
2.5 KiB
C
74 lines
2.5 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( L"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, L"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, L"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( L"Mapcar returning: ", DEBUG_EVAL, 0 );
|
|
debug_print_object( result, DEBUG_EVAL, 0 );
|
|
debug_println( DEBUG_EVAL );
|
|
|
|
return result;
|
|
}
|