305 lines
9 KiB
C
305 lines
9 KiB
C
/**
|
|
* lispops.c
|
|
*
|
|
* List processing operations.
|
|
*
|
|
* The general idea here is that a list processing operation is a
|
|
* function which takes two arguments, both cons_pointers:
|
|
*
|
|
* 1. args, the argument list to this function;
|
|
* 2. env, the environment in which this function should be evaluated;
|
|
*
|
|
* and returns a cons_pointer, the result.
|
|
*
|
|
* They must all have the same signature so that I can call them as
|
|
* function pointers.
|
|
*
|
|
* (c) 2017 Simon Brooke <simon@journeyman.cc>
|
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
|
*/
|
|
|
|
#include <ctype.h>
|
|
#include <stdbool.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
|
|
#include "consspaceobject.h"
|
|
#include "conspage.h"
|
|
#include "equal.h"
|
|
#include "integer.h"
|
|
#include "intern.h"
|
|
#include "lispops.h"
|
|
#include "print.h"
|
|
#include "read.h"
|
|
#include "stack.h"
|
|
|
|
/*
|
|
* also to create in this section:
|
|
* struct cons_pointer lisp_cond( struct cons_pointer args, struct cons_pointer env,
|
|
struct stack_frame* frame);
|
|
* struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env,
|
|
struct stack_frame* frame);
|
|
* struct cons_pointer lisp_mapcar( struct cons_pointer args, struct cons_pointer env,
|
|
struct stack_frame* frame);
|
|
*
|
|
* and others I haven't thought of yet.
|
|
*/
|
|
|
|
/**
|
|
* Implementation of car in C. If arg is not a cons, does not error but returns nil.
|
|
*/
|
|
struct cons_pointer c_car( struct cons_pointer arg) {
|
|
struct cons_pointer result = NIL;
|
|
|
|
if ( consp(arg)) {
|
|
result = pointer2cell( arg).payload.cons.car;
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* Implementation of cdr in C. If arg is not a cons, does not error but returns nil.
|
|
*/
|
|
struct cons_pointer c_cdr( struct cons_pointer arg) {
|
|
struct cons_pointer result = NIL;
|
|
|
|
if ( consp(arg)) {
|
|
result = pointer2cell( arg).payload.cons.cdr;
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* (apply fn args...)
|
|
*
|
|
* I'm now confused about whether at this stage I actually need an apply special form,
|
|
* and if so how it differs from eval.
|
|
*/
|
|
struct cons_pointer lisp_apply( struct cons_pointer args, struct cons_pointer env,
|
|
struct stack_frame* frame) {
|
|
struct cons_pointer result = args;
|
|
|
|
if ( consp( args)) {
|
|
lisp_eval( args, env, frame);
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* (eval s_expr)
|
|
*
|
|
* Special form.
|
|
* If s_expr is a number, NIL, or T, returns s_expr.
|
|
* If s_expr is an unprotected string, returns the value that s_expr is bound
|
|
* to in the evaluation environment (env).
|
|
* If s_expr is a list, expects the car to be something that evaluates to a
|
|
* function or special form.
|
|
* If a function, evaluates all the other top level elements in s_expr and
|
|
* passes them in a stack frame as arguments to the function.
|
|
* If a special form, passes the cdr of s_expr to the special form as argument.
|
|
*/
|
|
struct cons_pointer lisp_eval( struct cons_pointer s_expr, struct cons_pointer env,
|
|
struct stack_frame* previous) {
|
|
struct cons_pointer result = s_expr;
|
|
struct stack_frame* my_frame =
|
|
make_stack_frame( previous, make_cons( s_expr, NIL), env);
|
|
|
|
if ( consp( s_expr)) {
|
|
/* the hard bit. Sort out what function is required and pass the
|
|
* args to it. */
|
|
struct cons_pointer fn_pointer = lisp_eval( c_car( s_expr), env, my_frame);
|
|
struct cons_pointer args = c_cdr( s_expr);
|
|
|
|
if ( specialp( fn_pointer)) {
|
|
struct cons_space_object special = pointer2cell( fn_pointer);
|
|
result = (*special.payload.special.executable)( args, env, previous);
|
|
} else if ( functionp( fn_pointer)) {
|
|
/* actually, this is apply */
|
|
struct cons_space_object function = pointer2cell( fn_pointer);
|
|
struct stack_frame* frame = make_stack_frame( my_frame, args, env);
|
|
|
|
/* the trick: pass the remaining arguments and environment to
|
|
the executable code which is the payload of the function
|
|
object. */
|
|
result = (*function.payload.function.executable)( frame, env);
|
|
free_stack_frame( frame);
|
|
} else if ( stringp( s_expr)) {
|
|
struct cons_pointer canonical = internedp( s_expr, env);
|
|
if ( !nilp( canonical)) {
|
|
result = c_assoc( canonical, env);
|
|
} else {
|
|
struct cons_pointer message =
|
|
c_string_to_lisp_string( "Attempt to value of unbound name.");
|
|
result = lisp_throw( message, my_frame);
|
|
}
|
|
/* the Clojure practice of having a map serve in the function
|
|
* place of an s-expression is a good one and I should adopt it;
|
|
* also if the object is a consp it could be interpretable
|
|
* source code but in the long run I don't want an interpreter,
|
|
* and if I can get away without so much the better. */
|
|
}
|
|
}
|
|
|
|
free_stack_frame( my_frame);
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* (quote a)
|
|
*
|
|
* Special form
|
|
* Returns its argument (strictly first argument - only one is expected but
|
|
* this isn't at this stage checked) unevaluated.
|
|
*/
|
|
struct cons_pointer lisp_quote( struct cons_pointer args, struct cons_pointer env,
|
|
struct stack_frame* frame) {
|
|
return c_car( args);
|
|
}
|
|
|
|
/**
|
|
* (cons a b)
|
|
*
|
|
* Function.
|
|
* Returns a cell constructed from a and b. If a is of type string but its
|
|
* cdr is nill, and b is of type string, then returns a new string cell;
|
|
* otherwise returns a new cons cell.
|
|
*/
|
|
struct cons_pointer lisp_cons(struct stack_frame* frame, struct cons_pointer env) {
|
|
struct cons_pointer car = frame->arg[0];
|
|
struct cons_pointer cdr = frame->arg[1];
|
|
struct cons_pointer result;
|
|
|
|
if ( nilp( car) && nilp( cdr)) {
|
|
return NIL;
|
|
} else if ( stringp( car) && stringp( cdr) &&
|
|
nilp( pointer2cell( car).payload.string.cdr)) {
|
|
result = make_string( pointer2cell( car).payload.string.character, cdr);
|
|
} else {
|
|
result = make_cons( car, cdr);
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* (car s_expr)
|
|
* Returns the first item (head) of a sequence. Valid for cons cells,
|
|
* strings, and TODO read streams and other things which can be considered as sequences.
|
|
*/
|
|
struct cons_pointer lisp_car(struct stack_frame* frame, struct cons_pointer env) {
|
|
struct cons_pointer result = NIL;
|
|
|
|
if ( consp( frame->arg[ 0])) {
|
|
struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
|
|
result = cell.payload.cons.car;
|
|
} else if ( stringp( frame->arg[ 0])) {
|
|
struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
|
|
result = make_string( cell.payload.string.character, NIL);
|
|
} else {
|
|
struct cons_pointer message =
|
|
c_string_to_lisp_string( "Attempt to take CAR/CDR of non sequence");
|
|
result = lisp_throw( message, frame);
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
|
|
/**
|
|
* (cdr s_expr)
|
|
* Returns the remainder of a sequence when the head is removed. Valid for cons cells,
|
|
* strings, and TODO read streams and other things which can be considered as sequences.
|
|
*/
|
|
struct cons_pointer lisp_cdr(struct stack_frame* frame, struct cons_pointer env) {
|
|
struct cons_pointer result = NIL;
|
|
|
|
if ( consp( frame->arg[ 0])) {
|
|
struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
|
|
result = cell.payload.cons.car;
|
|
} else if ( stringp( frame->arg[ 0])) {
|
|
struct cons_space_object cell = pointer2cell( frame->arg[ 0]);
|
|
result = cell.payload.string.cdr;
|
|
} else {
|
|
struct cons_pointer message =
|
|
c_string_to_lisp_string( "Attempt to take CAR/CDR of non sequence");
|
|
result = lisp_throw( message, frame);
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* (assoc key store)
|
|
* Returns the value associated with key in store, or NIL if not found.
|
|
*/
|
|
struct cons_pointer lisp_assoc( struct stack_frame* frame, struct cons_pointer env) {
|
|
return c_assoc( frame->arg[ 0], frame->arg[ 1]);
|
|
}
|
|
|
|
/**
|
|
* (eq a b)
|
|
* Returns T if a and b are pointers to the same object, else NIL
|
|
*/
|
|
struct cons_pointer lisp_eq( struct stack_frame* frame, struct cons_pointer env) {
|
|
return eq( frame->arg[ 0], frame->arg[ 1]) ? TRUE : NIL;
|
|
}
|
|
|
|
/**
|
|
* (eq a b)
|
|
* Returns T if a and b are pointers to structurally identical objects, else NIL
|
|
*/
|
|
struct cons_pointer lisp_equal( struct stack_frame* frame, struct cons_pointer env) {
|
|
return equal( frame->arg[ 0], frame->arg[ 1]) ? TRUE : NIL;
|
|
}
|
|
|
|
/**
|
|
* (read)
|
|
* (read read-stream)
|
|
* Read one complete lisp form and return it. If read-stream is specified and
|
|
* is a read stream, then read from that stream, else stdin.
|
|
*/
|
|
struct cons_pointer lisp_read( struct stack_frame* frame, struct cons_pointer env) {
|
|
FILE* input = stdin;
|
|
|
|
if ( readp( frame->arg[0])) {
|
|
input = pointer2cell( frame->arg[0]).payload.stream.stream;
|
|
}
|
|
|
|
return read( input);
|
|
}
|
|
|
|
/**
|
|
* (print expr)
|
|
* (print expr write-stream)
|
|
* Print one complete lisp form and return NIL. If write-stream is specified and
|
|
* is a write stream, then print to that stream, else stdout.
|
|
*/
|
|
struct cons_pointer lisp_print( struct stack_frame* frame, struct cons_pointer env) {
|
|
FILE* output = stdout;
|
|
|
|
if ( writep( frame->arg[1])) {
|
|
output = pointer2cell( frame->arg[1]).payload.stream.stream;
|
|
}
|
|
|
|
print( output, frame->arg[0]);
|
|
|
|
return NIL;
|
|
}
|
|
|
|
|
|
/**
|
|
* TODO: make this do something sensible somehow.
|
|
*/
|
|
struct cons_pointer lisp_throw( struct cons_pointer message, struct stack_frame* frame) {
|
|
fprintf( stderr, "\nERROR: ");
|
|
print( stderr, message);
|
|
fprintf( stderr, "\n\nAn exception was thrown and I've no idea what to do now\n");
|
|
|
|
exit( 1);
|
|
}
|
|
|