Codebase list cafeobj / 7290c25
* Fix inconsistency of libpath switch. tswd 8 years ago
10 changed file(s) with 110 addition(s) and 41 deletion(s). Raw diff Collapse all Expand all
+8
-6
cafeobj/command-top.lisp less more
423423 (pathname (concatenate 'string topdir "/lib/")))
424424 (setq *system-ex-dir*
425425 (pathname (concatenate 'string topdir "/exs/")))
426 (setq *chaos-libpath* (list *system-lib-dir* *system-ex-dir*)))
426 ;; (setq *chaos-libpath* (list *system-lib-dir* *system-ex-dir*))
427 (setq *chaos-libpath* (list *system-lib-dir*)))
427428
428429 #-(or (and CCL (not :openmcl)) ALLEGRO (and SBCL WIN32))
429430 (defun set-cafeobj-standard-library-path (&optional topdir)
453454 (setq *system-prelude-dir* (translate-logical-pathname (merge-pathnames "prelude/")))
454455 (setq *system-lib-dir* (translate-logical-pathname (merge-pathnames "lib/")))
455456 (setq *system-ex-dir* (translate-logical-pathname (merge-pathnames "exs/")))
456 (setq *chaos-libpath*
457 (list *system-lib-dir* *system-ex-dir*)))))
457 ;;; (setq *chaos-libpath* (list *system-lib-dir* *system-ex-dir*))
458 (setq *chaos-libpath* (list *system-lib-dir*)))))
458459
459460 #+(and :SBCL :win32)
460461 (defun set-cafeobj-standard-library-path (&optional topdir)
467468 (setq *system-prelude-dir* (translate-logical-pathname (merge-pathnames "prelude/")))
468469 (setq *system-lib-dir* (translate-logical-pathname (merge-pathnames "lib/")))
469470 (setq *system-ex-dir* (translate-logical-pathname (merge-pathnames "exs/")))
470 (setq *chaos-libpath*
471 (list *system-lib-dir* *system-ex-dir*)))))
471 ;;; (setq *chaos-libpath* (list *system-lib-dir* *system-ex-dir*))
472 (setq *chaos-libpath* (list *system-lib-dir*)))))
472473
473474 ;;; patch by t-seino@jaist.ac.jp
474475 #+(and CCL (not :openmcl))
482483 (full-pathname (make-pathname :host "ccl" :directory "lib/")))
483484 (setq *system-ex-dir*
484485 (full-pathname (make-pathname :host "ccl" :directory "exs/")))
485 (setq *chaos-libpath* (list *system-lib-dir* *system-ex-dir*)))
486 ;; (setq *chaos-libpath* (list *system-lib-dir* *system-ex-dir*))
487 (setq *chaos-libpath* (list *system-lib-dir*)))
486488
487489 ;;; MAIN ROUTINE
488490 ;;; PROCESSING INPUT FILE STREAM
+2
-2
cafeobj/commands.lisp less more
342342 retries the evaluation.
343343 ")
344344
345 (define ("no autoload")
345 (define ("no-autoload")
346346 :category :library
347 :parse parse-no-autoload-command
347 :parser parse-no-autoload-command
348348 :evaluator eval-ast
349349 :title "`no autoload <module-name>`"
350350 :related ("autoload")
+1
-1
cafeobj/creader.lisp less more
463463 (version)
464464 ;; AUTO LOAD
465465 (autoload :symbol :symbol)
466 (no autoload :symbol)
466 (no-autoload :symbol)
467467 ;; (stop at :term |.|)
468468 ;; ((:+ rwt) limit :symbol)
469469 (test (:+ reduction red execution exec) (:if-present in :modexp |:|)
+9
-1
cafeobj/trans-com.lisp less more
158158 (let ((mod-name (second inp))
159159 (file (third inp)))
160160 (%autoload* mod-name file)))
161
161
162 ;;;
163 ;;; NO AUTOLOAD
164 ;;;
165 (defun parse-no-autoload-command (inp &rest ignore)
166 (declare (ignore ignore))
167 (let ((mod-name (second inp)))
168 (%no-autoload* mod-name)))
169
162170 ;;; ******
163171 ;;; CBREAD
164172 ;;; ******
+49
-25
chaos/cafein/rengine.lisp less more
110110 (term-hash-equal (term-builtin-value term))))
111111 ((term-is-variable? term) (term-hash-eq term))))
112112
113 (defun dump-term-hash (term-hash &optional (size term-hash-size))
114 (dotimes (x size)
115 (let ((ent (svref term-hash x)))
116 (when ent
117 (format t "~%[~3d]: ~d entrie(s)" x (length ent))
118 (dotimes (y (length ent))
119 (let ((e (nth y ent)))
120 (format t "~%(~d)" y)
121 (let ((*print-indent* (+ 2 *print-indent*)))
122 (term-print (car e))
123 (print-next)
124 (princ "==>")
125 (print-next)
126 (term-print (cdr e)))))))))
113 (defun dump-term-hash (term-hash &optional (size term-hash-size) (module *current-module*))
114 (with-in-module (module)
115 (dotimes (x size)
116 (let ((ent (svref term-hash x)))
117 (when ent
118 (format t "~%[~3d]: ~d entrie(s)" x (length ent))
119 (dotimes (y (length ent))
120 (let ((e (nth y ent)))
121 (format t "~%(~d)" y)
122 (let ((*print-indent* (+ 2 *print-indent*)))
123 (term-print (car e))
124 (print-next)
125 (princ "==>")
126 (print-next)
127 (term-print (cdr e))))))))))
127128
128129 #-GCL
129130 (declaim (inline get-hashed-term))
240241
241242 ;;; ----------------------------------------
242243 ;;; BASIC PROCS for REWRITE RULE APPLICATION
243
244 (defvar *memo-debug* nil)
245
246 #| NOT USED
244247 (defmacro term-replace-with-memo (old new)
245248 (once-only (old new)
246249 ` (if (and (not (term-is-builtin-constant? ,old))
247250 (or *always-memo*
248251 (method-has-memo (term-head ,old))))
249 (progn
250 (set-hashed-term (simple-copy-term ,old) *term-memo-table* ,new)
252 (let ((term-memo (simple-copy-term ,old)))
253 (when *memo-debug*
254 (when (term-equational-equal term-memo ,new)
255 (with-output-chaos-warning ()
256 (format t "E-E term is about to hashed!")
257 (terpri)
258 (term-print-with-sort ,new)))
259 (format t "~%[memo]: ")
260 (term-print-with-sort term-memo)
261 (format t "~% ==> ")
262 (term-print-with-sort ,new))
263 (set-hashed-term term-memo *term-memo-table* ,new)
251264 (term-replace ,old ,new))
252265 (term-replace ,old ,new))))
266 |#
253267
254268 (declaim (inline term-replace-dd-simple))
255269 #-gcl
779793 ;; return t iff the rule is applied.
780794 is-applied))
781795
782 #| -- moved to reducer.lisp
796 #|| -- moved to reducer.lisp
783797 (defun simplify-on-top (term)
784798 (declare (type term term)
785799 (values t))
788802 (method-rules-with-different-top
789803 (term-method term)))
790804 term))
791 |#
805 ||#
792806
793807 ;;;
794808 ;;; REWRITE ENGINE
954968 (let ((term-nu nil)
955969 (normal-form (get-hashed-term term *term-memo-table*)))
956970 (unless normal-form
957 (setq term-nu (simple-copy-term term))
958 ;; compute the normal form of "term"
959 (reduce-term term strategy)
960 (setq normal-form term)
961 ;; store the normal form
962 (set-hashed-term term-nu *term-memo-table* normal-form))
971 (let ((rule-count (number-rewritings)))
972 (setq term-nu (simple-copy-term term))
973 ;; compute the normal form of "term"
974 (reduce-term term strategy)
975 (setq normal-form term)
976 (unless (= rule-count (number-rewritings))
977 (when *memo-debug*
978 (when (term-equational-equal term-nu normal-form)
979 (with-output-chaos-warning ()
980 (format t "E-E term is about to be hashed!")
981 (format t "~%(~d) old = " rule-count (number-rewritings))
982 (term-print-with-sort term-nu)
983 (format t "~%(~d) new = " (number-rewritings))
984 (term-print-with-sort normal-form))))
985 ;; store the normal form
986 (set-hashed-term term-nu *term-memo-table* normal-form))))
963987 normal-form))
964988
965989 (defmacro check-closed-world-assumption (?term)
+12
-0
chaos/eval/eval-ast2.lisp less more
13821382 (setf (cdr entry) file)
13831383 (push (cons modname file) *autoload-alist*)))))
13841384
1385 ;;; ************
1386 ;;; NO AUTOLOAD
1387 ;;; ************
1388 (defun eval-no-autoload (ast)
1389 (let ((modname (%no-autoload-mod-name ast)))
1390 (unless (assoc modname *autoload-alist* :test #'equal)
1391 (with-output-chaos-warning ()
1392 (format t "Module ~s is not specified as 'autoload'." modname)))
1393 (setq *autoload-alist*
1394 (remove-if #'(lambda (x) (equal modname x)) *autoload-alist*
1395 :key #'car))))
1396
13851397 ;;; *********************
13861398 ;;; MISC SUPOORT ROUTINES
13871399 ;;; *********************
+7
-0
chaos/primitives/script.lisp less more
376376 file)
377377 :eval eval-autoload)
378378
379 ;;; ***********
380 ;;; NO AUTOLOAD
381 ;;; ***********
382 (defterm no-autoload (%script)
383 :visible (mod-name)
384 :eval eval-no-autoload)
385
379386 ;;; ******************************
380387 ;;; CIRCULAR COINDUCTIVE REWRITING
381388 ;;; ******************************
+9
-5
chaos/tools/set.lisp less more
191191 ;; debug flags : invisible from user, internal use only
192192 ("sys" ("universal-sort") parity *allow-universal-sort* "" nil nil t)
193193 ("debug" ("rewrite") parity *rewrite-debug* "" nil nil t)
194 ("debug" ("memo") parity *memo-debug* "" nil nil t)
194195 ("debug" ("hash") parity *on-term-hash-debug* "" nil nil t)
195196 ("debug" ("axiom") parity *on-axiom-debug* "" nil nil t)
196197 ("debug" ("beh") parity *beh-debug* "" nil nil t)
302303 (type (chaos-switch-type switch)))
303304 (cond ((eq name :comment)
304305 (format t "~%~a" (second switch)))
306 ((equal name "libpath")
307 (format t "~%libpath~24T= ~{~a~^:~}" value))
305308 (t (when (atom name) (setq name (list name)))
306309 (if (eq type 'parity)
307310 (format t "~&~{~a~^|~a~} ~{~^ ~a~} ~24T~:[off~;on~]" name option value)
343346 ;;; some switch setters
344347 ;;;
345348 (defun chaos-set-search-path (path)
346 (let* ((add (if (equal "+" (car path))
347 t
348 nil))
349 (paths (if add (cadr path) (car path))))
349 (let* ((add (equal "+" (car path)))
350 (minus (equal "-" (car path)))
351 (paths (if (or add minus) (cadr path) (car path))))
350352 (if add
351353 (set-search-path-plus paths)
352 (set-search-path paths))))
354 (if minus
355 (set-search-path-minus paths)
356 (set-search-path paths)))))
353357
354358 (defun chaos-set-tram-path (path)
355359 (let ((path (car path)))
+12
-0
comlib/fsys.lisp less more
494494 (setq *chaos-libpath*
495495 (append (nreverse path) *chaos-libpath*))))
496496
497 (defun set-search-path-minus (paths)
498 (when (consp paths) (setq paths (car paths)))
499 (let ((path nil))
500 (dolist (p (parse-with-delimiter paths #\:))
501 (push p path))
502 (dolist (p path)
503 (if (not (member p *chaos-libpath* :test #'equal))
504 (with-output-chaos-warning ()
505 (format t "The path ~s does not in 'libpath'." p))
506 (setq *chaos-libpath* (remove p *chaos-libpath* :test #'equal))))
507 *chaos-libpath*))
508
497509 ;;;
498510 ;;; INITIALIZATION
499511 ;;;
+1
-1
thstuff/cexec.lisp less more
777777 :condition condition))
778778 ;; register the term
779779 (when *cexec-debug*
780 (format t "~%** hasing state ~D" state-num))
780 (format t "~%** hashing state ~D" state-num))
781781 (cexec-set-hashed-term target state-num))))
782782 ;;
783783 new-state))