41 lines
901 B
Common Lisp
41 lines
901 B
Common Lisp
;;; cl-scopes/scratch - interactive testing
|
|
|
|
(asdf:load-system :scopes)
|
|
|
|
(in-package :cl-user)
|
|
(ext:add-package-local-nickname :scf :scopes/forge)
|
|
(ext:add-package-local-nickname :sctf :scopes/test-forge)
|
|
|
|
(scopes/test-forge:run)
|
|
|
|
|
|
;;; real scratch area
|
|
|
|
(defun make-iter ()
|
|
(let ((pointers (vector nil nil nil)))
|
|
#'(lambda (fn)
|
|
(funcall fn pointers))))
|
|
|
|
(defun iter-current (it)
|
|
(funcall it #'(lambda (p) (car (svref p 0)))))
|
|
|
|
(defun classes ()
|
|
(let ((r nil))
|
|
(maphash #'(lambda (k v)
|
|
(setf r (cons k r))) si:*class-name-hash-table*)
|
|
(sort r #'(lambda (x y)
|
|
(string<= (package-name (symbol-package x))
|
|
(package-name (symbol-package y)))))))
|
|
|
|
(defun x-make-var (value)
|
|
#'(lambda (nv)
|
|
(if (null nv)
|
|
value
|
|
(setf value nv))))
|
|
|
|
(defun x-get-var (vf)
|
|
(funcall vf nil))
|
|
|
|
(defun x-put-var (vf value)
|
|
(funcall vf value))
|
|
|