Skip to content
Browse files

prettify quote output

  • Loading branch information...
1 parent 06bb2bb commit fd5de4780b0af1a4b1f4f35295fba53588ad3c30 @cpylua committed Apr 21, 2012
Showing with 72 additions and 11 deletions.
  1. +5 −8 README.md
  2. +19 −0 test/quote-test.scm
  3. +48 −3 write.c
View
13 README.md
@@ -30,13 +30,10 @@ character, pair, vector
Install:
---------
-`$ make`
-`$ sudo make install`
-`$ asc`
-
-Uninstall:
------------
-`$ make uninstall`
+`$ make
+$ sudo make install
+$ asc`
+If you don't like it, `$ sudo make uninstall`
Documentation:
--------------
@@ -70,7 +67,7 @@ Todo list:
+ command line options **[DONE]**
+ make install **[DONE]**
+ add case, do **[DONE]**
-+ prettify quote output
++ prettify quote output **[DONE]**
+ stream support
Thanks for *Peter Michaux's* excellent
View
19 test/quote-test.scm
@@ -0,0 +1,19 @@
+(display-line `(list ,(+ 1 2) 4))
+
+(display-line
+ (let ((name 'a))
+ `(list ,name ',name)))
+
+(display-line `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
+
+(display-line `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
+
+(display-line `(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8))
+
+(display-line `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
+
+(display-line
+ (let ((name1 'x)
+ (name2 'y))
+ `(a `(b ,,name1 ,',name2 d) e)))
+
View
51 write.c
@@ -3,6 +3,7 @@
#include "object.h"
#include "write.h"
#include "log.h"
+#include "sform.h"
static int write_character(FILE *out, object *val) {
char v = obj_cv(val);
@@ -117,6 +118,45 @@ int write_vector(FILE *out, object *obj) {
return 0;
}
+static int is_quote(object *val) {
+ return car(val) == get_quote_symbol();
+}
+
+static int is_quasiquote(object *val) {
+ return car(val) == get_quasiquote_symbol();
+}
+
+static int is_unquote(object *val) {
+ return car(val) == get_unquote_symbol();
+}
+
+static int is_unquotesplicing(object *val) {
+ return car(val) == get_unquotesplicing_symbol();
+}
+
+static object* handle_quote(FILE *out, object *val) {
+ object *ret = val;
+ /* successive quotes needs a loop to remove them all */
+ for (;;) {
+ if (is_quote(ret)) {
+ ret = cadr(ret);
+ fprintf(out, "'");
+ } else if (is_quasiquote(ret)) {
+ ret = cadr(ret);
+ fprintf(out, "`");
+ } else if (is_unquote(ret)) {
+ ret = cadr(ret);
+ fprintf(out, ",");
+ } else if (is_unquotesplicing(ret)) {
+ ret = cadr(ret);
+ fprintf(out, ",@");
+ } else {
+ break;
+ }
+ }
+ return ret;
+}
+
int sc_write(FILE *out, object *val) {
int ret = 0;
@@ -139,9 +179,14 @@ int sc_write(FILE *out, object *val) {
} else if (is_empty_list(val)) {
fprintf(out, "%s", "()");
} else if (is_pair(val)) {
- fprintf(out, "(");
- ret = write_pair(out, val);
- fprintf(out, ")");
+ val = handle_quote(out, val);
+ if (is_pair(val)) {
+ fprintf(out, "(");
+ ret = write_pair(out, val);
+ fprintf(out, ")");
+ } else {
+ sc_write(out, val);
+ }
} else if (is_vector(val)) {
fprintf(out, "#(");
ret = write_vector(out, val);

0 comments on commit fd5de47

Please sign in to comment.
Something went wrong with that request. Please try again.