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

Merged.

parents 8eaef1bb 8610ad65
...@@ -48,9 +48,17 @@ help:: ...@@ -48,9 +48,17 @@ help::
@for c in $(COMPILERS) ; do printf $(HELP_FMT) "compile-with-$$c" "Compile with $$c." ; done @for c in $(COMPILERS) ; do printf $(HELP_FMT) "compile-with-$$c" "Compile with $$c." ; done
@printf $(HELP_FMT) 'all' 'Compile with all the available compilers.' @printf $(HELP_FMT) 'all' 'Compile with all the available compilers.'
# Let's compile with all the available compilers ( $(GCL) not yet ). # Let's compile with all the available compilers ( $(GCL) not yet ).
# all:: $(ABCL) $(ALLEGRO) $(CCL) $(CLISP) $(ECL) $(SBCL) $(CMUCL) $(OPENMCL) all:: \
all:: compile-with-$(CLISP) compile-with-$(ECL) compile-with-$(SBCL) compile-with-$(OPENMCL) compile-with-$(CLISP) \
# compile-with-$(CMUCL) breaks on decode-raw-cardinal in bencode... compile-with-$(ECL) \
compile-with-$(SBCL) \
compile-with-$(OPENMCL) \
compile-with-$(CMUCL) \
compile-with-$(ALLEGRO) \
compile-with-$(ABCL) \
compile-with-$(CCL)
# compile-with-$(CMUCL) breaks on decode-raw-cardinal in bencode...
# compile-with-$(ALLEGRO) fails on posix-regexp out of memory... # compile-with-$(ALLEGRO) fails on posix-regexp out of memory...
# compile-with-$(ABCL) chokes on unicode! # compile-with-$(ABCL) chokes on unicode!
# compile-with-$(CCL) doesn't run from Makefile (it runs well from the shell!). # compile-with-$(CCL) doesn't run from Makefile (it runs well from the shell!).
...@@ -185,6 +193,11 @@ showpdf show-pdfs:README.pdf ...@@ -185,6 +193,11 @@ showpdf show-pdfs:README.pdf
help:: help::
@printf $(HELP_FMT) 'quicklisp-tag' 'Update the quicklisp tag on the remote repositories.' @printf $(HELP_FMT) 'quicklisp-tag' 'Update the quicklisp tag on the remote repositories.'
help::
@printf $(HELP_FMT) 'try' 'Try to compile all systems with sbcl and write report.'
try:
$(call eval_with_sbcl,'(progn (load #P"~/quicklisp/setup.lisp") (funcall (find-symbol "QUICKLOAD" "QL") :com.informatimago.tools.try-systems) (funcall (find-symbol "TRY-SYSTEMS" "COM.INFORMATIMAGO.TOOLS.TRY-SYSTEMS")))')
# quicklisp-tag: quicklisp-tag-remove quicklisp-tag-add # quicklisp-tag: quicklisp-tag-remove quicklisp-tag-add
# #
# quicklisp-tag-remove: # quicklisp-tag-remove:
...@@ -203,3 +216,4 @@ help:: ...@@ -203,3 +216,4 @@ help::
# .PHONY::quicklisp-tag quicklisp-tag-remove quicklisp-tag-add # .PHONY::quicklisp-tag quicklisp-tag-remove quicklisp-tag-add
#### THE END #### #### THE END ####
...@@ -243,7 +243,7 @@ INVARIANT: (length banque)=5, ...@@ -243,7 +243,7 @@ INVARIANT: (length banque)=5,
(let* ((b (subseq rib 0 5)) (let* ((b (subseq rib 0 5))
(g (subseq rib 5 5)) (g (subseq rib 5 5))
(c (subseq rib 10 11)) (c (subseq rib 10 11))
(k (when with-check-digits (subseq rib 21 2))) (k (when with-check-digits (subseq rib 21 23)))
(ck (compute-check-digits b g c))) (ck (compute-check-digits b g c)))
(when (and with-check-digits (string/= k ck)) (when (and with-check-digits (string/= k ck))
(signal 'rib-error "Invalid key, given=~S, computed=~S." k ck)) (signal 'rib-error "Invalid key, given=~S, computed=~S." k ck))
......
...@@ -34,6 +34,8 @@ ...@@ -34,6 +34,8 @@
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (copy-readtable nil))) (setf *readtable* (copy-readtable nil)))
(load #P"~/quicklisp/setup.lisp")
(let ((path (merge-pathnames (let ((path (merge-pathnames
(make-pathname :directory '(:relative "TOOLS") (make-pathname :directory '(:relative "TOOLS")
:name "INIT-ASDF" :type "LISP" :case :common) :name "INIT-ASDF" :type "LISP" :case :common)
...@@ -56,6 +58,7 @@ ...@@ -56,6 +58,7 @@
:test (function equalp)) :test (function equalp))
asdf:*central-registry*)) asdf:*central-registry*))
(asdf-load :cl-ppcre)
#-abcl #-abcl
(asdf-load :com.informatimago.common-lisp) (asdf-load :com.informatimago.common-lisp)
......
...@@ -109,15 +109,25 @@ CCL_EXIT := --eval '(ccl:quit)' ...@@ -109,15 +109,25 @@ CCL_EXIT := --eval '(ccl:quit)'
OPENMCL_EXIT := --eval '(ccl:quit)' OPENMCL_EXIT := --eval '(ccl:quit)'
SBCL_EXIT := --eval '(sb-ext:quit)' SBCL_EXIT := --eval '(sb-ext:quit)'
ABCL_COMMAND = LC_CTYPE=$(LC_CTYPE) $(ABCL) $(ABCL_FLAGS) --eval $(DECLAIMS) --eval $(COMPILES) $(ABCL_EXIT) eval_with_abcl = LC_CTYPE=$(LC_CTYPE) $(ABCL) $(ABCL_FLAGS) --eval $(DECLAIMS) --eval $(1) $(ABCL_EXIT)
ALLEGRO_COMMAND = LC_CTYPE=$(LC_CTYPE) $(ALLEGRO) $(ALLEGRO_FLAGS) -e $(DECLAIMS) -e $(COMPILES) $(ALLEGRO_EXIT) eval_with_allegro = LC_CTYPE=$(LC_CTYPE) $(ALLEGRO) $(ALLEGRO_FLAGS) -e $(DECLAIMS) -e $(1) $(ALLEGRO_EXIT)
CLISP_COMMAND = LC_CTYPE=$(LC_CTYPE) $(CLISP) $(CLISP_FLAGS) -x $(DECLAIMS) -x $(COMPILES) $(CLISP_EXIT) eval_with_clisp = LC_CTYPE=$(LC_CTYPE) $(CLISP) $(CLISP_FLAGS) -x $(DECLAIMS) -x $(1) $(CLISP_EXIT)
CMUCL_COMMAND = LC_CTYPE=$(LC_CTYPE) $(CMUCL) $(CMUCL_FLAGS) -eval $(DECLAIMS) -eval $(COMPILES) $(CMUCL_EXIT) eval_with_cmucl = LC_CTYPE=$(LC_CTYPE) $(CMUCL) $(CMUCL_FLAGS) -eval $(DECLAIMS) -eval $(1) $(CMUCL_EXIT)
ECL_COMMAND = LC_CTYPE=$(LC_CTYPE) $(ECL) $(ECL_FLAGS) -eval $(DECLAIMS) -eval $(COMPILES) $(ECL_EXIT) eval_with_ecl = LC_CTYPE=$(LC_CTYPE) $(ECL) $(ECL_FLAGS) -eval $(DECLAIMS) -eval $(1) $(ECL_EXIT)
GCL_COMMAND = LC_CTYPE=$(LC_CTYPE) $(GCL) $(GCL_FLAGS) -eval $(DECLAIMS) -eval $(COMPILES) $(GCL_EXIT) eval_with_gcl = LC_CTYPE=$(LC_CTYPE) $(GCL) $(GCL_FLAGS) -eval $(DECLAIMS) -eval $(1) $(GCL_EXIT)
CCL_COMMAND = LC_CTYPE=$(LC_CTYPE) $(CCL) $(CCL_FLAGS) --eval $(DECLAIMS) --eval $(COMPILES) $(CCL_EXIT) eval_with_ccl = LC_CTYPE=$(LC_CTYPE) $(CCL) $(CCL_FLAGS) --eval $(DECLAIMS) --eval $(1) $(CCL_EXIT)
OPENMCL_COMMAND = LC_CTYPE=$(LC_CTYPE) $(OPENMCL) $(OPENMCL_FLAGS) --eval $(DECLAIMS) --eval $(COMPILES) $(OPENMCL_EXIT) eval_with_openmcl = LC_CTYPE=$(LC_CTYPE) $(OPENMCL) $(OPENMCL_FLAGS) --eval $(DECLAIMS) --eval $(1) $(OPENMCL_EXIT)
SBCL_COMMAND = LC_CTYPE=$(LC_CTYPE) $(SBCL) $(SBCL_FLAGS) --eval $(DECLAIMS) --eval $(COMPILES) $(SBCL_EXIT) eval_with_sbcl = LC_CTYPE=$(LC_CTYPE) $(SBCL) $(SBCL_FLAGS) --eval $(DECLAIMS) --eval $(1) $(SBCL_EXIT)
ABCL_COMMAND = $(call eval_with_abcl,$(COMPILES))
ALLEGRO_COMMAND = $(call eval_with_allegro,$(COMPILES))
CLISP_COMMAND = $(call eval_with_clisp,$(COMPILES))
CMUCL_COMMAND = $(call eval_with_cmucl,$(COMPILES))
ECL_COMMAND = $(call eval_with_ecl,$(COMPILES))
GCL_COMMAND = $(call eval_with_gcl,$(COMPILES))
CCL_COMMAND = $(call eval_with_ccl,$(COMPILES))
OPENMCL_COMMAND = $(call eval_with_openmcl,$(COMPILES))
SBCL_COMMAND = $(call eval_with_sbcl,$(COMPILES))
all:: show-compilers all:: show-compilers
...@@ -233,7 +243,7 @@ compile-with-$(CCL): ...@@ -233,7 +243,7 @@ compile-with-$(CCL):
@printf '\n\n\n\n'$(LINE) @printf '\n\n\n\n'$(LINE)
@if type -p $(CCL) >/dev/null 2>&1 ; then \ @if type -p $(CCL) >/dev/null 2>&1 ; then \
echo ';;;; Compiling with Clozure Common Lisp' ;\ echo ';;;; Compiling with Clozure Common Lisp' ;\
"$(CCL_COMMAND)" ;\ $(CCL_COMMAND) ;\
fi fi
compile-with-$(OPENMCL): compile-with-$(OPENMCL):
......
...@@ -41,215 +41,217 @@ ...@@ -41,215 +41,217 @@
(defgrammar lua (defgrammar lua
:trace nil :trace nil
:scanner lua-scanner :scanner lua-scanner
:terminals ((number "[0-9]+") :terminals ((number "[0-9]+")
(string "\"[^\"]*\"") (string "\"[^\"]*\"")
(name "[_A-Za-z][_A-Za-z0-9]*")) (name "[_A-Za-z][_A-Za-z0-9]*"))
:start chunk :start chunk
:rules ( :rules (
(--> chunk ;; (--> chunk
block) ;; block)
(--> chunk
(--> block exp)
(seq (rep stat) (opt retstat)))
(--> block
(--> stat (seq (rep stat) (opt retstat)))
(alt ";"
(seq varlist "=" explist) (--> stat
(seq functioncall) (alt ";"
(seq label) (seq varlist "=" explist)
(seq "break") (seq functioncall)
(seq "goto" Name) (seq label)
(seq "do" block "end") (seq "break")
(seq "while" exp "do" block "end") (seq "goto" Name)
(seq "repeat" block "until" exp) (seq "do" block "end")
(seq "if" exp "then" block (rep "elseif" exp "then" block) (opt "else" block) "end") (seq "while" exp "do" block "end")
(seq "repeat" block "until" exp)
(seq "for" Name (alt for-name-= (seq "if" exp "then" block (rep "elseif" exp "then" block) (opt "else" block) "end")
for-namelist))
(seq "for" Name (alt for-name-=
(seq "function" funcname funcbody) for-namelist))
(seq "local"
(alt (seq "function" Name funcbody) (seq "function" funcname funcbody)
(seq namelist (opt "=" explist)))))) (seq "local"
(alt (seq "function" Name funcbody)
(--> for-name-= (seq namelist (opt "=" explist))))))
(seq "=" exp "," exp (opt "," exp) "do" block "end"))
(--> for-namelist (--> for-name-=
(seq namelist-cont "in" explist "do" block "end")) (seq "=" exp "," exp (opt "," exp) "do" block "end"))
(--> for-namelist
(--> retstat (seq namelist-cont "in" explist "do" block "end"))
(seq "return" (opt explist) (opt ";")))
(--> retstat
(--> label (seq "return" (opt explist) (opt ";")))
(seq "::" Name "::"))
(--> label
(--> funcname (seq "::" Name "::"))
(seq Name (rep (seq "." Name)) (opt (seq ":" Name))))
(--> funcname
(--> varlist (seq Name (rep (seq "." Name)) (opt (seq ":" Name))))
(seq var (rep (seq "," var))))
(--> varlist
(--> namelist (seq var (rep (seq "," var))))
(seq Name namelist-cont))
(--> namelist
(--> namelist-cont (seq Name namelist-cont))
(rep (seq "," Name)))
(--> namelist-cont
(--> explist (rep (seq "," Name)))
(seq exp (rep (seq "," exp))))
(--> explist
#-(and) (seq exp (rep (seq "," exp))))
(--> exp
(alt "nil" #-(and)
"false" (--> exp
"true" (alt "nil"
Number "false"
String "true"
"..." Number
functiondef String
prefixexp "..."
tableconstructor functiondef
(seq exp binop exp) prefixexp
(seq unop exp))) tableconstructor
(seq exp binop exp)
(--> exp disjonction) (seq unop exp)))
(--> disjonction
(seq conjonction (rep "or" conjonction))) (--> exp disjonction)
(--> conjonction (--> disjonction
(seq comparaison (rep "and" comparaison))) (seq conjonction (rep "or" conjonction)))
(--> comparaison (--> conjonction
(seq concatenation (rep (alt "<" ">" "<=" ">=" "~=" "==") concatenation))) (seq comparaison (rep "and" comparaison)))
(--> concatenation (--> comparaison
(seq summation (rep ".." summation))) (seq concatenation (rep (alt "<" ">" "<=" ">=" "~=" "==") concatenation)))
(--> summation (--> concatenation
(seq term (rep (alt "+" "-") term))) (seq summation (rep ".." summation)))
(--> term (--> summation
(seq factor (rep (alt "*" "/" "%") factor))) (seq term (rep (alt "+" "-") term)))
(--> factor (--> term
(seq (opt (alt "not" "#" "-")) exponentiation)) (seq factor (rep (alt "*" "/" "%") factor)))
(--> exponentiation (--> factor
(seq simple (rep "^" simple))) (seq (opt (alt "not" "#" "-")) exponentiation))
(--> simple (--> exponentiation
(alt (seq simple (rep "^" simple)))
"nil" (--> simple
"false" (alt
"true" "nil"
Number "false"
String "true"
"…" Number
functiondef String
prefixexp "…"
tableconstructor)) functiondef
prefixexp
tableconstructor))
#-(and)
(--> prefixexp
(alt var #-(and)
functioncall (--> prefixexp
"(" exp ")")) (alt var
#-(and) functioncall
(--> var "(" exp ")"))
(alt Name #-(and)
(seq prefixexp "[" exp "]") (--> var
(seq prefixexp "." Name)) ) (alt Name
(seq prefixexp "[" exp "]")
#-(and) (seq prefixexp "." Name)) )
(--> functioncall
(alt (seq prefixexp args) #-(and)
(seq prefixexp ":" Name args))) (--> functioncall
(alt (seq prefixexp args)
#-(and) (seq prefixexp ":" Name args)))
(--> callpart
(seq (opt (seq ":" name)) args)) #-(and)
(--> callpart
(--> indexpart (seq (opt (seq ":" name)) args))
(alt (seq "[" exp "]")
(seq "." Name))) (--> indexpart
(alt (seq "[" exp "]")
#-(and) (seq "." Name)))
(--> prefixexp
(alt #-(and)
(seq (alt Name (--> prefixexp
(seq "(" exp ")")) (alt
(rep (alt callpart (seq (alt Name
indexpart))))) (seq "(" exp ")"))
;; TODO: (rep (alt callpart
(--> prefixexp indexpart)))))
"prefix") ;; TODO:
(--> prefixexp
;; TODO: "prefix")
(--> var
Name) ;; TODO:
(--> var
;; TODO: Name)
(--> functioncall
(seq "funcall" Name "(" exp ")")) ;; TODO:
(--> functioncall
(seq "funcall" Name "(" exp ")"))
(--> args
(alt (seq "(" (opt explist) ")" )
tableconstructor (--> args
String) ) (alt (seq "(" (opt explist) ")" )
tableconstructor
(--> functiondef String) )
"function" funcbody)
(--> functiondef
(--> funcbody "function" funcbody)
(seq "(" (opt parlist) ")" block "end"))
(--> funcbody
(--> parlist (seq "(" (opt parlist) ")" block "end"))
(alt (seq namelist (opt "," "..."))
"...")) (--> parlist
(alt (seq namelist (opt "," "..."))
(--> tableconstructor "..."))
(seq "{" (opt fieldlist) "}"))
(--> tableconstructor
(--> fieldlist (seq "{" (opt fieldlist) "}"))
(seq field (rep fieldsep field) (opt fieldsep)))
(--> fieldlist
(--> field (seq field (rep fieldsep field) (opt fieldsep)))
(alt (seq "[" exp "]" "=" exp )
(seq Name "=" exp) (--> field
exp)) (alt (seq "[" exp "]" "=" exp )
(seq Name "=" exp)
(--> fieldsep exp))
(alt ","
";")) (--> fieldsep
(alt ","
#-(and) ";"))
(--> binop
(alt "+" #-(and)
"-" (--> binop
"*" (alt "+"
"/" "-"
"^" "*"
"%" "/"
".." "^"
"%"
"<" ".."
"<="
">" "<"
">=" "<="
"==" ">"
"~=" ">="
"=="
"~="
"and" "and"
"or")) "or"))
#-(and) #-(and)
(--> unop (--> unop
(alt "-" (alt "-"
"not" "not"
"#")))) "#"))))
......
...@@ -117,7 +117,7 @@ ...@@ -117,7 +117,7 @@
;;; LUA Scanner ;;; LUA Scanner
;;; ;;;
(defclass lua-scanner (scanner) (defclass lua-scanner (buffered-scanner)
((keep-comments :accessor lua-scanner-keep-comments ((keep-comments :accessor lua-scanner-keep-comments
:initform nil :initform nil
:initarg :keep-comments :initarg :keep-comments
...@@ -593,4 +593,3 @@ when NIL, comments are skipped as spaces.")) ...@@ -593,4 +593,3 @@ when NIL, comments are skipped as spaces."))
(invalid-char ch)))))))) (invalid-char ch))))))))
;;;; THE END ;;;; ;;;; THE END ;;;;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
;;;;USER-INTERFACE: NONE ;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION ;;;;DESCRIPTION
;;;; ;;;;
;;;; Compile the com.informatimago.common-lisp libraries with ASDF. ;;;; Register the com.informatimago.common-lisp systems with ASDF.
;;;; ;;;;
;;;;AUTHORS ;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com> ;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
...@@ -36,10 +36,11 @@ ...@@ -36,10 +36,11 @@
(in-package "COMMON-LISP-USER") (in-package "COMMON-LISP-USER")
(defvar *asdf-source* (defvar *asdf-source*
#p"/data/lisp/packages/net/common-lisp/projects/asdf/asdf/asdf.lisp") (truename (merge-pathnames (make-pathname :name "ASDF" :type "LISP" :case :common)
*load-pathname*)))
(defvar *asdf-binary-locations-directory* ;; (defvar *asdf-binary-locations-directory*
#p"/data/lisp/packages/net/common-lisp/projects/asdf-binary-locations/asdf-binary-locations/") ;; #p"/data/lisp/packages/net/common-lisp/projects/asdf-binary-locations/asdf-binary-locations/")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
...@@ -83,7 +84,7 @@ ...@@ -83,7 +84,7 @@
#+has-asdf-enable-asdf-binary-locations-compatibility #+has-asdf-enable-asdf-binary-locations-compatibility
(progn (progn
(format *trace-output* "enable-asdf-binary-locations-compatibility ~%") (format *trace-output* "~&enable-asdf-binary-locations-compatibility ~%")
(asdf:enable-asdf-binary-locations-compatibility (asdf:enable-asdf-binary-locations-compatibility
:centralize-lisp-binaries t :centralize-lisp-binaries t
:default-toplevel-directory (merge-pathnames (format nil ".cache/common-lisp/~A/" (hostname)) :default-toplevel-directory (merge-pathnames (format nil ".cache/common-lisp/~A/" (hostname))
...@@ -95,14 +96,14 @@ ...@@ -95,14 +96,14 @@
;; We need (truename (user-homedir-pathname)) because in cmucl (user-homedir-pathname) ;; We need (truename (user-homedir-pathname)) because in cmucl (user-homedir-pathname)
;; is a search path, and that cannot be merged... ;; is a search path, and that cannot be merged...
#-has-asdf-enable-asdf-binary-locations-compatibility ;; #-has-asdf-enable-asdf-binary-locations-compatibility
(progn ;; (progn
(push-asdf-repository *asdf-binary-locations-directory*) ;; (push-asdf-repository *asdf-binary-locations-directory*)
(asdf-load :asdf-binary-locations)) ;; (asdf-load :asdf-binary-locations))
#-has-asdf-enable-asdf-binary-locations-compatibility #-has-asdf-enable-asdf-binary-locations-compatibility
(progn (progn
(format *trace-output* "enable-asdf-binary-locations-compatibility ~%") (format *trace-output* "~&enable-asdf-binary-locations-compatibility ~%")
(setf asdf:*centralize-lisp-binaries* t (setf asdf:*centralize-lisp-binaries* t
asdf:*include-per-user-information* nil asdf:*include-per-user-information* nil
asdf:*default-toplevel-directory* asdf:*default-toplevel-directory*
...@@ -112,7 +113,7 @@ ...@@ -112,7 +113,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Compiling com.informatimago.common-lisp ;;; Registering com.informatimago.common-lisp systems.
;;; ;;;
...@@ -161,7 +162,6 @@ ...@@ -161,7 +162,6 @@
:test (function equalp)) :test (function equalp))
asdf:*central-registry*)) asdf:*central-registry*))
(asdf-load :com.informatimago.common-lisp)
;;;; THE END ;;;; ;;;; 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