Created
September 11, 2012 12:31
-
-
Save fogus/3698078 to your computer and use it in GitHub Desktop.
Guy Steele's FOO language
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; Guy Steele's "FOO" language, as found on the ll1.mit.edu mailing list. | |
;; ---------------------------------------------------------------------- | |
;; [He said..] | |
;; If you speak Common Lisp, you might find the following | |
;; bit of code illuminating. (If you speak Scheme but | |
;; not Common Lisp, then just delete or ignore all occurrences | |
;; of the strings "funcall " and "#'"). | |
;; This is an interpreter for a tiny Scheme-like language | |
;; (I'll call it FOO) with just the following constructs: | |
;; numeric literals | |
;; variable names | |
;; LAMBDA expressions | |
;; IF | |
;; function calls | |
;; and three built-in functions: | |
;; + | |
;; * | |
;; CALL/CC | |
;; (I took the cheesy way out on defining the functions: | |
;; I just made undefined variables evaluate to themselves | |
;; and have the @apply function check for those names. | |
;; That's okay because the data domain of this language | |
;; is just numbers---there aren't any operations on symbols.) | |
;; I spelled the name of each functino with a leading "@" purely | |
;; to avoid conflict with the Common Lisp functions of the | |
;; same name. | |
;; You can evaluate an expression by typing at the Common Lisp | |
;; top level: | |
;; (@eval '<expression> '() #'(lambda (x) x)) | |
;; Note two things about this piece of code: | |
;; (1) Every call from one Common Lisp function to another is | |
;; a tail-call. In other words, in effect I am not using the | |
;; Common Lisp stack at all to keep information about the state | |
;; of the FOO program being interpreted. | |
;; (2) Every LAMBDA expression in the code of the interpreter | |
;; is a continuation: it says what to do next when the call to | |
;; any given @-routine is "finished". | |
;; (3) Every @-routine takes a continuation "cont" and always | |
;; finishes either by calling cont (as a tail-call) or by | |
;; calling another @-routine (as a tail-call). | |
;; If you keep in mind that "#'" means roughly "allocate (in the heap) | |
;; a closure for the following LAMBDA expression" and that a closure can | |
;; refer to lexical variables visible to the LAMBDA expression, you can see | |
;; that one continuation can know about another, which knows about another, | |
;; and so on; this chain is sometimes called the "control stack", but in | |
;; this implementation it's all in the heap. | |
;; Does this help? | |
;; --Guy | |
(defun @eval (exp env cont) | |
(cond ((numberp exp) (funcall cont exp)) | |
((symbolp exp) (@lookup exp env cont)) | |
((eq (first exp) 'LAMBDA) | |
(funcall cont (list 'CLOSURE (second exp) (third exp) env))) | |
((eq (first exp) 'IF) | |
(@eval (second exp) env | |
#'(lambda (test) | |
(@eval (cond (test (second exp)) (t (third exp))) env cont)))) | |
(t (@eval (first exp) env | |
#'(lambda (fn) | |
(@evlis (rest exp) env | |
#'(lambda (args) (@apply fn args cont)))))))) | |
(defun @lookup (name env cont) | |
(cond ((null env) (funcall cont name)) | |
((eq (car (first env)) name) (funcall cont (cdr (first env)))) | |
(t (@lookup name (rest env) cont)))) | |
(defun @evlis (exps env cont) | |
(cond ((null exps) (funcall cont '())) | |
(t (@eval (first exps) env | |
#'(lambda (arg) | |
(@evlis (rest exps) env | |
#'(lambda (args) (funcall cont (cons arg args))))))))) | |
(defun @apply (fn args cont) | |
(cond ((eq fn '+) (funcall cont (+ (first args) (second args)))) | |
((eq fn '*) (funcall cont (* (first args) (second args)))) | |
((eq fn 'call/cc) | |
(@apply (first args) (list (list 'CONTINUATION cont)) cont)) | |
((atom fn) (funcall cont 'UNDEFINED-FUNCTION)) | |
((eq (first fn) 'CLOSURE) | |
(@eval (third fn) (pairlis (second fn) args (fourth fn)) cont)) | |
((eq (first fn) 'CONTINUATION) | |
(funcall (second fn) (first args))) | |
(t (funcall cont 'UNDEFINED-FUNCTION)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment