I need to write a numeric list to a file and put a return at the end of the line.
I have tried with this code but work only for the first element of the list.
(defun write-segment (filename segment)
(cond ((null segment)
(with-open-file (out filename
:direction :output
:if-exists :append
:if-does-not-exist :create)
(format out "~%")))
(T (with-open-file (out filename
:direction :output
:if-exists :append
:if-does-not-exist :create)
(format out "~D " (first segment))
(write-segment filename (cdr segment))))))
Some one can help me to resolve this problem?
What about of appending % to the stream like this:
(with-open-file (str "filename.txt"
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(format str "~A~%" '(1 2 3 4 5)))
In your case I will do something like go througth the list and write to the stream, some thing like this, be carefull with the extra return, also you can add a control before opening the file if yuo do not want to make anything if the list is empty.
(defun write-non-empty-list-to-a-file (file-name lst)
"writes a non empty list to a file if the list is empty creates the file with a return"
(with-open-file (str file-name
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(dolist (e lst)
(format str "~A~%" e))
(format str "~%")));this if you want an extra return
From the description and the code, I am not 100% sure if the following fits what you are after, but I will try anyway. The code in this snippet walks a list of numerical values and writes them to an output file:
(defun write-numeric-list(filename l)
(with-open-file (out filename :direction :output :if-exists :append :if-does-not-exist :create)
(dolist (segment l)
(format out "~D " segment))
(format out "~%")))
Sample call:
(write-numeric-list "output.txt" (list 1 2 -42))
This code opens the output file only once for the entire list, instead of once for each element of the list, as in the original version. You may want to adjust the :if-exists and :if-does-not-exist options depending on preconditions in your particular situation.
In fact, format can walk a list just by its own, using slightly advanced format control strings. Those control strings aren't everybody's cup of tea, but for reference, here is a version of the code using them:
(defun write-numeric-list(filename l)
(with-open-file (out filename :direction :output :if-exists :append :if-does-not-exist :create)
(format out "~{~D ~}~%" l)))
Related
I'm trying to fully understand the limitations of compile-time macros.
Here is a macro (I'm fully aware that this is not a best-practice macro):
(defmacro emit (language file &body body)
(print language)
(print file)
(print body)
(with-open-file (str file :direction :output :if-exists :supersede)
(princ (cond ((eq language 'html)
(cl-who:with-html-output-to-string (s nil :prologue t :indent t) body))
((eq language 'javascript)
(parenscript:ps body))
((eq language 'json)
(remove #\; (parenscript:ps body))))
str)))
I compile the macro:
; processing (DEFMACRO EMIT ...)
PROGRAM>
I compile this form:
PROGRAM> (compile nil (lambda () (emit json "~/file" (ps:create "hi" "hello") (ps:create "yo" "howdy"))))
JSON
"~/file"
((PARENSCRIPT:CREATE "hi" "hello") (PARENSCRIPT:CREATE "yo" "howdy"))
#<FUNCTION (LAMBDA ()) {5367482B}>
NIL
NIL
PROGRAM>
The compile-time print output is what I expect.
However, if I look at ~/file:
body
It appears that ((PARENSCRIPT:CREATE "hi" "hello") (PARENSCRIPT:CREATE "yo" "howdy")) was never substituted in for the parameter body, and thus never processed.
Why is this?
& what would be the best literature to read on this subject?
Why should it substitute? You never substituted anything.
A macro defines a macro substitution function, which is applied to the actual form in the code to produce another form which is then compiled. When you apply your macro definition to those parameters, it will at macroexpansion time do all kinds of things (write a file etc.) before returning what princ returned, which is exactly its first argument, and this returned form is then compiled. I don't think that is what you want.
It seems that what you actually want to do is to expand to a form that interprets the body in one of a variety of ways, indicated by the first argument.
What you need to do is to return the new form, so that
(emit 'html "foo.html"
(:html (:head) (:body "whatever")))
expands to
(with-open-file (str "foo.html" :direction :output :etc :etc)
(cl-who:with-html-output (str)
(:html (:head) (:body "whatever")))
For that, we have a template syntax: the backtick.
`(foo ,bar baz)
means the same as
(list 'foo bar 'baz)
but makes the structure of transformed code a bit clearer. There is also ,# to splice things into a list.
`(foo ,#bar)
means the same as
(list* 'foo bar)
i. e. the contents of bar, when they are a list, are spliced into the list. This is especially useful for bodies such as in your macro.
(defmacro emit (language file &body body)
`(with-open-file (str ,file :direction :output :if-exists :supersede)
(princ (cond ((eq ,language 'html)
(cl-who:with-html-output-to-string (s nil :prologue t :indent t)
,#body))
((eq ,language 'javascript)
(parenscript:ps ,#body))
((eq ,language 'json)
(remove #\; (parenscript:ps ,#body))))
str)))
Note where I introduced the backtick to create a template and commata to put outer arguments into it. Note also that the arguments are forms.
This has a few problems: there are hardcoded symbols that the user of the macro has no way of knowing. In one case (str) they have to pay attention not to shadow it, in the other (s) they have to know it in order to write to it. For this, we use either generated symbols (for str so that there is no conflict possible) or let the user say what they want to name it (for s). Also, this cond can be simplified to a case:
(defmacro emit (language file var &body body)
(let ((str (gensym "str")))
`(with-open-file (,str ,file
:direction :output
:if-exists :supersede)
(princ (case ,language
('html
(cl-who:with-html-output-to-string (,var nil
:prologue t
:indent t)
,#body))
('javascript
(parenscript:ps ,#body))
('json
(remove #\; (parenscript:ps ,#body))))
,str)))
However, you might want to determine the output code already at macro expansion time.
(defmacro emit (language file var &body body)
(let ((str (gensym "str")))
`(with-open-file (,str ,file
:direction :output
:if-exists :supersede)
(princ ,(case language
('html
`(cl-who:with-html-output-to-string (,var nil
:prologue t
:indent t)
,#body))
('javascript
`(parenscript:ps ,#body))
('json
`(remove #\; (parenscript:ps ,#body))))
,str)))
Here, you can see that the case form is already evaluated at macro expansion time, and an inner template is then used to create the inner form.
This is all completely untested, so removing the little errors is left as an exercise ^^.
One book that has a lot of things to say about macro writing is »On Lisp« by Paul Graham. The freely available »Practical Common Lisp« by Peter Seibel also has a chapter about it, and there are also some recipes in »Common Lisp Recipes« by Edi Weitz.
parenscript:ps is a macro, not a function: its body is literal parenscript and is not evaluated but compiled, from Parenscript to JavaSctipt. This is easy to check:
> (parenscript:ps body)
"body;"
I don't have any advice on what you should read: this macro looks so utterly confused I can't really understand what the underlying intent was. A macro in CL is a function which whose argument is source code in some language L1 and which returns source code in some language L2, where L2 is usually a subset of L1. I can't work out, though, if this is just the normal case of someone thinking they need a macro when they need a function, or if it's some other confusion.
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.
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 tried to wrap a lisp expression by another lisp expression. I guess, a macro should do it, but I don't get the trick. Can someone help me, who knows how to do it?
My actual aim is to write a macro which wraps a batch of with-open-file expressions around some macro-body code.
(I want to write a script/program, which opens one or two input files, process them line by line, but also outputs the processing result in several different independent output files. For that I would love to have the with-open-file macro calls piled up around the code which processes and writes to the independent output files - all opened for the macro-body code).
Since the with-open-file requires a symbol (handler) for the input or output stream and the path variable to the output (or input) file, and some additional information (direction of the file etc.), I want to put them into lists.
;; Output file-paths:
(defparameter *paths* '("~/out1.lisp" "~/out2.lisp" "~/out3.lisp"))
;; stream handlers (symbols for the output streams)
(defparameter *handlers* '(out1 out2 out3))
;; code which I would love to execute in the body
(print "something1" out1)
(print "something2" out2)
(print "something3" out3)
How I would love the macro to be called:
(with-open-files (*handlers* *paths* '(:direction :output :if-exists :append))
;; the third macro argument should be what should be passed to the
;; individual `with-open-file` calls
;; and it might be without `quote`-ing or with `quote`-ing
;; - is there by the way a good-practice for such cases? -
;; - is it recommended to have `quote`-ing? Or how would you do that? -
;; and then follows the code which should be in the macro body:
(print "something1" out1)
(print "something2" out2)
(print "something3" out3))
To what the macro call should expand:
(with-open-file (out1 "~/out1.lisp" :direction :output :if-exists :append)
(with-open-file (out2 "~/out2.lisp" :direction :output :if-exists :append)
(with-open-file (out3 "~/out3.lisp" :direction :output :if-exists :append)
(print "something1" out1)
(print "something2" out2)
(print "something3" out3))))
As one step, I thought I have to make an s-expression wrap another s-expression.
My first question was: How to wrap an s-expression by another s-expression? But I just couldn't manage it already at this point.
All I could do was to write a function which just spills out an un-executed expression. How to write a macro which does the same but also executes the code after expanding it in this way?
(defun wrap (s-expr-1 s-expr-2)
(append s-expr-1 (list s-expr-2)))
(wrap '(func1 arg1) '(func2 arg2))
;; => (FUNC1 ARG1 (FUNC2 ARG2))
(wrap '(with-open-files (out1 "~/out1.lisp" :direction :output :if-exists :append))
'(with-open-files (out2 "~/out2.lisp" :direction :output :if-exists :append)
(print "something1" out1)
(print "something2" out2)
(print "something3" out3)))
Which gives:
(WITH-OPEN-FILES (OUT1 "~/out1.lisp" :DIRECTION :OUTPUT :IF-EXISTS :APPEND)
(WITH-OPEN-FILES (OUT2 "~/out2.lisp" :DIRECTION :OUTPUT :IF-EXISTS :APPEND)
(PRINT "something1" OUT1)
(PRINT "something2" OUT2)
(PRINT "something3" OUT3)))
In this way, applying wrap function successively, looping over the input-lists, I could build the code maybe ...
However, these functions would generate only code but don't execute it.
And I would be forced at the end to use the eval function to evaluate the built code ... (But somehow I know this shouldn't be done like this. And I just didn't really understood how to write macros which do such things ... Actually, macros are there for solving exactly such problems ... )
With the execution, I just came into big trouble. And since one cannot call funcall or apply on macros (instead of function-names) I don't see an obvious solution. Did someone had experience with such kind of situations?
And when accomplished wrapping an s-expression in a macro by another s-expression and let it be evaluated, the next question would be, how to process the list to let the code to expand to the desired code and then be evaluated? I just tried hours and didn't came far.
I need help from someone who has experience to write such kind of macros ...
Please note that in Lisp, "handler" is normally a function, not a symbol. Your naming is confusing.
Static
If you are generating code, you should use macros, not functions.
This assumes that you know at compile time what files and stream
variable you will use:
The simplest approach is to use recursion:
(defmacro with-open-files ((streams file-names &rest options &key &allow-other-keys) &body body)
(if (and streams file-names)
`(with-open-file (,(pop streams) ,(pop file-names) ,#options)
(with-open-files (,streams ,file-names ,#options)
,#body))
`(progn ,#body)))
Test:
(macroexpand-1
'(with-open-files ((a b c) ("f" "g" "h") :direction :output :if-exists :supersede)
(print "a" a)
(print "b" b)
(print "c" c)))
==>
(WITH-OPEN-FILE (A "f" :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(WITH-OPEN-FILES ((B C) ("g" "h") :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(PRINT "a" A) (PRINT "b" B) (PRINT "c" C)))
(macroexpand-1
'(with-open-files ((a) ("f") :direction :output :if-exists :supersede)
(print "a" a)))
==>
(WITH-OPEN-FILE (A "f" :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(WITH-OPEN-FILES (NIL NIL :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(PRINT "a" A)))
(macroexpand-1
'(with-open-files (nil nil :direction :output :if-exists :supersede)
(print nil)))
==>
(PROGN (PRINT NIL))
Dynamic
If you do not know at compile time what the streams and files are, e.g.,
they are stored in the *handler* variable, you cannot use the simple
macro above - you will have to roll your own using
progv for binding and
gensym to avoid variable
capture. Note how the let inside backtick avoids multiple
evaluation (i.e., arguments streams, file-names and options are to
be evaluated once, not multiple times):
(defmacro with-open-files-d ((streams file-names &rest options &key &allow-other-keys) &body body)
(let ((sv (gensym "STREAM-VARIABLES-"))
(so (gensym "STREAM-OBJECTS-"))
(ab (gensym "ABORT-"))
(op (gensym "OPTIONS-")))
`(let* ((,sv ,streams)
(,ab t)
(,op (list ,#options))
(,so (mapcar (lambda (fn) (apply #'open fn ,op)) ,file-names)))
(progv ,sv ,so
(unwind-protect (multiple-value-prog1 (progn ,#body) (setq ,ab nil))
(dolist (s ,so)
(when s
(close s :abort ,ab))))))))
(macroexpand-1
'(with-open-files-d ('(a b c) '("f" "g" "h") :direction :output :if-exists :supersede)
(print "a" a)
(print "b" b)
(print "c" c)))
==>
(LET* ((#:STREAM-VARIABLES-372 '(A B C))
(#:ABORT-374 T)
(#:OPTIONS-375 (LIST :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE))
(#:STREAM-OBJECTS-373
(MAPCAR (LAMBDA (FN) (APPLY #'OPEN FN #:OPTIONS-375)) '("f" "g" "h"))))
(PROGV
#:STREAM-VARIABLES-372
#:STREAM-OBJECTS-373
(UNWIND-PROTECT
(MULTIPLE-VALUE-PROG1 (PROGN (PRINT "a" A) (PRINT "b" B) (PRINT "c" C))
(SETQ #:ABORT-374 NIL))
(DOLIST (S #:STREAM-OBJECTS-373)
(WHEN S
(CLOSE S :ABORT #:ABORT-374))))))
Here both stream variables and file list are evaluated at run time.
Important
An important practical note here is that the static version is more robust in that it guarantees that all streams are closed, while the dynamic version will fail to close remaining streams if, say, the first close raises an exception (this can be fixed, but it is not trivial: we cannot just ignore-errors because they should in fact be reported, but which error should be reported? &c &c).
Another observation is that if your list of stream variables is not known at compile time, the code in the body that uses them will not be compiled correctly (the variables will be compiled with dynamic binding &c) indicated by undefined-variable compile-time warnings.
Basically, the dynamic version is an exercise in macrology, while the static version is what you should use in practice.
Your specific case
If I understood your requirements correctly, you can do something like
this (untested!):
(defun process-A-line (line stream)
do something with line,
stream is an open output stream)
(defun process-file (input-file processors)
"Read input-file line by line, calling processors,
which is a list of lists (handler destination ...):
handler is a function like process-A-line,
destination is a file name and the rest is open options."
(with-open-file (inf input-file)
(let ((proc-fd (mapcar (lambda (p)
(cons (first p)
(apply #'open (rest p))))
processors))
(abort-p t))
(unwind-protect
(loop for line = (read-line inf nil nil)
while line
do (dolist (p-f proc-fd)
(funcall (car p-f) line (cdr p-f)))
finally (setq abort-p nil))
(dolist (p-f proc-fd)
(close (cdr p-f) :abort abort-p))))))
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)))