Skip to content
Snippets Groups Projects
Commit fb161e0f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Genera: better support lambda, add read-sequence, write-sequence.

parent 183c27f7
No related branches found
No related tags found
No related merge requests found
...@@ -8,8 +8,8 @@ ...@@ -8,8 +8,8 @@
(uiop/package:define-package :uiop/common-lisp (uiop/package:define-package :uiop/common-lisp
(:nicknames :uoip/cl :asdf/common-lisp :asdf/cl) (:nicknames :uoip/cl :asdf/common-lisp :asdf/cl)
(:use #-genera :common-lisp #+genera :future-common-lisp :uiop/package) (:use :uiop/package)
(:reexport :common-lisp) (:use-reexport #-genera :common-lisp #+genera :future-common-lisp)
(:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf) (:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf)
#+allegro (:intern #:*acl-warn-save*) #+allegro (:intern #:*acl-warn-save*)
#+cormanlisp (:shadow #:user-homedir-pathname) #+cormanlisp (:shadow #:user-homedir-pathname)
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
#:logical-pathname #:translate-logical-pathname #:logical-pathname #:translate-logical-pathname
#:make-broadcast-stream #:file-namestring) #:make-broadcast-stream #:file-namestring)
#+genera (:shadowing-import-from :scl #:boolean) #+genera (:shadowing-import-from :scl #:boolean)
#+genera (:export #:boolean #:ensure-directories-exist) #+genera (:export #:boolean #:ensure-directories-exist #:read-sequence #:write-sequence)
#+mcl (:shadow #:user-homedir-pathname)) #+mcl (:shadow #:user-homedir-pathname))
(in-package :uiop/common-lisp) (in-package :uiop/common-lisp)
...@@ -98,9 +98,20 @@ ...@@ -98,9 +98,20 @@
#+genera #+genera
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
(unless (fboundp 'lambda)
(defmacro lambda (&whole form &rest bvl-decls-and-body)
(declare (ignore bvl-decls-and-body)(zwei::indentation 1 1))
`#',(cons 'lisp::lambda (cdr form))))
(unless (fboundp 'ensure-directories-exist) (unless (fboundp 'ensure-directories-exist)
(defun ensure-directories-exist (path) (defun ensure-directories-exist (path)
(fs:create-directories-recursively (pathname path))))) (fs:create-directories-recursively (pathname path))))
(unless (fboundp 'read-sequence)
(defun read-sequence (sequence stream &key (start 0) end)
(scl:send stream :string-in nil sequence start end)))
(unless (fboundp 'write-sequence)
(defun write-sequence (sequence stream &key (start 0) end)
(scl:send stream :string-out sequence start end)
sequence)))
#.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl, so we use this trick #.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl, so we use this trick
(read-from-string (read-from-string
......
...@@ -71,7 +71,7 @@ This is designed to abstract away the implementation specific quit forms." ...@@ -71,7 +71,7 @@ This is designed to abstract away the implementation specific quit forms."
#+(or cmu scl) (unix:unix-exit code) #+(or cmu scl) (unix:unix-exit code)
#+ecl (si:quit code) #+ecl (si:quit code)
#+gcl (system:quit code) #+gcl (system:quit code)
#+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code) #+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code)
#+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t) #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
#+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ? #+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ?
#+mkcl (mk-ext:quit :exit-code code) #+mkcl (mk-ext:quit :exit-code code)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment