cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

compile recursively

Browse source
This commit is contained in:
Helmut Merz 2024-04-29 15:28:16 +02:00
parent 27fb32feb2
commit 53a999bb38
1 changed files with 13 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
forge/forge.lisp
View file

@ -29,24 +29,20 @@
(defun exec (fe code)
(dolist (x code)
(typecase x
(symbol (funcall (find-word (vocabulary fe) x) fe))
(symbol (funcall (comp1 fe x) fe))
(compiled-function (funcall x fe))
(t (pushd fe x)))))
(defun register (voc key fn)
(let ((k (if (symbolp key) (symbol-name key) key)))
(setf (gethash (string-downcase k) voc) fn)))
(defun find-word (vocab key)
(let ((k (string-downcase (symbol-name key))) (result nil))
(dolist (voc vocab)
(let ((v (gethash k voc)))
(if v (return v))))))
(defun repl (fe)
(do ((input (read-line) (read-line))) ((string= input "q") nil)
(exec-str fe input)))
(defun find-word (fe key)
(let ((k (string-downcase (symbol-name key))))
(dolist (voc (vocabulary fe))
(let ((v (gethash k voc)))
(if v (return v))))))
(defun comp (fe inp)
(let ((code nil))
(dolist (item inp)
@ -54,11 +50,15 @@
(reverse code)))
(defun comp1 (fe item)
(format t "~%item: ~a" item)
(typecase item
(symbol (find-word (vocabulary fe) item))
(symbol (find-word fe item))
(cons (comp fe item))
(t item)))
(defun register (voc key fn)
(let ((k (if (symbolp key) (symbol-name key) key)))
(setf (gethash (string-downcase k) voc) fn)))
; built-in primitives
(defun reg-b (key fn) (register *builtins* key fn))