I made a small evaluator in TXR Lisp for what appears to be my understanding "Kamby-like" semantics.
$ txr -i kamby.tl
Syntactic toffee recipe: melt butter over low heat, stir in Lisp macros.
1> (kamby-repl)
kmb> (let dz (/ 10 0))
** error: /: division by zero
kmb> (let a 1)
a
kmb> a
1
kmb> (let foo [(let bar1 42) (let bar2 73)])
foo
kmb> foo
#
kmb> foo.bar1
42
kmb> foo.bar2
73
kmb> (set a 4)
4
kmb> a
4
kmb> (set a (* 2 a))
** warning: unbound variable a
** error: unbound variable a
Mostly this was to play with the "construct environment tree as-you-go, with qualified pathname access" idea.
Code:
(defstruct kamby-env ()
bindings ;; assoc list
next-env ;; kamby-env object or nil
(:method extend (me sym value)
(upd me.bindings (acons sym value)))
(:method lookup (me sym)
(assoc sym me.bindings))
(:method delete (me sym)
(let ((binding (assoc sym me.bindings)))
(upd me.bindings (remq binding))))
(:method print (me stream pretty-p)
(format stream "#" 'kamby-env [mapcar car me.bindings])))
(defvar *kamby-env* (new kamby-env))
(defun kamby-error (form fmt . args)
(error `~s: ~s: @fmt` 'kamby-eval (if (atom form) form (car form)) . args))
(defun kamby-eval (form)
(let ((e *kamby-env*))
(match-case form
((let @var @expr) e.(extend var (kamby-eval expr))
var)
((set @var @expr) (let ((binding e.(lookup var)))
(if binding
(rplacd binding (kamby-eval expr))
(kamby-error form "no such variable: ~s" var))
(cdr binding)))
((del @var) (unless e.(delete var)
(kamby-error form "no such variable")))
(@(symbolp @var) (let ((binding e.(lookup var)))
(if binding
(cdr binding)
(kamby-error form "no such variable: ~s" var))))
;; TXR Lisp qref syntax a.b.c.d (qref a b c d)
((qref . @vars) (let (value)
(while vars
(let* ((var (pop vars))
(binding e.(lookup var)))
(unless binding
(kamby-error form "no such variable: ~s (when resolving ~s)" var form))
(set value (cdr binding))
(if (and vars (not (typep value 'kamby-env)))
(kamby-error form "~s isn't an environment object; cannot lookup ~s"
value (car vars)))
(set e value)))
value))
;; TXR Lisp dwim brackets syntax [a b c] (dwim a b c)
((dwim . @forms) (let ((*kamby-env* (new kamby-env next-env e)))
[mapdo kamby-eval forms]
*kamby-env*))
(@else (eval else)))))
(defun kamby-repl ()
(whilet ((line (progn (put-string "kmb> ") (get-line))))
(catch
(prinl (kamby-eval (read line)))
(error (x)
(put-line `** error: @x`)))))