== Lisp on Printers

Evaluate Lisp forms using printers and print results of them!


=== How to use

Please rewrite the following line in pslisp.ps:
/input_string ((cdr '(Please (write (your favorite program) here!)))) def

Note that PostScript represents string literals with parentheses.
The outermost parenthesis are used for PostScript.


=== Sample Pograms

%% Factorial
/input_string ((begin (define fact (lambda (n) (cond ((= n 0) 1) (#t (* n (fact (- n 1))))))) (fact 10))) def

%% Mini PostScript interpreter
/input_string ((begin (define *environment* nil) (define assoc (lambda (key lst) (cond ((eq? lst nil) nil) ((eq? key (car (car lst))) (car lst)) (#t (assoc key (cdr lst)))))) (define ps_eval (lambda (e stack) (cond ((eq? e 'add) (cons (compute + stack) (cdr (cdr stack)))) ((eq? e 'sub) (cons (compute - stack) (cdr (cdr stack)))) ((eq? e 'mul) (cons (compute * stack) (cdr (cdr stack)))) ((eq? e 'div) (cons (compute / stack) (cdr (cdr stack)))) ((eq? e 'eq) (cond ((compute = stack) (cons 'true (cdr (cdr stack)))) (#t (cons 'false (cdr (cdr stack)))))) ((eq? e 'dup) (cons (car stack) stack)) ((eq? e 'exch) (cons (car (cdr stack)) (cons (car stack) (cdr (cdr stack))))) ((eq? e 'pop) (cdr stack)) ((eq? e 'if) (cond ((eq? (car (cdr stack)) 'true) (ps_eval_seq (car stack) (cdr (cdr stack)))) (#t (cdr (cdr stack))))) ((eq? e 'ifelse) (cond ((eq? (car (cdr (cdr stack))) 'true) (ps_eval_seq (car (cdr stack)) (cdr (cdr (cdr stack))))) (#t (ps_eval_seq (car stack) (cdr (cdr (cdr stack))))))) ((eq? e 'def) (set! *environment* (cons (cons (car (cdr stack)) (car stack)) *environment*)) (cdr (cdr stack))) ((symbol? e) (cond ((eq? (subsym e 0 1) '/) (cons (subsym e 1 0) stack)) (#t (eval_var e stack)))) (#t (cons e stack))))) (define look-up-var (lambda (var) (cdr (assoc var *environment*)))) (define eval_var (lambda (e stack) ((lambda (val) (cond ((eq? val nil) stack) ((eq? (atom? val) #f) (ps_eval_seq val stack)) (#t (cons val stack)))) (look-up-var e)))) (define compute (lambda (fn stack) (fn (car (cdr stack)) (car stack)))) (define postscript (lambda (e) (ps_eval_loop e nil))) (define mark (lambda (e stack) (cond ((eq? (car e) '}) (mark_end (cdr e) stack)) ((eq? (car e) '{) ((lambda (e-stack) (mark (car e-stack) (cdr e-stack))) (mark (cdr e) (cons '{ stack)))) (#t (mark (cdr e) (cons (car e) stack)))))) (define mark_end (lambda (e stack) (mark_end1 e stack nil))) (define mark_end1 (lambda (e stack acc) (cond ((eq? (car stack) '{) (cons e (cons acc (cdr stack)))) (#t (mark_end1 e (cdr stack) (cons (car stack) acc)))))) (define ps_eval_loop (lambda (e stack) (car (ps_eval_seq e stack)))) (define ps_eval_seq (lambda (e stack) (cond ((eq? e nil) stack) ((eq? (car e) '{) ((lambda (e-stack) (ps_eval_seq (car e-stack) (cdr e-stack))) (mark (cdr e) (cons '{ stack)))) (#t (ps_eval_seq (cdr e) (ps_eval (car e) stack)))))) (postscript '( /fact { dup 0 eq { pop 1 } { dup 1 sub fact mul } ifelse } def 10 fact ) ) )) def