Reverse

src/init.c

@@ -95,6 +95,7 @@ int main( int argc, char *argv[] ) {
     bind_function( "oblist", &lisp_oblist );
     bind_function( "print", &lisp_print );
     bind_function( "progn", &lisp_progn );
+    bind_function( "reverse", &lisp_reverse );
     bind_function( "set", &lisp_set );
     bind_function( "subtract", &lisp_subtract );
     bind_function( "type", &lisp_type );

src/memory/consspaceobject.h

@@ -234,6 +234,8 @@
  */
 #define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)||check_tag(conspoint,BIGNUMTAG))
 
+#define sequencep(conspoint) (check_tag(conspoint,CONSTAG)||check_tag(conspoint,STRINGTAG)||check_tag(conspoint,SYMBOLTAG))
+
 /**
  * true if thr conspointer points to a vector pointer.
  */

src/ops/lispops.c

@@ -169,11 +169,13 @@ lisp_nlambda( struct stack_frame *frame, struct cons_pointer env ) {
 }
 
 void log_binding( struct cons_pointer name, struct cons_pointer val ) {
-    print( stderr, c_string_to_lisp_string( "\n\tBinding " ) );
+#ifdef DEBUG
+    fputws( L"\n\tBinding ", stderr );
     print( stderr, name );
-    print( stderr, c_string_to_lisp_string( " to " ) );
+    fputws( L" to ", stderr);
     print( stderr, val );
     fputws( L"\"\n", stderr );
+#endif
 }
 
 /**
@@ -279,8 +281,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
                 struct cons_pointer exep = NIL;
                 struct stack_frame *next =
                     make_stack_frame( frame, args, env, &exep );
+#ifdef DEBUG
                 fputws( L"Stack frame for lambda\n", stderr );
                 dump_frame( stderr, next );
+#endif
                 result = eval_lambda( fn_cell, next, env );
                 if ( exceptionp( result ) ) {
                     /* if we're returning an exception, we should NOT free the
@@ -296,8 +300,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
             {
                 struct stack_frame *next =
                     make_special_frame( frame, args, env );
+#ifdef DEBUG
                 fputws( L"Stack frame for nlambda\n", stderr );
                 dump_frame( stderr, next );
+#endif
                 result = eval_lambda( fn_cell, next, env );
                 if ( !exceptionp( result ) ) {
                     /* if we're returning an exception, we should NOT free the
@@ -376,8 +382,10 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
     struct cons_pointer result = frame->arg[0];
     struct cons_space_object cell = pointer2cell( frame->arg[0] );
 
+#ifdef DEBUG
     fputws( L"Eval: ", stderr );
     dump_frame( stderr, frame );
+#endif
 
     switch ( cell.tag.value ) {
         case CONSTV:
@@ -415,9 +423,11 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
             break;
     }
 
+#ifdef DEBUG
     fputws( L"Eval returning ", stderr );
     print( stderr, result );
     fputws( L"\n", stderr );
+#endif
 
     return result;
 }
@@ -432,17 +442,20 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer env ) {
  */
 struct cons_pointer
 lisp_apply( struct stack_frame *frame, struct cons_pointer env ) {
+#ifdef DEBUG
     fputws( L"Apply: ", stderr );
     dump_frame( stderr, frame );
-
+#endif
     set_reg( frame, 0, make_cons( frame->arg[0], frame->arg[1] ) );
     set_reg( frame, 1, NIL );
 
     struct cons_pointer result = c_apply( frame, env );
 
+#ifdef DEBUG
     fputws( L"Apply returning ", stderr );
     print( stderr, result );
     fputws( L"\n", stderr );
+#endif
 
     return result;
 }
@@ -641,6 +654,40 @@ lisp_read( struct stack_frame *frame, struct cons_pointer env ) {
 }
 
 
+/**
+ * reverse a sequence.
+ */
+struct cons_pointer c_reverse( struct cons_pointer arg) {
+  struct cons_pointer result = NIL;
+
+  for (struct cons_pointer p = arg; sequencep(p); p = c_cdr(p)) {
+    struct cons_space_object o = pointer2cell(p);
+    switch (o.tag.value) {
+      case CONSTV:
+        result = make_cons(o.payload.cons.car, result);
+        break;
+      case STRINGTV:
+        result = make_string(o.payload.string.character, result);
+        break;
+      case SYMBOLTV:
+        result = make_symbol(o.payload.string.character, result);
+        break;
+    }
+  }
+
+  return result;
+}
+
+
+/**
+ * (reverse sequence)
+ * Return a sequence like this sequence but with the members in the reverse order.
+ */
+struct cons_pointer lisp_reverse( struct stack_frame *frame, struct cons_pointer env ) {
+  return c_reverse( frame->arg[0]);
+}
+
+
 /**
  * (print expr)
  * (print expr write-stream)

src/ops/lispops.h

@@ -40,6 +40,7 @@ struct cons_pointer c_car( struct cons_pointer arg );
  */
 struct cons_pointer c_cdr( struct cons_pointer arg );
 
+struct cons_pointer c_reverse( struct cons_pointer arg);
 
 /**
  * Useful building block; evaluate this single form in the context of this
@@ -117,10 +118,12 @@ struct cons_pointer lisp_eq( struct stack_frame *frame,
                              struct cons_pointer env );
 struct cons_pointer lisp_equal( struct stack_frame *frame,
                                 struct cons_pointer env );
-struct cons_pointer lisp_read( struct stack_frame *frame,
-                               struct cons_pointer env );
 struct cons_pointer lisp_print( struct stack_frame *frame,
                                 struct cons_pointer env );
+struct cons_pointer lisp_read( struct stack_frame *frame,
+                               struct cons_pointer env );
+struct cons_pointer lisp_reverse( struct stack_frame *frame,
+                                 struct cons_pointer env );
 /**
  * Function: Get the Lisp type of the single argument.
  * @param frame My stack frame.

src/ops/read.c

@@ -148,6 +148,8 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
       initial = fgetwc( input );
     }
 
+
+
 #ifdef DEBUG
     fwprintf( stderr, L"read_number starting '%c' (%d)\n", initial, initial );
 #endif
@@ -164,7 +166,7 @@ struct cons_pointer read_number( struct stack_frame *frame, FILE * input,
         } else if ( c == btowc( '/' ) ) {
             if ( seen_period || dividend > 0 ) {
                 return make_exception( c_string_to_lisp_string
-                                       ( "Malformed number: dividend must be integer" ),
+                                       ( "Malformed number: dividend of rational must be integer" ),
                                        frame );
             } else {
                 dividend = negative ? 0 - accumulator : accumulator;

unit-tests/add.sh

@@ -23,3 +23,57 @@ else
     exit 1
 fi
 
+expected='1/4'
+actual=`echo "(+ 3/14 1/28)" | 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
+
+# (+ integer ratio) should be ratio
+expected='25/4'
+actual=`echo "(+ 6 1/4)" | 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
+
+# (+ ratio integer) should be ratio
+expected='25/4'
+actual=`echo "(+ 1/4 6)" | 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
+
+# (+ real ratio) should be real
+# for this test, trailing zeros can be ignored
+expected='6.25'
+actual=`echo "(+ 6.000000001 1/4)" |\
+  target/psse 2> /dev/null |\
+  sed 's/0*$//' |\
+  head -2 |\
+  tail -1`
+
+outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
+
+if [ "${outcome}" = "1" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi
+

unit-tests/reverse.sh

@@ -0,0 +1,36 @@
+#!/bin/bash
+
+expected='"god yzal eht revo depmuj xof nworb kciuq ehT"'
+actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | 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='(1024 512 256 128 64 32 16 8 4 2)'
+actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | 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='esrever'
+actual=`echo "(reverse 'reverse)" | 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
+