Commit 432542a1 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Moved scat to utility.

parent 3ac8d0da
......@@ -36,6 +36,7 @@
(setf *readtable* (copy-readtable nil)))
(defpackage "COM.INFORMATIMAGO.CLEXT.ASSOCIATION"
(:use "COMMON-LISP" "CLOSER-MOP")
(:import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL" "SCAT")
(:shadowing-import-from "CLOSER-MOP"
"STANDARD-CLASS" "STANDARD-GENERIC-FUNCTION" "STANDARD-METHOD"
"DEFMETHOD" "DEFGENERIC")
......@@ -531,11 +532,6 @@ RETURN: MIN; MAX"
class))
(defun scat (&rest string-designators)
(intern (apply (function concatenate) 'string
(mapcar (function string) string-designators))))
;; (defmacro define-association (name ((role &key type slot accessor
;; multiplicity implementation
;; multiple ordered qualifier
......
......@@ -35,6 +35,7 @@
(defpackage "COM.INFORMATIMAGO.CLEXT.PKCS11"
(:use "COMMON-LISP" "CFFI" "BABEL")
(:use "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-UTILS")
(:import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL" "SCAT")
(:import-from "COM.INFORMATIMAGO.CLEXT.PKCS11.LOW" "LOAD-LIBRARY")
(:shadowing-import-from "COM.INFORMATIMAGO.CLEXT.PKCS11.CFFI-DEBUG"
"FOREIGN-ALLOC" "FOREIGN-FREE")
......@@ -1944,10 +1945,6 @@ RETURN: TEMPLATE
(set-mechanism fmechanism mechanism)
(check-rv (,low-name session fmechanism ,@(when keyp `(key))) ,c-name))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun scat (&rest args)
(intern (reduce (lambda (a b) (concatenate 'string a b)) args :key (function string)))))
(defmacro define-pkcs11-processing-function (name low-name c-name &key (input '()) (outputp t))
"Defines a function to process buffers.
......
......@@ -11,6 +11,7 @@
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2018-12-30 <PJB> Added symbol.lisp
;;;; 2010-10-31 <PJB> Created this .asd file.
;;;;BUGS
;;;;LEGAL
......@@ -63,7 +64,7 @@ all written in 100% conforming Common Lisp.
:licence "AGPL3"
;; component attributes:
:version "1.8.0"
:version "1.8.1"
:properties ((#:author-email . "pjb@informatimago.com")
(#:date . "Autumn 2015")
((#:albert #:output-dir) . "/tmp/documentation/com.informatimago.common-lisp.cesarum/")
......@@ -82,7 +83,8 @@ all written in 100% conforming Common Lisp.
(:file "array" :depends-on ())
(:file "sequence" :depends-on ())
(:file "list" :depends-on ())
(:file "utility" :depends-on ("list"))
(:file "symbol" :depends-on ())
(:file "utility" :depends-on ("list" "symbol"))
(:file "string" :depends-on ("utility" "list" "sequence" "ecma048"))
(:file "package" :depends-on ("utility"))
......
......@@ -277,9 +277,6 @@ NOTE: Unfortunately some implementations don't take into account
((>= i max) result)
(setf (char result i) (character (aref ,seq i)))))) )))
(defgeneric explode (object &optional result-type)
(:documentation "
RETURN: A sequence of character of type RESULT-TYPE containing
......@@ -297,7 +294,6 @@ OBJECT: Can be a string, a symbol (its symbol-name is exploded),
(:method ((object t) &optional (result-type 'list))
(explode-string (prin1-to-string object) result-type)))
(defun implode (char-seq &optional (result-type 'symbol) (package *package*))
"
RETURN: An object of type RESULT-TYPE made with the character
......@@ -318,7 +314,6 @@ PACKAGE: When RESULT-TYPE is SYMBOL, then the package where the
object (type-of object) result-type)
object))))
(defun split-escaped-string (string-designator escape separator)
"
STRING-DESIGNATOR: A string designator.
......
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY")
(defun test/get-option ()
(mapc (lambda (expected-arguments)
(destructuring-bind (expected arguments) expected-arguments
(handler-case
(let ((result (apply (function get-option) arguments)))
(if (equal expected result)
result
(error "For ~S, expected ~S, got ~S" (cons 'get-option arguments) expected result)))
(error (err)
(if (eql expected 'error)
err
(error "For ~S, expected ~S, got ~S" (cons 'get-option arguments) expected err))))))
'((nil (:foo (:bar (:quux))))
(nil (:foo (:bar (:quux)) :list))
(:symbol (:foo (:bar :foo (:quux))))
(error (:foo (:bar :foo (:quux) :foo)))
(:singleton (:foo (:bar (:foo) (:quux))))
((nil) (:foo (:bar (:foo nil) (:quux))))
((foo) (:foo (:bar (:foo foo) (:quux))))
((foo bar baz) (:foo (:bar (:foo foo bar baz) (:quux))))
((:foo) (:foo (:bar :foo (:quux)) :list))
((:foo :foo) (:foo (:bar :foo (:quux) :foo) :list))
(((:foo) :foo (:foo foo)) (:foo (:bar (:foo) (:quux) :foo (:foo foo)) :list))))
:success)
(defun test/all ()
(test/get-option))
(mapcar
(lambda (expected-arguments)
(destructuring-bind (expected arguments) expected-arguments
(handler-case
(let ((results (multiple-value-list
(apply (function parse-structure-name-and-options) arguments))))
results
#-(and)
(if (equal expected results)
results
(error "For ~S, expected ~S, got ~S" (cons 'parse-structure-name-and-options arguments) expected results)))
(error (err)
(if (eql expected 'error)
err
(error "For ~S, expected ~S, got ~S" (cons 'parse-structure-name-and-options arguments) expected err))))))
'(
(() (point))
))
(assert
(equalp
(mapcar (lambda (arguments)
(print
(mapcan (function list)
'(:name :conc-name :constructors :copier :include :initial-offset :predicate :print-function :print-object :structure-type-p :structure-type)
(multiple-value-list (apply (function parse-structure-name-and-options) arguments)))))
'((point)
((point))
((point :conc-name))
((point (:conc-name)))
((point (:conc-name nil)))
((point (:conc-name pt-)))
((point :copier))
((point (:copier)))
((point (:copier nil)))
((point (:copier copy-pt)))
((point :conc-name :copier))
((point (:conc-name) (:copier)))
((point (:conc-name nil) (:copier nil)))
((point (:conc-name pt-) (:copy copy-pt)))
((point :constructor))
((point (:constructor)))
((point (:constructor nil)))
((point (:constructor %make-pt)))
((point :constructor (:constructor %make-pt) (:constructor %make-a-pt (x y))))
((point (:print-function)))
((point (:print-function nil)))
((point (:print-function print-pt)))
((point :print-object))
((point (:print-object)))
((point (:print-object nil)))
((point (:print-object print-pt)))
))
'((:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name || :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name || :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name || :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name pt- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier nil :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-pt :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name || :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name || :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name || :constructors (make-point) :copier nil :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name pt- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors nil :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (%make-pt) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point %make-pt (%make-a-pt (x y))) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function print-pt :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object nil :structure-type-p nil :structure-type nil)
(:name point :conc-name point- :constructors (make-point) :copier copy-point :include nil :initial-offset nil :predicate point-p :print-function nil :print-object print-pt :structure-type-p nil :structure-type nil))))
#-(and)
(progn
(pprint (macroexpand-1 '(define-structure-class point x y)))
(pprint (macroexpand-1 '(define-structure-class (point :conc-name) x y)))
(pprint (macroexpand-1 '(define-structure-class (point (:conc-name)) x y)))
(pprint (macroexpand-1 '(define-structure-class (point (:conc-name nil)) x y)))
(pprint (macroexpand-1 '(define-structure-class (point (:conc-name pt-)) x y)))
(pprint (macroexpand-1 '(define-structure-class (point :predicate) x y)))
(pprint (macroexpand-1 '(define-structure-class (point (:predicate)) x y)))
(pprint (macroexpand-1 '(define-structure-class (point (:predicate nil)) x y)))
(pprint (macroexpand-1 '(define-structure-class (point (:predicate ptp)) x y)))
)
......@@ -43,8 +43,8 @@
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
"COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP"
"COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER"
"COM.INFORMATIMAGO.COMMON-LISP.PARSER.PARSER"
)
"COM.INFORMATIMAGO.COMMON-LISP.PARSER.PARSER")
(:import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL" "SCAT")
(:export "DEFGRAMMAR" "-->" "SEQ" "REP" "OPT" "ALT" "GRAMMAR-NAMED"
"GENERATE-GRAMMAR"
......
......@@ -302,10 +302,7 @@ RETURN: A form that defines the grammar object and its parser functions.
;;; Utilities
;;;
(defun scat (&rest string-designators)
"Interns the concatenation of the STRING-DESIGNATORS."
(intern (apply (function concatenate) 'string
(mapcar (function string) string-designators))))
(defun dollar (n)
"Interns a $-symbol number N."
(scat "$" (prin1-to-string n)))
......
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