Working on eval/apply. Unfinished, does not build. More significantly,
as the focus ot this prototype is supposed to be building things in Lisp, I've started deliberately copying stuff that mostly works directly from the 0.0.6 branch into this branch. After all, if it's going to be replaced in Lisp, it doesn't have to be the most elegant C.
This commit is contained in:
parent
63906fe817
commit
f7eabb9b62
10 changed files with 1730 additions and 134 deletions
|
|
@ -371,8 +371,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
|
|||
struct pso_pointer result = nil;
|
||||
if ( characterp( c ) && readp( r ) ) {
|
||||
if ( url_ungetwc( ( wint_t )
|
||||
( pointer_to_object( c )->payload.
|
||||
character.character ),
|
||||
( pointer_to_object( c )->payload.character.
|
||||
character ),
|
||||
pointer_to_object( r )->payload.stream.stream ) >=
|
||||
0 ) {
|
||||
result = t;
|
||||
|
|
@ -399,8 +399,8 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer result = nil;
|
||||
if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) {
|
||||
if ( url_fclose
|
||||
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
|
||||
stream.stream )
|
||||
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.
|
||||
stream )
|
||||
== 0 ) {
|
||||
result = t;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -173,11 +173,10 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
|
|||
debug_printf( DEBUG_ALLOC, 0,
|
||||
L"\nIncremented object of type %3.3s, size class %d, "
|
||||
L"at page %u, offset %u to count %u", ( ( char * )
|
||||
&( object->
|
||||
header.
|
||||
tag.bytes.
|
||||
mnemonic
|
||||
[0] ) ),
|
||||
&
|
||||
( object->header.tag.
|
||||
bytes.mnemonic
|
||||
[0] ) ),
|
||||
( int ) object->header.tag.bytes.size_class,
|
||||
pointer.page, pointer.offset, object->header.count );
|
||||
if ( vectorpointp( pointer ) ) {
|
||||
|
|
|
|||
|
|
@ -125,8 +125,8 @@ struct pso_pointer assoc(
|
|||
struct pso_pointer key = fetch_arg( frame, 0 );
|
||||
struct pso_pointer store = or( make_frame( 2, frame_pointer,
|
||||
fetch_arg( frame, 1 ),
|
||||
frame->payload.stack_frame.
|
||||
env ) );
|
||||
frame->payload.
|
||||
stack_frame.env ) );
|
||||
|
||||
return c_assoc( key, store );
|
||||
}
|
||||
|
|
@ -147,8 +147,8 @@ struct pso_pointer interned(
|
|||
struct pso_pointer key = fetch_arg( frame, 0 );
|
||||
struct pso_pointer store = or( make_frame( 2, frame_pointer,
|
||||
fetch_arg( frame, 1 ),
|
||||
frame->payload.stack_frame.
|
||||
env ) );
|
||||
frame->payload.
|
||||
stack_frame.env ) );
|
||||
|
||||
return c_interned( key, store );
|
||||
}
|
||||
|
|
@ -169,8 +169,8 @@ struct pso_pointer internedp(
|
|||
struct pso_pointer key = fetch_arg( frame, 0 );
|
||||
struct pso_pointer store = or( make_frame( 2, frame_pointer,
|
||||
fetch_arg( frame, 1 ),
|
||||
frame->payload.stack_frame.
|
||||
env ) );
|
||||
frame->payload.
|
||||
stack_frame.env ) );
|
||||
|
||||
return c_internedp( key, store ) ? t : nil;
|
||||
}
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -16,8 +16,10 @@
|
|||
#include "memory/pointer.h"
|
||||
#include "memory/pso.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/stack_ops.h"
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/exception.h"
|
||||
#include "payloads/psse_string.h"
|
||||
|
|
@ -25,6 +27,63 @@
|
|||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
||||
struct pso_pointer reverse( struct pso_pointer frame_pointer ) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso_pointer sequence =
|
||||
fetch_arg( pointer_to_pso4( frame_pointer ), 0 );
|
||||
for ( struct pso_pointer cursor = sequence; !c_nilp( sequence );
|
||||
cursor = c_cdr( cursor ) ) {
|
||||
struct pso2 *object = pointer_to_object( cursor );
|
||||
switch ( get_tag_value( cursor ) ) {
|
||||
case CONSTV:
|
||||
result = push_local( frame_pointer,
|
||||
make_cons( frame_pointer, c_car( cursor ),
|
||||
result ) );
|
||||
break;
|
||||
case KEYTV:
|
||||
result = push_local( frame_pointer,
|
||||
make_string_like_thing( frame_pointer,
|
||||
object->payload.
|
||||
string.character,
|
||||
result,
|
||||
KEYTAG ) );
|
||||
break;
|
||||
case STRINGTV:
|
||||
result = push_local( frame_pointer,
|
||||
make_string_like_thing( frame_pointer,
|
||||
object->payload.
|
||||
string.character,
|
||||
result,
|
||||
STRINGTAG ) );
|
||||
break;
|
||||
case SYMBOLTV:
|
||||
result = push_local( frame_pointer,
|
||||
make_string_like_thing( frame_pointer,
|
||||
object->payload.
|
||||
string.character,
|
||||
result,
|
||||
SYMBOLTAG ) );
|
||||
break;
|
||||
default:
|
||||
result = push_local( frame_pointer,
|
||||
make_exception( make_frame
|
||||
( 1, frame_pointer,
|
||||
make_cons
|
||||
( frame_pointer,
|
||||
c_string_to_lisp_string
|
||||
( frame_pointer,
|
||||
L"Invalid object in sequence" ),
|
||||
cursor ) ) ) );
|
||||
goto exit;
|
||||
break;
|
||||
}
|
||||
}
|
||||
exit:
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief reverse a sequence.
|
||||
*
|
||||
|
|
@ -37,49 +96,11 @@
|
|||
*/
|
||||
struct pso_pointer c_reverse( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer sequence ) {
|
||||
// todo: issue #21: must have stack frame passed in.
|
||||
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
for ( struct pso_pointer cursor = sequence; !c_nilp( sequence );
|
||||
cursor = c_cdr( cursor ) ) {
|
||||
struct pso2 *object = pointer_to_object( cursor );
|
||||
switch ( get_tag_value( cursor ) ) {
|
||||
case CONSTV:
|
||||
result = make_cons( frame_pointer, c_car( cursor ), result );
|
||||
break;
|
||||
case KEYTV:
|
||||
// TODO: should you be able to reverse keywords and symbols?
|
||||
result =
|
||||
make_string_like_thing( frame_pointer,
|
||||
object->payload.string.character,
|
||||
result, KEYTAG );
|
||||
break;
|
||||
case STRINGTV:
|
||||
result =
|
||||
make_string_like_thing( frame_pointer,
|
||||
object->payload.string.character,
|
||||
result, STRINGTAG );
|
||||
break;
|
||||
case SYMBOLTV:
|
||||
// TODO: should you be able to reverse keywords and symbols?
|
||||
result =
|
||||
make_string_like_thing( frame_pointer,
|
||||
object->payload.string.character,
|
||||
result, SYMBOLTAG );
|
||||
break;
|
||||
default:
|
||||
result =
|
||||
make_exception( make_frame( 1, frame_pointer,
|
||||
make_cons( frame_pointer,
|
||||
c_string_to_lisp_string
|
||||
( frame_pointer,
|
||||
L"Invalid object in sequence" ),
|
||||
cursor ) ) );
|
||||
goto exit;
|
||||
break;
|
||||
}
|
||||
if ( stackp( frame_pointer ) ) {
|
||||
result = reverse( frame_pointer );
|
||||
}
|
||||
exit:
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -71,9 +71,8 @@ struct pso_pointer push_local( struct pso_pointer frame_pointer,
|
|||
if ( stackp( frame_pointer ) ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
|
||||
struct pso_pointer l =
|
||||
make_cons( frame_pointer, local,
|
||||
frame->payload.stack_frame.locals );
|
||||
struct pso_pointer l = make_cons( frame_pointer, local,
|
||||
frame->payload.stack_frame.locals );
|
||||
frame->payload.stack_frame.locals = l;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -181,8 +181,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
|
|||
int i = 0;
|
||||
for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) {
|
||||
buffer[i++] =
|
||||
( wchar_t ) ( pointer_to_object( c )->payload.string.
|
||||
character );
|
||||
( wchar_t ) ( pointer_to_object( c )->payload.
|
||||
string.character );
|
||||
}
|
||||
|
||||
mbstate_t ps;
|
||||
|
|
|
|||
|
|
@ -194,8 +194,8 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer
|
|||
struct pso_pointer arg_length =
|
||||
length( make_frame( 1, previous, argvalues ) );
|
||||
int arg_count =
|
||||
integerp( arg_length ) ? pointer_to_object( arg_length )->payload.
|
||||
integer.value : 0;
|
||||
integerp( arg_length ) ? pointer_to_object( arg_length )->
|
||||
payload.integer.value : 0;
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_ALLOC, 0,
|
||||
L"\nAllocating stack frame with %d arguments at page %d, "
|
||||
|
|
@ -253,8 +253,8 @@ struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
|
|||
struct pso_pointer argvalues ) {
|
||||
return make_frame_with_arglist_and_env( previous, argvalues,
|
||||
pointer_to_pso4
|
||||
( previous )->payload.
|
||||
stack_frame.env );
|
||||
( previous )->payload.stack_frame.
|
||||
env );
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue