Permalink
Browse files

set-macro-character. we're now able to influence the reader from lisp…

… code.
  • Loading branch information...
1 parent 2a66505 commit 2d2ed4ad64ade0c8b233bea444e3f17e4797082f @mishoo committed May 15, 2011
Showing with 87 additions and 22 deletions.
  1. +51 −22 jcls.js
  2. +36 −0 tmp/test.lisp
View
73 jcls.js
@@ -524,7 +524,10 @@ function read(stream, eof_error, eof_value) {
var reader = _READTABLE_.value()[ch], ret;
if (reader) {
stream.next();
- ret = reader(stream, ch);
+ if (reader instanceof Function)
+ ret = reader(stream, ch);
+ else
+ ret = fapply(reader, cons(stream, cons(ch, NIL)));
if (ret == null && !stream.in_list)
// toplevel comment, advance
ret = read(stream, eof_error, eof_value);
@@ -599,7 +602,7 @@ var analyze = (function(){
var func = car(list), args = cdr(list);
if (symbolp(func))
func = _GLOBAL_ENV_.get("f", func);
- return apply(func, args, this);
+ return fapply(func, args, this);
});
CL.defun("APPLY", function(func) {
@@ -616,7 +619,7 @@ var analyze = (function(){
}
if (p) set_cdr(p, last);
else list = last;
- return apply(func, list);
+ return fapply(func, list);
});
{
@@ -1046,15 +1049,15 @@ var analyze = (function(){
// macro?
var mac = $environment.get("m", operator);
if (mac) {
- return analyze(apply(mac($environment), args));
+ return analyze(fapply(mac($environment), args));
}
// otherwise function call
args = maplist(args, analyze);
return function(env) {
var func = env.get("f", operator);
if (!func)
throw new Error("Undefined function: " + write_ast_to_string(operator));
- return apply(func, maplist(args, function(proc){
+ return fapply(func, maplist(args, function(proc){
return proc(env);
}));
};
@@ -1065,35 +1068,35 @@ var analyze = (function(){
body = do_sequence(body);
values = maplist(values, analyze);
return function(env) {
- return apply([ args, body, env ], maplist(values, function(proc){
+ return fapply([ args, body, env ], maplist(values, function(proc){
return proc(env);
}));
};
};
- function apply(func, values) {
- if (func instanceof Function) {
- return func.apply(null, list_to_array(values));
- }
- else if (func instanceof Array) {
- var args = func[0], body = func[1], env = func[2];
- if (!nullp(args)) {
- env = env.fork();
- eachlist(args, function(arg){
- values = arg(env, values);
- });
- }
- return body(env);
- }
- };
-
var $level = 0;
var $environment = _GLOBAL_ENV_;
return analyze;
}());
+function fapply(func, values) {
+ if (func instanceof Function) {
+ return func.apply(null, list_to_array(values));
+ }
+ else if (func instanceof Array) {
+ var args = func[0], body = func[1], env = func[2];
+ if (!nullp(args)) {
+ env = env.fork();
+ eachlist(args, function(arg){
+ values = arg(env, values);
+ });
+ }
+ return body(env);
+ }
+};
+
function eval(ast, env) {
return analyze(ast)(env || _GLOBAL_ENV_);
};
@@ -1241,6 +1244,32 @@ CL.defun(">=", function(last){
return T;
});
+/* -----[ To influence the reader ]----- */
+
+CL.defun("READ-DELIMITED-LIST", function(endchar, stream) {
+ return read_delimited_list(stream, endchar);
+});
+
+CL.defun("GET-MACRO-CHARACTER", function(ch, readtable){
+ if (arguments.length == 1) readtable = _READTABLE_.value();
+ return readtable[ch];
+});
+
+CL.defun("SET-MACRO-CHARACTER", function(ch, func, readtable){
+ if (arguments.length == 2) readtable = _READTABLE_.value();
+ return readtable[ch] = func;
+});
+
+CL.defun("READ", function(stream, eof_error, eof_value){
+ if (arguments.length < 2) eof_error = true;
+ if (arguments.length < 3) eof_value = NIL;
+ return read(stream, eof_error, eof_value);
+});
+
+/* -----[ Math functions ]----- */
+
+
+
/* -----[ temporary stuff ]----- */
JCLS.defun("PRINT", function(){
View
36 tmp/test.lisp
@@ -21,3 +21,39 @@
(jcls:print (eq (gensym) (gensym)))
(jcls:print (gensym))
(jcls:print (gensym))
+
+(let ((a 'G6) ; G6 is the next
+ (b (gensym)))
+ (jcls:print a b (if (eq a b) "same symbol" "not same symbol")))
+
+(defun map (list proc)
+ (if list
+ (cons (funcall proc (car list))
+ (map (cdr list) proc))))
+
+(defun foreach (list proc)
+ (if list
+ (progn
+ (funcall proc (car list))
+ (foreach (cdr list) proc))))
+
+(defun append (a b)
+ (if a
+ (cons (car a) (append (cdr a) b))
+ b))
+
+(defun reduce (list proc init)
+ (if list
+ (reduce (cdr list) proc (funcall proc (car list) init))
+ init))
+
+(defun reverse (list)
+ (reduce list (function cons) nil))
+
+(set-macro-character "]" (get-macro-character ")"))
+(set-macro-character "[" (lambda (stream ch)
+ (reverse (read-delimited-list "]" stream))))
+
+;; now square brackets delimit lists in reverse order
+
+[[2 1 list] jcls:print]

0 comments on commit 2d2ed4a

Please sign in to comment.