Things working much better now. assoc works. Currently printing of
string-like-things does not work, but I suspect that's shallow.
This commit is contained in:
parent
02a4bc3e28
commit
9a0f186f29
13 changed files with 400 additions and 38 deletions
|
|
@ -89,7 +89,7 @@ struct pso_pointer lisp_io_out;
|
|||
struct pso_pointer lisp_stdout;
|
||||
|
||||
/**
|
||||
* @brief bound to the Lisp symbol representing C_IO_log in initialisation.
|
||||
* @brief bound to the Lisp symbol representing C_IO_LOG in initialisation.
|
||||
*/
|
||||
struct pso_pointer lisp_io_log;
|
||||
|
||||
|
|
@ -99,6 +99,11 @@ struct pso_pointer lisp_io_log;
|
|||
*/
|
||||
struct pso_pointer lisp_stderr;
|
||||
|
||||
/**
|
||||
* @brief bound to the Lisp symbol representing C_IO_PROMPT in initialisation
|
||||
*/
|
||||
struct pso_pointer lisp_io_prompt;
|
||||
|
||||
/**
|
||||
* Allow a one-character unget facility. This may not be enough - we may need
|
||||
* to allocate a buffer.
|
||||
|
|
@ -147,11 +152,16 @@ 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 );
|
||||
lisp_io_log = c_string_to_lisp_symbol( C_IO_LOG );
|
||||
lisp_io_prompt = c_string_to_lisp_symbol( C_IO_PROMPT );
|
||||
|
||||
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO,
|
||||
0 );
|
||||
debug_print_object( env, DEBUG_IO, 0 );
|
||||
|
||||
env =
|
||||
c_bind( lisp_io_prompt, c_string_to_lisp_string( INITIAL_PROMPT ),
|
||||
env );
|
||||
|
||||
lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ),
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword
|
||||
|
|
@ -367,8 +377,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
|
|||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -33,6 +33,11 @@ extern struct pso_pointer lisp_stdin;
|
|||
extern struct pso_pointer lisp_stdout;
|
||||
extern struct pso_pointer lisp_stderr;
|
||||
|
||||
#define INITIAL_PROMPT L"psse ]"
|
||||
#define C_IO_PROMPT L"*prompt*"
|
||||
|
||||
extern struct pso_pointer lisp_io_prompt;
|
||||
|
||||
URL_FILE *file_to_url_file( FILE * f );
|
||||
wint_t url_fgetwc( URL_FILE * input );
|
||||
wint_t url_ungetwc( wint_t wc, URL_FILE * input );
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <ctype.h>
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
|
|
@ -26,6 +27,7 @@
|
|||
|
||||
#include "io/fopen.h"
|
||||
#include "io/io.h"
|
||||
#include "io/print.h"
|
||||
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
|
|
@ -33,22 +35,26 @@
|
|||
#include "memory/pso2.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/string_ops.h"
|
||||
#include "payloads/character.h"
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/exception.h"
|
||||
#include "payloads/integer.h"
|
||||
|
||||
#include "ops/truth.h"
|
||||
|
||||
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
|
||||
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
|
||||
bool escape );
|
||||
|
||||
struct pso_pointer print_string_like_thing( struct pso_pointer p,
|
||||
URL_FILE *output ) {
|
||||
URL_FILE *output, bool escape ) {
|
||||
switch ( get_tag_value( p ) ) {
|
||||
case KEYTV:
|
||||
url_fputwc( L':', output );
|
||||
break;
|
||||
case STRINGTV:
|
||||
url_fputwc( L'"', output );
|
||||
if ( !escape )
|
||||
url_fputwc( L'"', output );
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
@ -61,18 +67,20 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
|
|||
}
|
||||
|
||||
if ( stringp( p ) ) {
|
||||
url_fputwc( L'"', output );
|
||||
if ( !escape )
|
||||
url_fputwc( L'"', output );
|
||||
}
|
||||
}
|
||||
|
||||
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output ) {
|
||||
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output,
|
||||
bool escape ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if ( consp( p ) ) {
|
||||
for ( ; consp( p ); p = c_cdr( p ) ) {
|
||||
struct pso2 *object = pointer_to_object( p );
|
||||
|
||||
result = in_print( object->payload.cons.car, output );
|
||||
result = in_write( object->payload.cons.car, output, escape );
|
||||
|
||||
if ( exceptionp( result ) )
|
||||
break;
|
||||
|
|
@ -85,7 +93,8 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
|
|||
break;
|
||||
default:
|
||||
url_fputws( L" . ", output );
|
||||
result = in_print( object->payload.cons.cdr, output );
|
||||
result =
|
||||
in_write( object->payload.cons.cdr, output, escape );
|
||||
}
|
||||
}
|
||||
} else {
|
||||
|
|
@ -95,7 +104,18 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
|
|||
return result;
|
||||
}
|
||||
|
||||
struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
||||
/**
|
||||
* This is kind of modelled after the implementation of PRIN* variants on page
|
||||
* 383 of the aluminium book. It is the inner workings of all PRIN* functions.
|
||||
*
|
||||
* @param p pointer to the object to print.
|
||||
* @param output stream to print to.
|
||||
* @param escape if true, print everything so that it can be read by the Lisp
|
||||
* reader; otherwise, print it appropriately for human readers.
|
||||
* @return p on success, exception on failure.
|
||||
*/
|
||||
struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
|
||||
bool escape ) {
|
||||
struct pso2 *object = pointer_to_object( p );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
|
|
@ -107,7 +127,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
|||
break;
|
||||
case CONSTV:
|
||||
url_fputwc( L'(', output );
|
||||
result = print_list_content( p, output );
|
||||
result = print_list_content( p, output, escape );
|
||||
url_fputwc( L')', output );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
|
|
@ -117,7 +137,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
|||
case KEYTV:
|
||||
case STRINGTV:
|
||||
case SYMBOLTV:
|
||||
print_string_like_thing( p, output );
|
||||
print_string_like_thing( p, output, escape );
|
||||
break;
|
||||
case NILTV:
|
||||
url_fputws( L"nil", output );
|
||||
|
|
@ -126,7 +146,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
|||
case WRITETV:
|
||||
url_fwprintf( output, L"<%s stream: ",
|
||||
v == READTV ? "read" : "write" );
|
||||
in_print( object->payload.stream.meta, output );
|
||||
in_write( object->payload.stream.meta, output, escape );
|
||||
url_fputwc( L'>', output );
|
||||
break;
|
||||
case TRUETV:
|
||||
|
|
@ -143,13 +163,19 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
|||
}
|
||||
|
||||
/**
|
||||
* @brief Simple print for bootstrap layer.
|
||||
* This is kind of modelled after the implementation of PRIN* variants on page
|
||||
* 383 of the aluminium book. It is the inner workings of all PRIN* functions.
|
||||
*
|
||||
* @param p pointer to the object to print.
|
||||
* @param stream if a pointer to an open write stream, print to there.
|
||||
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
|
||||
* @param output stream to print to.
|
||||
* @param escape if true, print everything so that it can be read by the Lisp
|
||||
* reader; otherwise, print it appropriately for human readers.
|
||||
* @param nl_before if true, print a newline *before* printing `p`.
|
||||
* @param nl_after if true, print a newline *after* printing `p`; else a space.
|
||||
* @return p on success, exception on failure.
|
||||
*/
|
||||
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
|
||||
struct pso_pointer write( struct pso_pointer p, struct pso_pointer stream,
|
||||
bool escape, bool nl_before, bool nl_after ) {
|
||||
struct pso_pointer result = p;
|
||||
URL_FILE *output = writep( stream )
|
||||
? pointer_to_object( stream )->payload.stream.stream
|
||||
|
|
@ -158,10 +184,38 @@ struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
|
|||
if ( writep( stream ) ) {
|
||||
inc_ref( stream );
|
||||
|
||||
result = in_print( p, output );
|
||||
if ( nl_before )
|
||||
url_fputwc( L'\n', output );
|
||||
|
||||
result = in_write( p, output, true );
|
||||
|
||||
url_fputwc( nl_after ? L'\n' : L' ', output );
|
||||
|
||||
dec_ref( stream );
|
||||
} else {
|
||||
result =
|
||||
make_exception( c_string_to_lisp_string
|
||||
( L"Bad write stream passed to write." ), nil, nil,
|
||||
nil );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief Simple print for bootstrap layer.
|
||||
*
|
||||
* @param p pointer to the object to print.
|
||||
* @param stream if a pointer to an open write stream, print to there.
|
||||
* @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 ) {
|
||||
return write( p, stream, true, true, false );
|
||||
}
|
||||
|
||||
/**
|
||||
* @brief princ is pretty much like print except things are printed `unescaped`
|
||||
*/
|
||||
struct pso_pointer c_princ( struct pso_pointer p, struct pso_pointer stream ) {
|
||||
return write( p, stream, false, true, false );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -13,10 +13,17 @@
|
|||
|
||||
#ifndef __psse_io_print_h
|
||||
#define __psse_io_print_h
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "io/fopen.h"
|
||||
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream );
|
||||
struct pso_pointer c_princ( struct pso_pointer p, struct pso_pointer stream );
|
||||
|
||||
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
|
||||
#define PRINT_VARIANT_PRINT 0
|
||||
#define PRINT_VARIANT_PRIN1 1
|
||||
#define PRINT_VARIANT_PRINC 2
|
||||
|
||||
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
|
||||
bool variant );
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue