String-like-things are being created and printed correctly; bind is broken.
This commit is contained in:
parent
cf05e30540
commit
ca5671f613
8 changed files with 508 additions and 450 deletions
|
|
@ -36,7 +36,7 @@ bool environment_initialised = false;
|
|||
* @brief Initialise a minimal environment, so that Lisp can be bootstrapped.
|
||||
*
|
||||
* @param node the index of the node we are initialising.
|
||||
* @return struct pso_pointer t on success, else an exception.
|
||||
* @return a proto-environment on success, else an exception.
|
||||
*/
|
||||
|
||||
struct pso_pointer initialise_environment( uint32_t node ) {
|
||||
|
|
@ -85,9 +85,14 @@ struct pso_pointer initialise_environment( uint32_t node ) {
|
|||
}
|
||||
if ( !exceptionp( result ) ) {
|
||||
result = c_bind( c_string_to_lisp_symbol( L"nil" ), nil, nil );
|
||||
debug_print(L"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, 0);
|
||||
debug_print_object( result, DEBUG_BOOTSTRAP, 0);
|
||||
result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
|
||||
|
||||
environment_initialised = true;
|
||||
debug_print(L"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0);
|
||||
debug_print_object( result, DEBUG_BOOTSTRAP, 0);
|
||||
|
||||
debug_print( L"\nEnvironment initialised successfully.\n",
|
||||
DEBUG_BOOTSTRAP, 0 );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
#ifndef __psse_environment_environment_h
|
||||
#define __psse_environment_environment_h
|
||||
|
||||
#include <stdint.h>
|
||||
struct pso_pointer initialise_environment( uint32_t node );
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -35,6 +35,7 @@
|
|||
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
|
|
@ -122,25 +123,32 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
|
|||
lisp_io_in = c_string_to_lisp_symbol(C_IO_IN);
|
||||
lisp_io_out = c_string_to_lisp_symbol(C_IO_OUT);
|
||||
|
||||
env = c_bind( lisp_io_in,
|
||||
make_read_stream( file_to_url_file( stdin ),
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword
|
||||
( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"system:standard input" ) ),
|
||||
nil ) ), env );
|
||||
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO, 0);
|
||||
debug_print_object(env, DEBUG_IO, 0);
|
||||
|
||||
env = c_bind(
|
||||
lisp_io_in,
|
||||
lock_object(make_read_stream(
|
||||
file_to_url_file(stdin),
|
||||
c_cons(c_cons(c_string_to_lisp_keyword(L"url"),
|
||||
c_string_to_lisp_string(L"::system:standard-input")),
|
||||
nil))),
|
||||
env);
|
||||
debug_print_object(env, DEBUG_IO, 0);
|
||||
if (!nilp(env) && !exceptionp(env)) {
|
||||
env = c_bind(lisp_io_out,
|
||||
make_write_stream( file_to_url_file( stdout ),
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword
|
||||
( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"system:standard input" ) ),
|
||||
nil ) ), env );
|
||||
lock_object(make_write_stream(
|
||||
file_to_url_file(stdout),
|
||||
c_cons(c_cons(c_string_to_lisp_keyword(L"url"),
|
||||
c_string_to_lisp_string(
|
||||
L"::system:standard-output")),
|
||||
nil))),
|
||||
env);
|
||||
}
|
||||
|
||||
debug_print( L"Leaving initialise_default_streams; environment is: ", DEBUG_IO, 0);
|
||||
debug_print_object(env, DEBUG_IO, 0);
|
||||
|
||||
return env;
|
||||
}
|
||||
|
||||
|
|
@ -204,20 +212,18 @@ wint_t url_fgetwc( URL_FILE *input ) {
|
|||
break;
|
||||
|
||||
case CFTYPE_CURL: {
|
||||
char *cbuff =
|
||||
calloc( sizeof( wchar_t ) + 2, sizeof( char ) );
|
||||
char *cbuff = calloc(sizeof(wchar_t) + 2, sizeof(char));
|
||||
wchar_t *wbuff = calloc(2, sizeof(wchar_t));
|
||||
|
||||
size_t count = 0;
|
||||
|
||||
debug_print( L"url_fgetwc: about to call url_fgets\n",
|
||||
DEBUG_IO, 0 );
|
||||
debug_print(L"url_fgetwc: about to call url_fgets\n", DEBUG_IO, 0);
|
||||
url_fgets(cbuff, 2, input);
|
||||
debug_print( L"url_fgetwc: back from url_fgets\n",
|
||||
DEBUG_IO, 0 );
|
||||
debug_print(L"url_fgetwc: back from url_fgets\n", DEBUG_IO, 0);
|
||||
int c = (int)cbuff[0];
|
||||
// TODO: risk of reading off cbuff?
|
||||
debug_printf( DEBUG_IO, 0,
|
||||
debug_printf(
|
||||
DEBUG_IO, 0,
|
||||
L"url_fgetwc: cbuff is '%s'; (first) character = %d (%c)\n",
|
||||
cbuff, c, c & 0xf7);
|
||||
/* The value of each individual byte indicates its UTF-8 function,
|
||||
|
|
@ -243,7 +249,8 @@ wint_t url_fgetwc( URL_FILE *input ) {
|
|||
if (count > 1) {
|
||||
url_fgets((char *)&cbuff[1], count, input);
|
||||
}
|
||||
mbstowcs( wbuff, cbuff, 2 ); //(char *)(&input->buffer[input->buffer_pos]), 1 );
|
||||
mbstowcs(wbuff, cbuff,
|
||||
2); //(char *)(&input->buffer[input->buffer_pos]), 1 );
|
||||
result = wbuff[0];
|
||||
|
||||
free(wbuff);
|
||||
|
|
@ -291,9 +298,8 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
if (readp(read_stream)) {
|
||||
result =
|
||||
make_character( url_fgetwc
|
||||
( pointer_to_object_of_size_class( read_stream, 2 )
|
||||
result = make_character(
|
||||
url_fgetwc(pointer_to_object_of_size_class(read_stream, 2)
|
||||
->payload.stream.stream));
|
||||
}
|
||||
|
||||
|
|
@ -313,11 +319,9 @@ 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( r )->payload.stream.stream ) >=
|
||||
0 ) {
|
||||
if (url_ungetwc(
|
||||
(wint_t)(pointer_to_object(c)->payload.character.character),
|
||||
pointer_to_object(r)->payload.stream.stream) >= 0) {
|
||||
result = t;
|
||||
}
|
||||
}
|
||||
|
|
@ -353,9 +357,7 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
|
|||
|
||||
struct pso_pointer add_meta_integer(struct pso_pointer meta, wchar_t *key,
|
||||
long int value) {
|
||||
return
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword( key ), make_integer( value ) ),
|
||||
return c_cons(c_cons(c_string_to_lisp_keyword(key), make_integer(value)),
|
||||
meta);
|
||||
}
|
||||
|
||||
|
|
@ -365,10 +367,9 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key,
|
|||
wchar_t buffer[strlen(value) + 1];
|
||||
mbstowcs(buffer, value, strlen(value) + 1);
|
||||
|
||||
return
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword( key ),
|
||||
c_string_to_lisp_string( buffer ) ), meta );
|
||||
return c_cons(
|
||||
c_cons(c_string_to_lisp_keyword(key), c_string_to_lisp_string(buffer)),
|
||||
meta);
|
||||
}
|
||||
|
||||
struct pso_pointer add_meta_time(struct pso_pointer meta, wchar_t *key,
|
||||
|
|
@ -474,9 +475,7 @@ void collect_meta( struct pso_pointer stream, char *url ) {
|
|||
meta = add_meta_integer(meta, L"group", statbuf.st_gid);
|
||||
}
|
||||
|
||||
meta =
|
||||
add_meta_integer( meta, L"size",
|
||||
( intmax_t ) statbuf.st_size );
|
||||
meta = add_meta_integer(meta, L"size", (intmax_t)statbuf.st_size);
|
||||
|
||||
meta = add_meta_time(meta, L"modified", &statbuf.st_mtime);
|
||||
}
|
||||
|
|
@ -613,8 +612,7 @@ struct pso_pointer lisp_read_char( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer stream_pointer = fetch_arg(frame, 0);
|
||||
if (readp(stream_pointer)) {
|
||||
result =
|
||||
make_string( url_fgetwc( stream_get_url_file( stream_pointer ) ),
|
||||
nil );
|
||||
make_string(url_fgetwc(stream_get_url_file(stream_pointer)), nil);
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
*/
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
|
@ -36,8 +37,34 @@
|
|||
#include "payloads/cons.h"
|
||||
#include "payloads/integer.h"
|
||||
|
||||
#include "ops/truth.h"
|
||||
|
||||
struct pso_pointer in_print(struct pso_pointer p, URL_FILE *output);
|
||||
|
||||
struct pso_pointer print_string_like_thing(struct pso_pointer p,
|
||||
URL_FILE *output) {
|
||||
switch (get_tag_value(p)) {
|
||||
case KEYTV:
|
||||
url_fputwc(L':', output);
|
||||
break;
|
||||
case STRINGTV:
|
||||
url_fputwc(L'"', output);
|
||||
break;
|
||||
}
|
||||
|
||||
if (keywordp(p) || stringp(p) || symbolp(p)) {
|
||||
for (struct pso_pointer cursor = p; !nilp(cursor);
|
||||
cursor = pointer_to_object(cursor)->payload.string.cdr) {
|
||||
url_fputwc(pointer_to_object(cursor)->payload.character.character,
|
||||
output);
|
||||
}
|
||||
}
|
||||
|
||||
if (stringp(p)) {
|
||||
url_fputwc(L'"', output);
|
||||
}
|
||||
}
|
||||
|
||||
struct pso_pointer print_list_content(struct pso_pointer p, URL_FILE *output) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
|
|
@ -60,7 +87,6 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
|
|||
url_fputws(L" . ", output);
|
||||
result = in_print(object->payload.cons.cdr, output);
|
||||
}
|
||||
|
||||
}
|
||||
} else {
|
||||
// TODO: return exception
|
||||
|
|
@ -74,7 +100,8 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
if (object != NULL) {
|
||||
switch ( get_tag_value( p ) ) {
|
||||
uint32_t v = get_tag_value(p);
|
||||
switch (v) {
|
||||
case CHARACTERTV:
|
||||
url_fputwc(object->payload.character.character, output);
|
||||
break;
|
||||
|
|
@ -87,11 +114,23 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
|||
url_fwprintf(output, L"%d",
|
||||
(int64_t)(object->payload.integer.value));
|
||||
break;
|
||||
case TRUETV:
|
||||
url_fputwc( L't', output );
|
||||
case KEYTV:
|
||||
case STRINGTV:
|
||||
case SYMBOLTV:
|
||||
print_string_like_thing(p, output);
|
||||
break;
|
||||
case NILTV:
|
||||
url_fputws(L"nil", output);
|
||||
break;
|
||||
case READTV:
|
||||
case WRITETV:
|
||||
url_fwprintf(output, L"<%s stream: ", v == READTV ? "read" : "write");
|
||||
in_print(object->payload.stream.meta, output);
|
||||
url_fputwc(L'>', output);
|
||||
break;
|
||||
case TRUETV:
|
||||
url_fputwc(L't', output);
|
||||
break;
|
||||
default:
|
||||
// TODO: return exception
|
||||
}
|
||||
|
|
@ -110,17 +149,16 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
|||
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
|
||||
*/
|
||||
struct pso_pointer c_print(struct pso_pointer p, struct pso_pointer stream) {
|
||||
URL_FILE *output = writep( stream ) ?
|
||||
pointer_to_object( stream )->payload.stream.stream :
|
||||
file_to_url_file( stdout );
|
||||
struct pso_pointer result = p;
|
||||
URL_FILE *output = writep(stream)
|
||||
? pointer_to_object(stream)->payload.stream.stream
|
||||
: file_to_url_file(stdout);
|
||||
|
||||
if (writep(stream)) {
|
||||
inc_ref(stream);
|
||||
}
|
||||
|
||||
struct pso_pointer result = in_print( p, output );
|
||||
result = in_print(p, output);
|
||||
|
||||
if ( writep( stream ) ) {
|
||||
dec_ref(stream);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
#define __psse_memory_tags_h
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdint.h>
|
||||
|
||||
#define TAGLENGTH 3
|
||||
|
||||
|
|
@ -71,8 +72,8 @@
|
|||
#define TRUETV 5591636
|
||||
#define VECTORTV 4408662
|
||||
#define VECTORPOINTTV 5264214
|
||||
#define WRITETV 5264214
|
||||
|
||||
#define WRITETV 5526103
|
||||
// 5526103
|
||||
/**
|
||||
* @brief return the numerical value of the tag of the object indicated by
|
||||
* pointer `p`.
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ struct pso_pointer search( struct pso_pointer key,
|
|||
|
||||
if ( consp( store ) ) {
|
||||
for ( struct pso_pointer cursor = store;
|
||||
consp( store ) && found == false; cursor = c_cdr( cursor ) ) {
|
||||
consp( cursor ) && found == false; cursor = c_cdr( cursor ) ) {
|
||||
struct pso_pointer pair = c_car( cursor );
|
||||
|
||||
if ( consp( pair ) && c_equal( c_car( pair ), key ) ) {
|
||||
|
|
|
|||
|
|
@ -58,6 +58,15 @@ void c_repl( ) {
|
|||
struct pso_pointer input_stream = c_assoc( lisp_io_in, env );
|
||||
struct pso_pointer output_stream = c_assoc( lisp_io_out, env );
|
||||
|
||||
if (!readp(input_stream)) {
|
||||
debug_print(L"Invalid read stream: ", DEBUG_IO, 0);
|
||||
debug_print_object(input_stream, DEBUG_IO, 0);
|
||||
}
|
||||
if (!writep(output_stream)) {
|
||||
debug_print(L"Invalid write stream: ", DEBUG_IO, 0);
|
||||
debug_print_object(output_stream, DEBUG_IO, 0);
|
||||
}
|
||||
|
||||
while ( readp( input_stream )
|
||||
&& !url_feof( stream_get_url_file( input_stream ) ) ) {
|
||||
/* bottom of stack */
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) {
|
|||
*/
|
||||
struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
|
||||
char *tag ) {
|
||||
struct pso_pointer pointer = nil;
|
||||
struct pso_pointer pointer = tail;
|
||||
|
||||
if ( check_type( tail, tag ) || nilp( tail ) ) {
|
||||
pointer = allocate( tag, CONS_SIZE_CLASS );
|
||||
|
|
@ -81,7 +81,10 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
|
|||
cell->payload.string.cdr = tail;
|
||||
|
||||
cell->payload.string.hash = calculate_hash( c, tail );
|
||||
debug_dump_object( pointer, DEBUG_ALLOC, 0 );
|
||||
debug_printf( DEBUG_ALLOC, 0,
|
||||
L"Building string-like-thing of type %3.3s: ",
|
||||
cell->header.tag.bytes.mnemonic);
|
||||
debug_print_object(pointer, DEBUG_ALLOC, 0);
|
||||
debug_println(DEBUG_ALLOC);
|
||||
} else {
|
||||
// \todo should throw an exception!
|
||||
|
|
@ -91,6 +94,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
|
|||
tag, tobj->header.tag.bytes.mnemonic );
|
||||
}
|
||||
|
||||
|
||||
return pointer;
|
||||
}
|
||||
|
||||
|
|
@ -138,8 +142,10 @@ struct pso_pointer c_string_to_lisp_string( wchar_t *string ) {
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
|
||||
if ( iswprint( string[i] ) && string[i] != '"' ) {
|
||||
if ( string[i] != '"' ) {
|
||||
result = make_string( string[i], result );
|
||||
} else {
|
||||
result = make_string( L'\\', make_string( string[i], result));
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -157,7 +163,7 @@ struct pso_pointer c_string_to_lisp_symbol( wchar_t *symbol ) {
|
|||
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
|
||||
wchar_t c = towlower( symbol[i] );
|
||||
|
||||
if ( iswalpha( c ) || c == L'-' ) {
|
||||
if ( iswalpha( c ) || c == L'-' || c == L'*') {
|
||||
result = make_symbol( c, result );
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue