/** * @brief evaluate a single cond clause; if the test part succeeds return a * pair whose car is t and whose cdr is the value of the action part */ #include "debug.h" #include "memory/node.h" #include "memory/pointer.h" #include "memory/pso2.h" #include "memory/tags.h" #include "ops/progn.h" #include "ops/stack_ops.h" #include "ops/truth.h" #include "payloads/cons.h" #include "payloads/exception.h" /** * if the car of a consp evaluates to non-nil, the clause succeeded and the * cond expression must conclude, even if the result of the clause is nil. * * Therefore this funtion will * @return nil if the test failed; * @return a pair `(t . )` if the test succeeded. */ struct pso_pointer eval_cond_clause( struct pso_pointer clause, struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ) { struct pso_pointer result = nil; #ifdef DEBUG debug_print( L"\n\tCond clause: ", DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 ); debug_println( DEBUG_EVAL); #endif if ( consp( clause ) ) { struct pso_pointer val = eval_form( frame, frame_pointer, c_car( clause ), env ); if ( !c_nilp( val ) ) { result = cons( t, c_progn( frame, frame_pointer, c_cdr( clause ), env ) ); #ifdef DEBUG debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 ); debug_print( L" succeeded; returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); debug_println( DEBUG_EVAL); } else { debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 ); debug_print_object( clause, DEBUG_EVAL, 0 ); debug_print( L" failed.\n", DEBUG_EVAL, 0 ); #endif } } else { result = throw_exception( c_string_to_lisp_symbol( frame_pointer, L"cond" ), c_string_to_lisp_string (frame_pointer, L"Arguments to `cond` must be lists" ), frame_pointer ); } return result; } /** * Special form: conditional. Each `clause` is expected to be a list; if the first * item in such a list evaluates to non-nil, the remaining items in that list * are evaluated in turn and the value of the last returned. If no arg `clause` * has a first element which evaluates to non nil, then nil is returned. * * * (cond clauses...) * * @param frame my stack frame. * @param frame_pointer a pointer to my pso4. * @param env the environment in which arguments will be evaluated. * @return the value of the last expression of the first successful `clause`. */ struct pso_pointer lisp_cond( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ) { struct pso_pointer result = nil; bool done = false; for ( int i = 0; ( i < frame->payload.stack_frame.args ) && !done; i++ ) { struct pso_pointer clause_pointer = fetch_arg( frame, i ); // TODO: WHOOPS! This isn't right. If the test of a cond clause // evaluates to non-nil, but the last form of the clause evaluates // to nil, the form still succeeded and we should still exit `cond`. // result = eval_cond_clause( clause_pointer, frame, frame_pointer, env ); if ( !c_nilp( result ) && c_truep( c_car( result ) ) ) { result = c_cdr( result ); done = true; break; } } #ifdef DEBUG debug_print( L"\tCond returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); debug_println( DEBUG_EVAL); #endif return result; }