.

.editorconfig

@@ -0,0 +1,14 @@
+# http://EditorConfig.org
+
+# top-most EditorConfig file
+root = true
+
+# Unix-style newlines with a newline ending every file
+[*]
+end_of_line = lf
+insert_final_newline = true
+charset = utf-8
+indent_style = space
+indent_size = 2
+trim_trailing_whitespace = true
+

Dockerfile

@@ -0,0 +1,33 @@
+# This image is only intended to run the tests
+
+FROM ubuntu:23.10 AS base
+
+RUN apt-get -qq update &&\
+    apt-get -qq install -y sbcl curl gcc git
+
+WORKDIR /opt
+RUN curl -s 'https://beta.quicklisp.org/quicklisp.lisp' > /opt/quicklisp.lisp
+RUN sbcl --noinform --load /opt/quicklisp.lisp\
+         --eval '(quicklisp-quickstart:install :path "/opt/quicklisp")'\
+         --eval '(sb-ext:quit)'
+
+RUN echo '(load "/opt/quicklisp/setup.lisp")' > /root/.sbclrc
+RUN mkdir -p quicklisp
+RUN mkdir -p /opt/data
+RUN apt-get -qq remove curl -y &&\
+    apt-get -qq autoremove -y &&\
+    apt-get -qq autoclean -y
+
+from base AS build
+
+WORKDIR /opt
+ADD bin quicklisp/local-projects/evl/bin
+ADD src quicklisp/local-projects/evl/src
+ADD test quicklisp/local-projects/evl/test
+ADD evl.asd quicklisp/local-projects/evl
+ADD run-tests.sh quicklisp/local-projects/evl/run-tests.sh
+RUN mkdir -p ~/quicklisp/ && ln -s  /opt/quicklisp/setup.lisp ~/quicklisp/setup.lisp
+
+WORKDIR /opt/quicklisp/local-projects/evl/
+
+CMD ["bash", "./run-tests.sh"]

LICENSE

@@ -0,0 +1,22 @@
+The MIT License (MIT)
+
+Copyright (c) 2024 Anders Hoff
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+

README.md

@@ -0,0 +1 @@
+# EVL - Meta-circular Evaluator

evl.asd

