43 lines
918 B
Common Lisp
43 lines
918 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 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 (&optional (nv nil))
|
|
(if (eq nv nil)
|
|
value
|
|
(setf value nv))))
|
|
|
|
(defun x-get-var (vf)
|
|
(funcall vf))
|
|
|
|
(defun x-put-var (vf value)
|
|
(funcall vf value))
|
|
|
|
(defun make-var (val)
|
|
(let ((var (list val)))
|
|
#'(lambda (fn)
|
|
(funcall fn var))))
|
|
|
|
(defun get-var (vf)
|
|
(funcall vf #'(lambda (x) (car x))))
|
|
|
|
(defun set-var (vf nv)
|
|
(funcall vf #'(lambda (x) (setf (car x) nv))))
|