THE CONCATENING
This patch does something I've been dreading since I started: it concatenates
the registers, stack, and heap into one single big-ass array called the store.
This is how the original WAM was laid out (actually the original WAM has
EVERYTHING in one giant block of memory, but let's not get carried away here).
I was hoping I wouldn't have to do this, because the code reads a lot nicer when
these things are separate, but after reading ahead in the book I think I'm
pretty sure it had to be done.
The upside here is that now dereferencing things can be done without caring
where they live -- it's all just pointers into this giant array. For example:
a register could refer to a stack cell, or a heap cell could point at a stack
cell. The downside is that the stack is no longer adjustable (and things are
a bit less safe).
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Sun, 08 May 2016 21:25:08 +0000 |
| parents |
b8bc9b175636 |
| children |
14de0f74d3e2 |
(in-package #:bones.utils)
(defmacro push-if-new (thing place
&environment env
&key key (test '#'eql))
"Push `thing` into the list at `place` if it's not already there.
Returns whether `thing` was actually pushed. This function is basically
`pushnew` except for the return value.
"
(multiple-value-bind (temps exprs stores store-expr access-expr)
(get-setf-expansion place env)
(declare (ignore stores store-expr))
(with-gensyms (current result)
`(let* (,@(zip temps exprs)
(,current ,access-expr)
(,result (pushnew ,thing ,place :key ,key :test ,test)))
(not (eql ,current ,result))))))
(defun invert-hash-table (ht)
"Jesus christ don't actually use this for anything but debugging.
Inverts the keys/values of a hash table.
"
(alist-to-hash-table
(loop :for k :being :the :hash-keys :of ht
:using (hash-value v)
:collect (list v k))))
(defmacro repeat (n &body body)
"Repeat `body` `n` times."
`(dotimes (,(gensym) ,n)
,@body))
(defun hex (d)
(format nil "~X" d))
;;;; Topological Sort
;;; Adapted from the AMOP book to add some flexibility (and remove the
;;; tie-breaker functionality, which we don't need).
(defun topological-sort
(elements constraints &key (key #'identity) (key-test #'eql) (test #'equal))
"Return a topologically sorted list of `elements` given the `constraints`.
`elements` should be a sequence of elements to be sorted.
`constraints` should be a list of `(key . key)` conses where `(foo . bar)`
means element `foo` must precede `bar` in the result.
`key` will be used to turn items in `elements` into the keys in `constraints`.
`key-test` is the equality predicate for keys.
`test` is the equality predicate for (non-keyified) elements.
"
(labels
((minimal-p (element constraints)
;; An element is minimal if there are no other elements that must
;; precede it.
(not (member (funcall key element) constraints
:key #'cdr
:test key-test)))
(in-constraint (val constraint)
;; Return whether val is either part of a constraint.
(or (funcall key-test val (car constraint))
(funcall key-test val (cdr constraint))))
(recur (remaining-constraints remaining-elements result)
(let ((minimal-element
(find-if (lambda (el)
(minimal-p el remaining-constraints))
remaining-elements)))
(if (null minimal-element)
(if (null remaining-elements)
result
(error "Inconsistent constraints."))
(recur (remove (funcall key minimal-element)
remaining-constraints
:test #'in-constraint)
(remove minimal-element remaining-elements :test test)
(cons minimal-element result))))))
(reverse (recur constraints elements (list)))))