@@ -0,0 +1,15 @@
+(asdf:defsystem #:evl
+  :description "Meta-circular Lisp Evaluator"
+  :version "0.0.1"
+  :author "anders hoff / @inconvergent / inconvergent@gmail.com"
+  :in-order-to ((asdf:test-op (asdf:test-op #:evl/tests)))
+  :licence "MIT" :pathname "src/" :serial nil
+  :components ((:file "packages")
+               (:file "interp")))
+
+(asdf:defsystem #:evl/tests
+  :depends-on (#:evl #:prove #:uiop #:asdf)
+  :version "0.0.1"
+  :perform (asdf:test-op (o s) (uiop:symbol-call ':evl-tests '#:run-tests))
+  :pathname "test/" :serial t
+  :components ((:file "run")))

ex/ex.lisp

@@ -0,0 +1,55 @@
+#!/usr/local/bin/sbcl --script
+
+(load "~/quicklisp/setup.lisp")
+(ql:quickload :evl)
+(in-package :evl)
+
+(defun main ()
+  (let ((kv '((+ . +) (- . -) (/ . /) (* . *)
+              (= . equal) (< . <) (> . >)
+              (1+ . 1+) (1- . 1-)
+              (t . t)
+              (print . print) (list . list)
+              (s . 104) (k . 107))))
+    (labels ((env (x &aux (res (assoc x kv)))
+               (if res (cdr res) (error "EVL: undefined variable: ~a" x))))
+      (print (evl '1 #'env))
+      (print (evl 's #'env))
+      (print (evl '(+ s k) #'env))
+      (print (evl '(list s k) #'env))
+      (print (evl '(progn s k :progn) #'env))
+      (print (evl '(if (< 4 1) 2 3) #'env))
+      (print (evl '(if (< 4 1) 2) #'env))
+      (print (funcall (evl '(lambda (x) x) #'env) 99))
+      (print (evl '((lambda (x) (+ s x -10000)) 888) #'env))
+      (print (evl '((lambda (x y) (+ s x y)) 888 999) #'env))
+      (print (evl '((lambda () 77)) #'env))
+
+      (print (evl '(let ((a 1) (b 20)) (+ a b)) #'env))
+      (print (evl '(let ((a 1) (b 20)) (+ a b) (- a b)) #'env))
+
+      (print (evl '(let ((a 1) (b (1+ a)))
+                     (list a b)) #'env))
+
+      (print (evl '(let ((fx (lambda (x) (+ 1 x))))
+                     (fx (fx 1)))
+                  #'env))
+      ; (print (evl '(let ((fact (lambda (x)
+      ;                             (if (= x 0) 0
+      ;                                 (+ x (fact x))
+      ;                               )
+      ;                                  )))
+      ;                (fact 6)
+      ;                )
+      ;             #'env))
+      ; (labels (
+      ;       (fact (x) (if (= x 0) 1
+      ;                     (* x (fact (1- x)))))
+      ;       )
+      ;   (print (fact 3))
+      ;   )
+
+   )))
+
+(main)
+

run-tests.sh

@@ -0,0 +1,17 @@
+#!/bin/bash
+
+set -e
+sbcl --version
+echo '#### running SBCL tests:'
+touch ./evl.asd
+time sbcl --noinform  --quit \
+     --eval '(ql:quickload :prove)'\
+     --eval '(handler-case (ql:quickload :evl :verbose nil)
+                           (error (c) (format t "STAGE1FAIL: ~a" c)
+                                      (uiop:quit 2)))'\
+     --eval '(handler-case (progn (asdf:test-system :evl))
+                           (error (c) (format t "STAGE2FAIL: ~a" c)
+                                      (uiop:quit 3)))'
+
+cd .. ; touch ./evl.asd
+

src/interp.lisp

@@ -0,0 +1,35 @@
+(in-package :evl)
+
+(defun evl (expr env)
+  "EVL"
+  (labels ((car-is (l s) (and (consp l) (equal (car l) s)))
+           (extend- (env kk vv)
+             (lambda (y) (loop for k in kk and v in vv
+                               if (equal k y) do (return v)
+                               finally (return (funcall env y))))))
+    (cond ((null expr)    nil)
+          ((numberp expr) expr)
+          ((keywordp expr) expr)
+          ((symbolp expr) (funcall env expr))
+          ((car-is expr 'progn)
+           (first (last (mapcar (lambda (e) (evl e env)) (cdr expr)))))
+          ((car-is expr 'if)
+           (destructuring-bind (test then &optional else) (cdr expr)
+             (if (evl test env) (evl then env) (evl else env))))
+          ((car-is expr 'lambda)
+           (destructuring-bind (kk body) (cdr expr)
+             (lambda (&rest vv) (evl body (extend- env kk vv)))))
+          ((car-is expr 'let)
+           (destructuring-bind (vars &rest body) (cdr expr)
+             (evl `((lambda ,(mapcar #'car vars)
+                            (progn ,@body))
+                    ,@(mapcar #'second vars))
+                  env)))
+          ((consp expr)
+           (handler-case
+             (apply (evl (car expr) env)
+                    (mapcar (lambda (x) (evl x env))
+                            (cdr expr)))
+             (error (e) (error "EVL: error at ~a: ~a" expr e))))
+          (t (error "EVL: invalid expression: ~a" expr)))))
+

src/packages.lisp

@@ -0,0 +1,4 @@
+(defpackage #:evl
+  (:use #:common-lisp)
+  (:nicknames #:cl-evl)
+  (:export evl))

test/run.lisp

@@ -0,0 +1,20 @@
+
+(setf prove:*enable-colors* nil)
+(defpackage #:evl-tests (:use #:cl #:prove) (:export #:run-tests))
+(in-package #:evl-tests)
+
+(defun -run-tests (files)
+  (labels ((rel (f) (mapcar (lambda (p) (asdf:system-relative-pathname
+                                          "evl/tests" p))
+                            f)))
+    (loop with fails = 0
+          for f in (rel files)
+          do ;(format t "~&~%starting tests in: ~a~%" (evl:str! f))
+             (unless (prove:run f :reporter :fiveam)
+                     (incf fails))
+             ;(format t "~&done: ~a~%" (evl:str! f))
+          finally (return (unless (< fails 1) (uiop:quit 7))))))
+
+(defun run-tests ()
+  (-run-tests '(#P"test/test-evl.lisp"))
+  )

test/test-evl.lisp

@@ -0,0 +1,7 @@
+(in-package #:evl-tests)
+
+(plan 6)
+
+
+
+(unless (finalize) (error "error in test-evl"))