From b989b5e041fdad13bddef3fa96e3dec473b9d7e9 Mon Sep 17 00:00:00 2001
From: simon <simon@journeyman.cc>
Date: Mon, 16 Oct 2017 12:22:49 +0100
Subject: [PATCH] PROGN working
---
src/init.c | 9 +++++----
src/lispops.c | 31 ++++++++++++++++++++++++++++++-
src/lispops.h | 16 +++++++++++++++-
unit-tests/add.sh | 5 ++---
unit-tests/multiply.sh | 24 ++++++++++++++++++++++++
unit-tests/progn.sh | 24 ++++++++++++++++++++++++
6 files changed, 100 insertions(+), 9 deletions(-)
create mode 100644 unit-tests/multiply.sh
create mode 100644 unit-tests/progn.sh
diff --git a/src/init.c b/src/init.c
index f2a78e3..d4e9dbf 100644
--- a/src/init.c
+++ b/src/init.c
@@ -78,23 +78,24 @@ int main( int argc, char *argv[] ) {
/*
* primitive function operations
*/
+ bind_function( "add", &lisp_add );
+ bind_function( "apply", &lisp_apply );
bind_function( "assoc", &lisp_assoc );
bind_function( "car", &lisp_car );
bind_function( "cdr", &lisp_cdr );
bind_function( "cons", &lisp_cons );
bind_function( "eq", &lisp_eq );
bind_function( "equal", &lisp_equal );
+ bind_function( "multiply", &lisp_multiply );
bind_function( "read", &lisp_read );
bind_function( "print", &lisp_print );
+ bind_function( "progn", &lisp_progn );
+ bind_function( "subtract", &lisp_subtract );
bind_function( "type", &lisp_type );
- bind_function( "add", &lisp_add );
bind_function( "+", &lisp_add );
- bind_function( "multiply", &lisp_multiply );
bind_function( "*", &lisp_multiply );
- bind_function( "subtract", &lisp_subtract );
bind_function( "-", &lisp_subtract );
- bind_function( "apply", &lisp_apply );
/*
* primitive special forms
diff --git a/src/lispops.c b/src/lispops.c
index 1c20529..1866b34 100644
--- a/src/lispops.c
+++ b/src/lispops.c
@@ -366,7 +366,7 @@ lisp_print( struct stack_frame *frame, struct cons_pointer env ) {
/**
- * Get the Lisp type of the single argument.
+ * Function: Get the Lisp type of the single argument.
* @param frame My stack frame.
* @param env My environment (ignored).
* @return As a Lisp string, the tag of the object which is the argument.
@@ -384,6 +384,35 @@ lisp_type( struct stack_frame *frame, struct cons_pointer env ) {
return result;
}
+/**
+ * Function; evaluate the forms which are listed in my single argument
+ * sequentially and return the value of the last. This function is called 'do'
+ * in some dialects of Lisp.
+ *
+ * @param frame My stack frame.
+ * @param env My environment (ignored).
+ * @return the value of the last form on the sequence which is my single
+ * argument.
+ */
+struct cons_pointer
+lisp_progn( struct stack_frame *frame, struct cons_pointer env ) {
+ struct cons_pointer remaining = frame->arg[0];
+ struct cons_pointer result = NIL;
+
+ while ( consp(remaining)) {
+ struct cons_space_object cell = pointer2cell( remaining );
+ struct stack_frame * next = make_empty_frame(frame, env);
+ next->arg[0] = cell.payload.cons.car;
+ inc_ref( next->arg[0] );
+ result = lisp_eval(next, env);
+ free_stack_frame( next);
+
+ remaining = cell.payload.cons.cdr;
+ }
+
+ return result;
+}
+
/**
* TODO: make this do something sensible somehow.
diff --git a/src/lispops.h b/src/lispops.h
index 716fdf6..cbfba60 100644
--- a/src/lispops.h
+++ b/src/lispops.h
@@ -49,7 +49,7 @@ struct cons_pointer lisp_read( struct stack_frame *frame,
struct cons_pointer lisp_print( struct stack_frame *frame,
struct cons_pointer env );
/**
- * Get the Lisp type of the single argument.
+ * Function: Get the Lisp type of the single argument.
* @param frame My stack frame.
* @param env My environment (ignored).
* @return As a Lisp string, the tag of the object which is the argument.
@@ -57,6 +57,20 @@ struct cons_pointer lisp_print( struct stack_frame *frame,
struct cons_pointer
lisp_type( struct stack_frame *frame, struct cons_pointer env );
+
+/**
+ * Function; evaluate the forms which are listed in my single argument
+ * sequentially and return the value of the last. This function is called 'do'
+ * in some dialects of Lisp.
+ *
+ * @param frame My stack frame.
+ * @param env My environment (ignored).
+ * @return the value of the last form on the sequence which is my single
+ * argument.
+ */
+struct cons_pointer
+lisp_progn( struct stack_frame *frame, struct cons_pointer env );
+
/*
* neither, at this stage, really
*/
diff --git a/unit-tests/add.sh b/unit-tests/add.sh
index 552ea8d..ba8e635 100644
--- a/unit-tests/add.sh
+++ b/unit-tests/add.sh
@@ -6,14 +6,13 @@ actual=`echo "(add 2 3)" | target/psse 2> /dev/null | head -2 | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
- exit 0
else
echo "Fail: expected '${expected}', got '${actual}'"
exit 1
fi
-expected='5.5000'
-actual=`echo "(add 2.5 3)" | target/psse 2> /dev/null | head -1`
+expected='5.500000'
+actual=`echo "(add 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1`
if [ "${expected}" = "${actual}" ]
then
diff --git a/unit-tests/multiply.sh b/unit-tests/multiply.sh
new file mode 100644
index 0000000..b9fd5b1
--- /dev/null
+++ b/unit-tests/multiply.sh
@@ -0,0 +1,24 @@
+#!/bin/bash
+
+expected='6'
+actual=`echo "(multiply 2 3)" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+ echo "OK"
+else
+ echo "Fail: expected '${expected}', got '${actual}'"
+ exit 1
+fi
+
+expected='7.500000'
+actual=`echo "(multiply 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+ echo "OK"
+ exit 0
+else
+ echo "Fail: expected '${expected}', got '${actual}'"
+ exit 1
+fi
diff --git a/unit-tests/progn.sh b/unit-tests/progn.sh
new file mode 100644
index 0000000..84921da
--- /dev/null
+++ b/unit-tests/progn.sh
@@ -0,0 +1,24 @@
+#!/bin/bash
+
+expected='5'
+actual=`echo "(progn '((add 2 3)))" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+ echo "OK"
+ exit 0
+else
+ echo "Fail: expected '${expected}', got '${actual}'"
+fi
+
+expected='"foo"'
+actual=`echo "(progn '((add 2.5 3) \"foo\"))" | target/psse 2> /dev/null | head -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+ echo "OK"
+ exit 0
+else
+ echo "Fail: expected '${expected}', got '${actual}'"
+ exit 1
+fi