Commit b5596a6f authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

merged.

parents ed1ae614 f6b376ca
......@@ -390,7 +390,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)))
......@@ -460,7 +459,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
......
;; -*- mode: lisp -*-
(:name "html"
:package "COM.INFORMATIMAGO.COMMON-LISP.PARSE-HTML"
:identifier-start-chars
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
:identifier-continue-chars
"-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"
:intern-identifier t
:string-delimiter #.(code-char 0)
:symbol-delimiter #.(code-char 0)
:lex-cats (
(ord-char "[^.\\[*]")
)
:grammar "zebu-mg"
:case-sensitive nil
)
;; Domain definition
html-seq := kb-domain: [(first) (rest)];
comment := kb-domain: [(data)];
attribute := kb-domain: [(name ident) (value)];
definition := kb-domain: [(name ident) (attributes)];
open-tag := kb-domain: [(name ident) (attributes)];
clos-tag := kb-domain: [(name ident)];
;; Productions
%token QUOTED_CHAR DUP_COUNT
backref
l-anchor --> "^" ;
r-anchor --> "$" ;
back-open-paren --> "\\(" ;
back-close-paren --> "\\)" ;
back-open-brace --> "\\{" ;
back-close-brace --> "\\}" ;
/* The following tokens are for the Bracket Expression
grammar common to both REs and EREs. */
%token COLL_ELEM_SINGLE COLL_ELEM_MULTI META_CHAR
%token Open_equal Equal_close Open_dot Dot_close Open_colon Colon_close
/* '[=' '=]' '[.' '.]' '[:' ':]' */
%token class_name
/* class_name is a keyword to the LC_CTYPE locale category */
/* (representing a character class) in the current locale */
/* and is only recognized between [: and :] */
%start basic_reg_exp
%%
/* --------------------------------------------
Basic Regular Expression
--------------------------------------------
*/
basic_reg_exp : RE_expression
| L_ANCHOR
| R_ANCHOR
| L_ANCHOR R_ANCHOR
| L_ANCHOR RE_expression
| RE_expression R_ANCHOR
| L_ANCHOR RE_expression R_ANCHOR
;
RE_expression : simple_RE
| RE_expression simple_RE
;
simple_RE : nondupl_RE
| nondupl_RE RE_dupl_symbol
;
nondupl_RE : one_char_or_coll_elem_RE
| Back_open_paren RE_expression Back_close_paren
| BACKREF
;
one_char_or_coll_elem_RE : ORD_CHAR
| QUOTED_CHAR
| '.'
| bracket_expression
;
RE_dupl_symbol : '*'
| Back_open_brace DUP_COUNT Back_close_brace
| Back_open_brace DUP_COUNT ',' Back_close_brace
| Back_open_brace DUP_COUNT ',' DUP_COUNT Back_close_brace
;
%token ORD_CHAR QUOTED_CHAR DUP_COUNT
%start extended_reg_exp
%%
/* --------------------------------------------
Extended Regular Expression
--------------------------------------------
*/
extended_reg_exp : ERE_branch
| extended_reg_exp '|' ERE_branch
;
ERE_branch : ERE_expression
| ERE_branch ERE_expression
;
ERE_expression : one_char_or_coll_elem_ERE
| '^'
| '$'
| '(' extended_reg_exp ')'
| ERE_expression ERE_dupl_symbol
;
one_char_or_coll_elem_ERE : ORD_CHAR
| QUOTED_CHAR
| '.'
| bracket_expression
;
ERE_dupl_symbol : '*'
| '+'
| '?'
| '{' DUP_COUNT '}'
| '{' DUP_COUNT ',' '}'
| '{' DUP_COUNT ',' DUP_COUNT '}'
;
/* --------------------------------------------
Bracket Expression
-------------------------------------------
*/
bracket_expression : '[' matching_list ']'
| '[' nonmatching_list ']'
;
matching_list : bracket_list
;
nonmatching_list : '^' bracket_list
;
bracket_list : follow_list
| follow_list '-'
;
follow_list : expression_term
| follow_list expression_term
;
expression_term : single_expression
| range_expression
;
single_expression : end_range
| character_class
| equivalence_class
;
range_expression : start_range end_range
| start_range '-'
;
start_range : end_range '-'
;
end_range : COLL_ELEM_SINGLE
| collating_symbol
;
collating_symbol : Open_dot COLL_ELEM_SINGLE Dot_close
| Open_dot COLL_ELEM_MULTI Dot_close
| Open_dot META_CHAR Dot_close
;
equivalence_class : Open_equal COLL_ELEM_SINGLE Equal_close
| Open_equal COLL_ELEM_MULTI Equal_close
;
character_class : Open_colon class_name Colon_close
;
;;;; bre.zb -- -- ;;;;
......@@ -1442,11 +1442,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
......@@ -1458,9 +1454,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)
......@@ -1680,7 +1684,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
......@@ -1694,6 +1698,7 @@ End of line anchor.
t)))))
(defun rmatch-item (node state env)
(declare (ignorable node))
(with-rens env node state
......
......@@ -42,5 +42,8 @@
"com.informatimago.tools.script")
:components ((:file "dependency-cycles")
(:file "check-asdf" :depends-on ("dependency-cycles"))))
(:file "asdf-file" :depends-on ("dependency-cycles" "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