Commit a7302be0 authored by Dave Cooper's avatar Dave Cooper

Various cleanups in preparation for re-introduction into Quicklisp.

parent a0e77fdb
......@@ -4,7 +4,7 @@
"The Gendl® Base Core Kernel Engine" :author
"Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20170524" :depends-on (:bordeaux-threads)
:version "20170524" :depends-on ()
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
......
(:bordeaux-threads)
\ No newline at end of file
()
\ No newline at end of file
......@@ -159,7 +159,7 @@ with <tt>:sequence (:size ...))</tt>), elements can be surgically inserted and d
:child-types)
:computed-slots
((lock (bt:make-lock))
((lock (glisp:make-lock))
(ht (progn (the :child-types)
;;
......@@ -204,7 +204,7 @@ with <tt>:sequence (:size ...))</tt>), elements can be surgically inserted and d
re-evaluates the expression to compute the original list of indices)"
reset!
()
(progn ;;bt:with-lock-held ((the lock))
(glisp:with-lock-held ((the lock))
(the (restore-slot-default! :element-index-list))
(the (restore-slot-default! :ht))))
......@@ -237,7 +237,7 @@ re-evaluates the expression to compute the original list of indices)"
:arguments (index \"Integer, Symbol, or other object matching with <tt>eql</tt>. The identifier used when the element was initialized or inserted.\")"
delete!
(index)
(bt:with-lock-held ((the lock))
(glisp:with-lock-held ((the lock))
(the (:set-slot! :ht (the :ht) :remember? nil))
(remhash index (the ht))
(the (:modify-attribute! :element-index-list
......@@ -256,7 +256,7 @@ re-evaluates the expression to compute the original list of indices)"
(gethash index (the ht))
(declare (ignore value))
(if (not found?)
(bt:with-lock-held ((the lock))
(glisp:with-lock-held ((the lock))
(setf (gethash index (the ht)) nil)
(the (set-slot! :ht (the ht) :remember? nil))
(the (set-slot! :element-index-list
......
......@@ -424,47 +424,6 @@ reading from databases or external files). Defaults to nil.\")"
(dolist (reset *leaf-resets*)
(the-object (first reset) (evaluate (second reset))))))))
;;
;; FLAG -- remove this defunct version.
;;
#+nil
("NIL. Restores the value of the given slot to its default, thus ``undoing'' any forcibly set value
in the slot. Any dependent slots in the tree will respond accordingly when they are next demanded.
Note that the slot must be specified as a keyword symbol (i.e. prepended with a colon (``:'')),
otherwise it will be evaluated as a variable according to normal Lisp functional evaluation rules.
:arguments (slot \"Keyword Symbol\")
:key (force? \"Boolean. Specify as t if you want to force non-settable slots to recompute (e.g.
reading from databases or external files). Defaults to nil.\")"
restore-slot-default!
(attribute &key (force? *force-restore-slot-default?*))
(bt:with-lock-held (*binding-lock*)
(when (or force? (eql (the (slot-status attribute)) :set))
(let (*leaf-resets*)
(let ((slot (glisp:intern (symbol-name attribute) :gdl-acc)))
(unless (eq (first (ensure-list (slot-value self slot))) 'gdl-rule::%unbound%)
(unbind-dependent-slots self slot)
(setf (slot-value self slot)
(if *remember-previous-slot-values?*
(list 'gdl-rule::%unbound% nil nil (first (slot-value self slot)))
'gdl-rule::%unbound%))))
(let ((root (the :root))
(root-path (remove :root-object-object (the root-path)))
;;(root-path (the root-path))
)
;;
;; FLAG -- this pushnew should never be necessary...
;;
(pushnew (list root-path)
(gdl-acc::%version-tree% root) :test #'equalp :key #'(lambda(item) (list (first item))))
(setf (rest (assoc root-path (gdl-acc::%version-tree% root) :test #'equalp))
(remove-plist-key (rest (assoc root-path
(gdl-acc::%version-tree% root) :test #'equalp)) attribute)))
(when *eager-setting-enabled?*
(dolist (reset *leaf-resets*)
(the-object (first reset) (evaluate (second reset)))))))))
(restore-attribute-default! (attribute) (the (restore-slot-default! attribute)))
......@@ -599,7 +558,7 @@ from
value
(cons 'the (append (reverse (the-object (first *notify-cons*) root-path))
(list (make-keyword (second *notify-cons*)))))))
(progn ;; bt:with-lock-held (*binding-lock*) FLAG - bring in later in bootstrapping.
(glisp:with-lock-held (*binding-lock*)
(unless (eql attribute :%primary?%)
(when (not *run-with-dependency-tracking?*)
(error "Dependency Tracking must be enabled in order to forcibly
......@@ -725,7 +684,7 @@ from
value
(cons 'the (append (reverse (the-object (first *notify-cons*) root-path))
(list (make-keyword (second *notify-cons*)))))))
(bt:with-lock-held (*binding-lock*)
(glisp:with-lock-held (*binding-lock*)
(unless (eql attribute :%primary?%)
(when (not *run-with-dependency-tracking?*)
(error "Dependency Tracking must be enabled in order to forcibly
......@@ -1226,12 +1185,11 @@ a separate object hierarchy." object self)))
(defvar *ui-server* (make-instance 'base-gdl-ui))
(defmethod restore-ui-object ((ui-server base-gdl-ui) object) (declare (ignore object)))
(defparameter *unbound-slots* nil)
(defparameter *binding-lock* (bt:make-lock "unbinding-lock"))
(defparameter *binding-lock* (glisp:make-lock "unbinding-lock"))
(defun unbind-dependent-slots (object slot &key updating?)
(let ((*unbound-slots* (glisp:make-sans-value-equalp-hash-table)))
......
......@@ -429,3 +429,18 @@ This must be replaced with e.g. appropriate process-locks.~%")
,@body)))
;;
;; FLAG -- fill these next two in with simple equivalent on each
;; lisp. Don't want to depend on libraries yet.
;;
(defmacro with-lock-held ((lock) &body body)
(declare (ignore lock))
`(progn ,@body))
(defun make-lock (name)
name)
......@@ -369,6 +369,8 @@ If you are interested in this effort we would love to hear from you at open-sour
#:with-definition-unit
#:without-package-variance-warnings
#:w-o-interrupts
#:with-lock-held
#:make-lock
#:xref-off
#:xref-on
......
"(:bordeaux-threads :uiop :babel #-allegro :quri #-allegro :zacl :cl-lite :gwl-graphics :tasty :robot :yadd)"
(:gwl-graphics :tasty :robot :yadd)
......@@ -3,8 +3,7 @@
(asdf:defsystem #:gendl :description
"The Gendl® gendl Subsystem" :author "Genworks International"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20180115" :depends-on
(:bordeaux-threads :uiop #-allegro :babel #-allegro :quri :cl-lite :gwl-graphics :tasty :robot :yadd)
:serial t :version "20180115" :depends-on (:gwl-graphics :tasty :robot :yadd)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode ()
#+asdf-encodings :encoding #+asdf-encodings :utf-8
......
(:glisp)
(:cl-pdf :cl-typesetting :cl-who :base)
......@@ -3,7 +3,7 @@
(asdf:defsystem #:geom-base :description
"The Gendl® Wireframe Geometry" :author "Genworks International"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20180823" :depends-on (:glisp)
:serial t :version "20180823" :depends-on (:cl-pdf :cl-typesetting :cl-who :base)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode ()
#+asdf-encodings :encoding #+asdf-encodings :utf-8
......
(in-package :geom-base)
;;
;; FLAG --- need to use asdf around-compile method (or something like
;; it) to set these only temporarily.
......
"(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel)"
"(:uiop :bordeaux-threads :cl-ppcre #-allegro :cl-base64 #-allegro :babel :base)"
......@@ -4,10 +4,8 @@
"The Gendl® Common Lisp Portability" :author
"Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20170828" :depends-on
;;(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-allegro :zacl)
(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel)
:version "20170828"
:depends-on (:uiop :bordeaux-threads :cl-ppcre #-allegro :cl-base64 #-allegro :babel :base)
:components
((:file "source/presets") (:file "source/parameters")
(:file "source/genworks") (:file "source/initialize")
((:file "source/parameters") (:file "source/genworks") (:file "source/initialize")
(:file "source/zzinit")))
......@@ -430,16 +430,6 @@ the \"current\" error."
#+nil
(defun local-port (socket)
(#+allegro
socket:local-port
#-allegro acl-compat.socket:local-port socket))
(defun match-regexp (string-or-regexp string-to-match
&key newlines-special case-fold return
(start 0) end shortest)
......@@ -454,20 +444,6 @@ are no longer supported by glisp:match-regexp.~%"))
(cl-ppcre:scan string-or-regexp string-to-match :start start :end end-default)))
#+nil
(defun match-regexp (string-or-regexp string-to-match
&key newlines-special case-fold return
(start 0) end shortest)
(#+allegro excl:match-regexp
#-allegro acl-compat.excl:match-regexp string-or-regexp string-to-match
:newlines-special newlines-special
:case-fold case-fold
:return return
:start start
:end end
:shortest shortest))
(defun patches-dir ()
nil)
......@@ -475,30 +451,12 @@ are no longer supported by glisp:match-regexp.~%"))
(defun process-run-function (name-or-options preset-function &rest initial-bindings)
(bt:make-thread preset-function :name name-or-options :initial-bindings initial-bindings))
#+nil
(defun process-run-function (name-or-options preset-function &rest args)
#-allegro (when args (error "args not supported for glisp:process-run-function on ~a.~%" (lisp-implementation-type)))
(apply #+allegro #'mp:process-run-function
#-allegro #'bt:make-thread preset-function name-or-options))
#+nil
(defun process-run-function (name-or-options preset-function &rest args)
(apply #+allegro #'mp:process-run-function
#-allegro #'acl-compat.mp:process-run-function
name-or-options preset-function args))
(defun sexpr-from-file (pathname &optional if-does-not-exist-error?)
(if (probe-file pathname)
(with-open-file (in pathname) (read in))
(when if-does-not-exist-error? (error "~&The File `~a' does not exist.~%" pathname))))
(defun replace-regexp (string regexp to-string)
(cl-ppcre:regex-replace-all regexp string to-string))
......
(in-package :com.genworks.lisp)
;;
;; FLAG --- need to use asdf around-compile method (or something like
;; it) to set these only temporarily.
;;
(setq cl-who:*prologue* "<!doctype HTML>")
(setq cl-who:*attribute-quote-char* #\")
(setq cl-who:*downcase-tokens-p* nil)
;;"(:bordeaux-threads :drakma :glisp #+zacl :aserve #-zacl :paserve :yason)"
(:bordeaux-threads:glisp #-allegro :zacl-aserve #+allegro :aserve :yason)
"( #+(or ccl sbcl allegro) :zaserve #-(or ccl sbcl allegro) :paserve :cl-who :yason :glisp)"
......@@ -5,7 +5,7 @@
"Dave Cooper, Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20170802" :depends-on
(:bordeaux-threads :glisp #-allegro :zacl-aserve #+allegro :aserve :yason)
(#+(or ccl sbcl allegro) :zaserve #-(or ccl sbcl allegro) :paserve :cl-who :yason :glisp)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode ()
#+asdf-encodings :encoding #+asdf-encodings :utf-8
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment