Define defmacro to eval.l

Author: shinh

README.md

@@ -118,6 +118,23 @@ Lisp. You can run the FizzBuzz program like:
 
 This takes very long time. For me, it took 45 minutes.
 
+Though sedlisp.sed does not support defmacro, eval.l also defines
+defmacro:
+
+    $ ./evalify.rb | sed -f sedlisp.sed
+    (defmacro let (l e) (cons (cons lambda (cons (cons (car l) nil) (cons e nil))) (cons (car (cdr l)) nil)))
+    (let (x 42) (+ x 7))  ; Hit ^d after this.
+    ...
+    49
+    $ ./evalify.rb | sed -f sedlisp.sed
+    (defun list0 (a) (cons a nil))
+    (defun cadr (a) (car (cdr a)))
+    (defmacro cond (l) (if l (cons if (cons (car (car l)) (cons (cadr (car l)) (cons (cons (quote cond) (list0 (cdr l))))))) nil))
+    (defun fb (n) (cond (((eq (mod n 5) 0) "Buzz") ((eq (mod n 3) 0) "Fizz") (t n))))
+    (fb 18)  ; Hit ^d after this. This will take about one minute.
+    ...
+    Fizz
+
 Unfortunately, you cannot nest the eval one more time. This is
 probably a limitation of eval.l.
 

eval.l

@@ -18,11 +18,14 @@
 (defun eval-val-1 (v s) (if (eq v NOT-FOUND) (eval-gval s) v))
 (defun eval-val (s) (eval-val-1 (table-get val-table s) s))
 
-(defun eval-if (o s) (if (eq o if) (run-if s) (eval-defun o s)))
+(defun eval-if (o s) (if (eq o if) (run-if s) (eval-defmacro o s)))
+(defun eval-defmacro (o s) (if (eq o defmacro) (run-defmacro s) (eval-defun o s)))
 (defun eval-defun (o s) (if (eq o defun) (run-defun s) (eval-lambda o s)))
 (defun eval-lambda (o s) (if (eq o lambda) (run-lambda s) (eval-quote o s)))
 (defun eval-quote (o s) (if (eq o quote) (run-quote s) (eval-define o s)))
-(defun eval-define (o s) (if (eq o define) (run-define s) (eval-func (eval o) s)))
+(defun eval-define (o s) (if (eq o define) (run-define s) (eval-macro (eval o) s)))
+(defun is-macro (o) (if (atom o) nil (eq (car o) macro)))
+(defun eval-macro (o s) (if (is-macro o) (run-macro (cdr o) s) (eval-func o s)))
 (defun is-func (o) (if (atom o) nil (eq (car o) lambda)))
 (defun eval-func (o s) (if (is-func o) (run-func (cdr o) s) (eval-add o s)))
 (defun eval-add (o s) (if (eq o +) (run-add s) (eval-sub o s)))
@@ -40,6 +43,7 @@
 (defun undefined-func (o) (print (cons o (quote (undefined func)))))
 
 (defun run-if (s) (if (eval (car s)) (eval (cadr s)) (eval (car (cddr s)))))
+(defun run-defmacro (s) (gval-table-add (car s) (cons macro (cdr s))))
 (defun run-defun (s) (gval-table-add (car s) (run-lambda (cdr s))))
 (defun run-lambda (s) (cons lambda s))
 (defun run-quote (s) (car s))
@@ -50,9 +54,16 @@
 
 (defun run-func-2 (a b c) b)
 (defun run-func-1 (v l s) (run-func-2 (set-vals (car l) s) (eval (cadr l)) (define val-table v)))
-;(defun run-func-1 (v l s) (run-func-2 (set-vals (car l) s) (eval (cadr l)) (define val-table v)))
 (defun run-func (l s) (run-func-1 val-table l s))
 
+(defun create-val-table-m (a p) (if a (cons (car a) (cons (car p) (create-val-table-m (cdr a) (cdr p)))) ()))
+(defun set-vals-m (a p) (define val-table (create-val-table-m a p)))
+
+(defun run-macro-2 (a b c) b)
+(defun run-macro-1 (v l s) (run-macro-2 (set-vals-m (car l) s) (eval (cadr l)) (define val-table v)))
+
+(defun run-macro (l s) (eval (run-macro-1 val-table l s)))
+
 (defun run-add (s) (+ (eval (car s)) (eval (cadr s))))
 (defun run-sub (s) (- (eval (car s)) (eval (cadr s))))
 (defun run-mul (s) (* (eval (car s)) (eval (cadr s))))
@@ -122,3 +133,6 @@
 ;(eval (quote (defun func2 (b) (+ (func) b))))
 ;(eval (quote (defun func2 (b) (+ b (func 99)))))
 ;(eval (quote (func2 42)))
+
+(eval (quote (defmacro let (l e) (cons (cons lambda (cons (cons (car l) nil) (cons e nil))) (cons (car (cdr l)) nil)))))
+(eval (quote (let (x 42) x)))

purelisp.rb

@@ -118,8 +118,9 @@ def eval_sexpr(sexpr, vals)
   when 'print'
     raise "invalid print: #{stringify_sexpr(sexpr)}" if args.size != 1
     puts "PRINT: #{stringify_sexpr(args[0])}"
-    p vals
     args[0]
+  else
+    raise "undefined function: #{op}"
   end
 end
 

test.l

@@ -44,7 +44,7 @@
 ;(- 34 7)
 
 ;(if 1 2 3)
-
+1
 (+ 1(+ 1 1))
 
 (+(- 9 2) 1)
@@ -145,3 +145,14 @@ foo
 (defun func (a b) b) ;cont
 (defun func2 (a b) (+ (func 2 3) b)) ;cont
 (func2 99 42)
+
+; TEST EVAL
+
+(defmacro let (l e) (cons (cons lambda (cons (cons (car l) nil) (cons e nil))) (cons (car (cdr l)) nil))) ;cont
+(let (x 42) (+ x 7))
+
+(defun list0 (a) (cons a nil)) ;cont
+(defun cadr (a) (car (cdr a))) ;cont
+(defmacro cond (l) (if l (cons if (cons (car (car l)) (cons (cadr (car l)) (cons (cons (quote cond) (list0 (cdr l))))))) nil)) ;cont
+(defun fb (n) (cond (((eq (mod n 5) 0) Buzz) ((eq (mod n 3) 0) Fizz) (t n)))) ;cont
+(fb 18)

test.rb

@@ -6,6 +6,10 @@
 if ARGV[0] == '-e'
   $evalify = true
   ARGV.shift
+elsif ARGV[0] == '-E'
+  $evalify = true
+  $eval_test_only = true
+  ARGV.shift
 end
 
 ref_lisp = ARGV[0] || 'purelisp.rb'
@@ -38,10 +42,17 @@ def getResult(cmd, line)
     if (/TEST LAMBDA/ =~ line &&
         (ref_lisp == 'rblisp.rb' || test_lisp == 'rblisp.rb'))
       break
+    elsif /TEST EVAL/ =~ line
+      $eval_test = true
+      if !$evalify
+        break
+      end
     end
     next
   end
 
+  next if !$eval_test && $eval_test_only
+
   while line =~ /;cont/
     line.sub!(/;cont/, '')
     line += lines[lineno += 1]
@@ -52,7 +63,7 @@ def getResult(cmd, line)
     line = evalify(line)
   end
 
-  expected = getResult(COMMANDS[ref_lisp], orig)
+  expected = getResult(COMMANDS[ref_lisp], $eval_test ? line : orig)
   expected = expected.lines[-1].chomp
   output = getResult(COMMANDS[test_lisp], line)
   actual = output.lines[-1].chomp