In Common Lisp, how can one read & write symbolic expressions from/to streams? For example, I might want to write an anonymous function to file and then read and funcall it:
;;; sexp-io.lisp
;;; Try writing a sexp to file and reading it back in
(with-open-file (file "~/Documents/Lisp/Concurrency/sexp.lisp"
:direction :output :if-exists :supersede)
(print #'(lambda () (+ 1 1)) file))
(with-open-file (file "~/Documents/Lisp/Concurrency/sexp.lisp"
:direction :input)
(read file))
However, that code results in dubious output
#<Anonymous Function #x3020018F950F>
which does result in an error when I try reading it back in:
> Error: Reader error on #<BASIC-FILE-CHARACTER-INPUT-STREAM ("/Users/frank/Documents/Lisp/Concurrency/sexp.lisp"/7 UTF-8) #x3020018F559D>, near position 3, within "
> #<Anonymous ":
> "#<" encountered.
> While executing: CCL::SIGNAL-READER-ERROR, in process Listener(4).
You are doing TRT, except for #' which turns the list (lambda () (+ 1 1)) into a function object. Just replace the sharp-quote (which is read as function) with a simple quote (which is read as quote) and it should work.
Another change you might want to make is replacing print with write with argument :readably t:
(write my-object :stream out :readably t)
The benefit of :readably is that it fails if it cannot write in a way that will preserve print-read consistency.
Related
i want to use if-exits but dont know how to,add gives error,
-when i try overwrite it changes the file
(defun writeToFile (filename content)
(with-open-file (stream filename :external-format charset:iso-8859-1
:direction :output
;if-exists :add
:if-does-not-exist :create )
(format stream content)
(terpri stream)))
(loop for i from x to y
do (if (= (is_me i) 0)
(format t "i = ~d ~%" i)
(writeToFile "/home/out.txt"
(concatenate 'string (write-to-string i) " is me" )))
do (if (ime i)
(format t "~d IS ME~%" i)
(writeToFile "/home/out.txt"
(concatenate 'string (write-to-string i) " is me" ))))
Quick answer, you need to use :if-exists :append.
The Common Lisp HyperSpec has the following to say about open:
if-exists---one of :error, :new-version, :rename, :rename-and-delete, :overwrite, :append, :supersede, or nil. The default is :new-version if the version component of filespec is :newest, or :error otherwise.
And if we look at what it says about :append:
:append
Output operations on the stream destructively modify the existing file. The file pointer is initially positioned at the end of the file. If direction is :io, the file is opened in a bidirectional mode that allows both reading and writing.
This question is really about my lack of understanding of restarts.
In the encoder for cl-json there exists a tempting macro I would like to use
with-substitute-printed-representation-restart
But alas I do not quite understand how.
This
(cl-json::encode-json-plist (list :boo "boo" :foo "foo"))
returns
{"boo":"boo","foo":"foo"}
This
(cl-json::encode-json-plist (list :boo "boo" :foo (lambda (a b) (+ a b))))
signals an UNENCODABLE-VALUE-ERROR
I would like to restart from that point where cl-json finds the function and have it return
something of my choosing when it runs into that adding lambda I included in the list.
(defun my-func ()
(handler-bind ((cl-json::UNENCODABLE-VALUE-ERROR
#'(lambda (e) (invoke-restart 'return-default))))
(myencode (list :boo "boo" :foo (lambda (a b) (+ a b))))
)
)
(defun myencode (alist)
(restart-case
(cl-json::encode-json-plist-to-string alist)
(return-default () :report "Just return a default could not do this string" "barf")
)
)
returns "barf"
I want it to return
{"boo":"boo","foo":"barf"}
How do I use that macro do to this?
In other words I want the restart to happen where the error was thrown not where the error was caught. Can I do that?
I don't understand if the doc is wrong or if I am reading the code badly, but there should already be a restart available whenever an object cannot be encoded. If you redefined cl-json default method for encode-json as follows, then you have a restart.
(defmethod encode-json (anything &optional (stream *json-output*))
"If OBJECT is not handled by any specialized encoder signal an error
which the user can correct by choosing to encode the string which is
the printed representation of the OBJECT."
(with-substitute-printed-representation-restart (anything stream)
(unencodable-value-error anything 'encode-json)))
By the way you could redefine so that the restart accepts an argument, the string to print instead:
(defmethod encode-json (anything &optional (stream *json-output*))
"If OBJECT is not handled by any specialized encoder signal an error
which the user can correct by choosing to encode the string which is
the printed representation of the OBJECT."
(with-substitute-printed-representation-restart (anything stream)
(restart-case (unencodable-value-error anything 'encode-json)
(use-value (v)
:report "Use a different encoding"
(check-type v string)
(write v :stream stream :escape t)))))
For example:
CL-USER> (handler-bind
((json:unencodable-value-error
(lambda (err)
(declare (ignore err))
(invoke-restart 'use-value "UNKNOWN"))))
(json:encode-json
`(((foo . ,#'print) (bar . "baz")))))
[{"foo":"UNKNOWN","bar":"baz"}]
You may want to ask directly the author of the library
How do I set up binary pipes on the stdin and stdout of the subprocess using sb-ext:run-program? I'd like to have streams with element-type (unsigned-byte 8) to talk to the subprocess in Lisp.
run-program takes an :external-format argument but as far as I can tell it's only about text encodings, not binary. SBCL ships with a test program that does binary I/O but it defines a custom stream class using Gray streams, which seems advanced enough that there has to be an easier way.
Normally, sb-ext:run-program is responsible for creating intermediate streams when you pass the :stream option. The other answer shows that you can directly write bytes to it if you want to. But If you inspect how run-program is implemented, you can build the streams yourself by using the same functions called by run-program to generate an intermediate unix pipe, and read/write to it using binary streams.
(defpackage :so (:use :cl :alexandria))
(in-package :so)
Define an auxiliary function that closes a file descriptor while handling errors as warnings:
(defun unix-close/warn-on-error (file-descriptor)
(multiple-value-bind (status error) (sb-unix:unix-close file-descriptor)
(prog1 status
(unless (eql error 0)
(warn "Unix close error: ~S" error)))))
Then, a macro that temporarily create a unix pipe:
(defmacro with-unix-pipe ((read-fd write-fd) &body body)
(with-gensyms (first second)
`(multiple-value-bind (,first ,second) (sb-unix:unix-pipe)
(if ,first
(unwind-protect
(multiple-value-bind (,read-fd ,write-fd)
(values ,first ,second)
,#body)
(unix-close/warn-on-error ,first)
(unix-close/warn-on-error ,second))
(error "Unix pipe error: ~s" ,second)))))
However, run-program expects streams, not file descriptors. Here you have a macro that binds a variable to a stream tied to a file descriptor:
(defmacro with-fd-stream% ((var fd direction &rest fd-args) &body body)
(check-type direction (member :output :input))
(with-gensyms (in%)
`(let ((,in% (sb-sys:make-fd-stream ,fd ,direction t ,#fd-args)))
(unwind-protect (let ((,var ,in%))
(declare (dynamic-extent ,var))
,#body)
(close ,in%)))))
And the macro that does the same for a pair if in/out file descriptors:
(defmacro with-fd-streams (((in read-fd &rest read-args)
(out write-fd &rest write-args))
&body body)
`(with-fd-stream% (,in ,read-fd :input ,#read-args)
(with-fd-stream% (,out ,write-fd :output ,#write-args)
,#body)))
Finally, you can test your code with the following:
(let ((ub8 '(unsigned-byte 8)))
(with-unix-pipe (read write)
(with-fd-streams ((in read :element-type ub8)
(out write :element-type ub8))
(fresh-line)
(sb-ext:run-program "dd"
'("if=/dev/random" "count=1" "bs=64")
:search t
:output out
:error nil
:wait nil
:status-hook (lambda (p)
(unless (sb-ext:process-alive-p p)
(close out))))
(sb-ext:run-program "hd"
'()
:search t
:input in
:output *standard-output*
:wait t))))
The first test that you linked already seems to show that you can simply send bytes to the streams created with :input :stream and :output :stream.
I'd suggest using uiop:launch-program instead for portability:
(let ((pri (uiop:launch-program "cat" :input :stream :output :stream)))
(write-byte 43 (uiop:process-info-input pri))
(force-output (uiop:process-info-input pri))
(read-byte (uiop:process-info-output pri)))
=> 43
I'm trying to write a racket reader extension procedure that disables the special treatment of the pipe character |.
I have two files: mylang/lang/reader.rkt to implement the lang reader and mylang/testing.rkt to try it out. I've run raco pkg install --link to install the lang.
Here is reader.rkt:
#lang s-exp syntax/module-reader
racket
#:read my-read
#:read-syntax my-read-syntax
(define (parse-pipe char in srcloc src linum colnum)
#'\|)
(define my-readtable
(make-readtable #f #\| 'terminating-macro parse-pipe))
(define (my-read-syntax src in)
(parameterize ((current-readtable my-readtable))
(read-syntax src in)))
(define (my-read in)
(syntax->datum
(my-read-syntax #f in)))
With testing.rkt like this:
#lang mylang
(define | 3)
(+ 3 2)
runs and produces 5 as expected. But this next one doesn't:
#lang mylang
(define |+ 3)
(+ |+ 2)
complaining that define: bad syntax (multiple expressions after identifier) in: (define \| + 3) which is reasonable since parse-pipe produces a syntax object, not a string, so it terminates the reading of the symbol prematurely.
One thing I can do is keep reading until the end of the symbol, but that is hackish at best because I would be reimplementing symbol parsing and it wouldn't fix the case that the symbol has the pipe char in the middle, or if | is inside a string, etc.
What I would like to do is remove the default reader procedure for | from the readtable, but I don't know how/if it can be done.
OK, I've found a way. The documentation for make-readtable says:
char like-char readtable — causes char to be parsed in the same way
that like-char is parsed in readtable, where readtable can be #f to
indicate the default readtable.
so I can make the reader read | like a normal character like a with:
(define my-readtable
(make-readtable #f #\| #\a #f))
And it works
(define hawdy|+ "hello")
(string-append hawdy|+ "|world")
; => "hello|world"
What's the lisp way of replacing a string in a file.
There is a file identified by *file-path*, a search string *search-term* and a replacement string *replace-term*.
How to make file with all instances of *search-term*s replaced with *replace-term*s, preferably in place of the old file?
One more take at the problem, but few warnings first:
To make this really robust and usable in the real-life situation you would need to wrap this into handler-case and handle various errors, like insufficient disc space, device not ready, insufficient permission for reading / writing, insufficient memory to allocate for the buffer and so on.
This does not do regular expression-like replacement, it's simple string replacement. Making a regular expression based replacement on large files may appear far less trivial than it looks like from the start, it would be worth writing a separate program, something like sed or awk or an entire language, like Perl or awk ;)
Unlike other solutions it will create a temporary file near the file being replaced and will save the data processed so far into this file. This may be worse in the sense that it will use more disc space, but this is safer because in case the program fails in the middle, the original file will remain intact, more than that, with some more effort you could later resume replacing from the temporary file if, for example, you were saving the offset into the original file in the temporary file too.
(defun file-replace-string (search-for replace-with file
&key (element-type 'base-char)
(temp-suffix ".tmp"))
(with-open-file (open-stream
file
:direction :input
:if-exists :supersede
:element-type element-type)
(with-open-file (temp-stream
(concatenate 'string file temp-suffix)
:direction :output
:element-type element-type)
(do ((buffer (make-string (length search-for)))
(buffer-fill-pointer 0)
(next-matching-char (aref search-for 0))
(in-char (read-char open-stream nil :eof)
(read-char open-stream nil :eof)))
((eql in-char :eof)
(when (/= 0 buffer-fill-pointer)
(dotimes (i buffer-fill-pointer)
(write-char (aref buffer i) temp-stream))))
(if (char= in-char next-matching-char)
(progn
(setf (aref buffer buffer-fill-pointer) in-char
buffer-fill-pointer (1+ buffer-fill-pointer))
(when (= buffer-fill-pointer (length search-for))
(dotimes (i (length replace-with))
(write-char (aref replace-with i) temp-stream))
(setf buffer-fill-pointer 0)))
(progn
(dotimes (i buffer-fill-pointer)
(write-char (aref buffer i) temp-stream))
(write-char in-char temp-stream)
(setf buffer-fill-pointer 0)))
(setf next-matching-char (aref search-for buffer-fill-pointer)))))
(delete-file file)
(rename-file (concatenate 'string file temp-suffix) file))
It can be accomplished in many ways, for example with regexes. The most self-contained way I see is something like the following:
(defun replace-in-file (search-term file-path replace-term)
(let ((contents (rutil:read-file file-path)))
(with-open-file (out file-path :direction :output :if-exists :supersede)
(do* ((start 0 (+ pos (length search-term)))
(pos (search search-term contents)
(search search-term contents :start2 start)))
((null pos) (write-string (subseq contents start) out))
(format out "~A~A" (subseq contents start pos) replace-term))))
(values))
See the implementation of rutil:read-file here: https://github.com/vseloved/rutils/blob/master/core/string.lisp#L33
Also note, that this function will replace search terms with any characters, including newlines.
in chicken scheme with the ireggex egg:
(use irregex) ; irregex, the regular expression library, is one of the
; libraries included with CHICKEN.
(define (process-line line re rplc)
(irregex-replace/all re line rplc))
(define (quickrep re rplc)
(let ((line (read-line)))
(if (not (eof-object? line))
(begin
(display (process-line line re rplc))
(newline)
(quickrep re rplc)))))
(define (main args)
(quickrep (irregex (car args)) (cadr args)))
Edit: in the above example buffering the input doesn't permit the regexp to span over
many lines.
To counter that here is an even simpler implementation which scans the whole file as one string:
(use ireggex)
(use utils)
(define (process-line line re rplc)
(irregex-replace/all re line rplc))
(define (quickrep re rplc file)
(let ((line (read-all file)))
(display (process-line line re rplc))))
(define (main args)
(quickrep (irregex (car args)) (cadr args) (caddr args)))