Commit 84186d33 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Modifications for abcl.

parent bbd80cc4
......@@ -469,7 +469,6 @@ RETURN: MIN; MAX"
((:key this-key) '(function identity))
((:copy this-copy) '(function identity))
&allow-other-keys) this
(declare (ignore this-copy))
(multiple-value-bind (this-min this-max) (multiplicity this-multiplicity)
(let ((this-implementation (or this-implementation
(if (equal 1 this-max) 'reference 'list)))
......@@ -539,7 +538,7 @@ RETURN: MIN; MAX"
((:test this-test) '(function eql))
((:copy this-copy) '(function identity))
&allow-other-keys) this
(declare (ignore this-role this-copy))
(declare (ignore this-role))
(multiple-value-bind (this-min this-max) (multiplicity this-multiplicity)
(declare (ignore this-min))
(let ((this-implementation (or this-implementation
......
......@@ -234,7 +234,16 @@ RETURN: A new list of name and aliases, with the ALIASES added, if
;;
;; Other external formats are also possible with abcl.
#+abcl
'(("US-ASCII") ("ISO-8859-1") ("UTF-8") ("UTF-16BE") ("UTF-16LE") ("UTF-16"))
(remove-duplicates
(append '(("US-ASCII") ("ISO-8859-1") ("UTF-8") ("UTF-16BE") ("UTF-16LE") ("UTF-16"))
(mapcar (lambda (encoding)
(let ((n (symbol-name encoding))
(u (string-upcase encoding)))
(if (string= n u)
(list n)
(list n u))))
(system:available-encodings)))
:test (function equal))
#-(or abcl ccl clisp cmu ecl sbcl)
......@@ -286,13 +295,13 @@ DO: Set the cs-lisp-encoding of the character-sets present in
((:mac) :macos)))
#+clisp
(ext:make-encoding :charset (symbol-value (intern (first (cs-lisp-encoding cs)) "CHARSET"))
(ext:make-encoding :charset (symbol-value (intern encoding "CHARSET"))
:line-terminator line-termination
:input-error-action :error
:output-error-action :error)
#+cmu
(if (string-equal (first (cs-lisp-encoding cs)) "ISO-8859-1")
(if (string-equal encoding "ISO-8859-1")
:iso-latin-1-unix
(progn #|should not occur|#
(cerror 'character-set-error
......@@ -316,10 +325,10 @@ DO: Set the cs-lisp-encoding of the character-sets present in
:default))
#+sbcl
(intern (first (cs-lisp-encoding cs)) "KEYWORD")
(intern encoding "KEYWORD")
#+abcl
(intern (first (cs-lisp-encoding cs)) "KEYWORD")
(intern encoding "KEYWORD")
#-(or abcl ccl clisp cmu ecl sbcl)
(values
......@@ -359,6 +368,7 @@ DO: Set the cs-lisp-encoding of the character-sets present in
(defun external-format-line-termination (external-format)
#+(or cmu ecl sbcl abcl) (declare (ignore external-format))
#+ccl (ccl:external-format-line-termination external-format)
#+(and clisp unicode) (string (ext:encoding-line-terminator external-format))
#+cmu :unix
......
......@@ -96,7 +96,7 @@ K: (vector (unsigned-byte 32) 4), the key
(macrolet ((ref (vector index)
`(the (unsigned-byte 32) (aref ,vector ,index))))
(flet ((32bit (x) (logand #xffffffff x)))
(declare (inline 32bit))
#-(or abcl eclxxx) (declare (inline 32bit))
(loop
:with b0 :of-type (unsigned-byte 32) = (ref v 0)
:with b1 :of-type (unsigned-byte 32) = (ref v 1)
......@@ -154,7 +154,7 @@ K: (vector (unsigned-byte 32) 4), the key
(type (vector (unsigned-byte 32) 2) w)
(type (vector (unsigned-byte 32) 4) k))
(flet ((32bit (x) (logand #xffffffff x)))
#-eclxxx (declare (inline 32bit))
#-(or abcl eclxxx) (declare (inline 32bit))
(loop
:with b0 :of-type (unsigned-byte 32) = (aref v 0)
:with b1 :of-type (unsigned-byte 32) = (aref v 1)
......
......@@ -506,7 +506,6 @@ some constraints may be different from one lambda-list to the other."))
(:method ((self or-ll)) (not (not (lambda-list-keyword-parameters self)))))
(defclass orake-ll (orak-ll)
((environment :accessor lambda-list-environment-parameter
:initarg :environment-parameter
......@@ -570,7 +569,7 @@ some constraints may be different from one lambda-list to the other."))
(defclass type-lambda-list (lambda-list orakawbe-ll) ())
(defclass destructuring-lambda-list (lambda-list orakawb-ll) ())
(defclass setf-lambda-list (lambda-list orake-ll) ())
(defclass method-combination-lambda-list (lambda-list orakaw-ll) ())
(defclass method-combination-lambda-list (lambda-list orakawb-ll) ())
(defgeneric lambda-list-kind (lambda-list)
(:method ((self ordinary-lambda-list)) (declare (ignorable self)) :ordinary)
......
......@@ -1470,11 +1470,7 @@ DO: complements the set.
(t obj))) ;;LIGHTEN
(defun print-rnode (node stream level)
(declare (ignore level))
(format stream "<~A~{ ~S~}>"
(lighten (rnode-token node))
(map 'list (function identity) (rnode-children node))))
(defstruct (rnode
......@@ -1486,9 +1482,17 @@ DO: complements the set.
(children nil :type (or null (array #+lispworks t
#-lispworks rnode
(*)))))
;; (equiv (null children) (not (< 0 (length children)))))
(defun print-rnode (node stream level)
(declare (ignore level))
(format stream "<~A~{ ~S~}>"
(lighten (rnode-token node))
(map 'list (function identity) (rnode-children node))))
(defmacro with-rnode (node &body body)
`(with-slots ((matchf matchf)
......@@ -1708,7 +1712,7 @@ End of line anchor.
nil))))
(defun rmatch-any (node state env)
(defun rmatch-any (node state env)
(declare (ignorable node))
(with-rens env node state
(try-once
......@@ -1722,6 +1726,7 @@ End of line anchor.
t)))))
(defun rmatch-item (node state env)
(declare (ignorable node))
(with-rens env node state
......
......@@ -42,7 +42,7 @@
"com.informatimago.clext")
:components ((:file "dependency-cycles")
(:file "asdf-file" :depends-on ("dependency-cycles" "script"))
(:file "script")
#-abcl (:file "script")
(:file "check-asdf" :depends-on ("dependency-cycles" "asdf-file"))))
;;;; THE END ;;;;
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