Madhu
4/28/2015 11:42:00 AM
* Jinsong Zhao <mhnjkl$gaa$1@dont-email.me> :
Wrote on Tue, 28 Apr 2015 17:25:38 +0800:
|>>> I want to extract the substrings underlined from the following strings
|>>> (The declaration of Fortran program or subprogram):
|>>>
|>>> " PROGRAM main"
|>>> ~~~~
|>>> " integer FUNCTION fun(x, y)"
|>>> ~~~
|>>> " SUBROUTINE sub (x1, y1)"
|>>> ~~~
|>>>
|>>> Now, I can extract it using function of search and subseq to determine
|>>> the position of those substrings. However, I think my implement may be
|>>> the bad way, if not the worst.
|>>
|>
|> I don't want to transform Fortran code to CL. I just want to split the
|> Fortran code consisted of lots of subprogram to individuals, i.e., each
|> subprogram is in a file with the file name same as the name of
|> subprogram. I don't understand how to write parser, currently.
|>
|> Now, I have written it from scratch, even though it may be ugly...
|>
|> (defun fn-p (line)
|> (and (> (length line) 6)
|> (string= " " (subseq line 0 6))
|> (or (search "PROGRAM" (string-upcase line))
|> (search "FUNCTION" (string-upcase line))
|> (search "SUBROUTINE" (string-upcase line))
|> (search "BLOCKDATA" (string-upcase line))
|> (search "BLOCK" (string-upcase line)))))
|>
|> (defun end-p (line)
|> (and (> (length line) 6)
|> (string= "END" (string-trim " " (subseq line 0 (if (> (length
|> line) 72) 72 nil))))))
|>
|> (defun fn (line)
|> (let ((fn.str nil))
|> (setf fn.str (string-trim #(#\space #\tab) (subseq line (fn-p line)
|> (position #\( line))))
|> (cond ((and (position #\space fn.str)) (setf fn.str (string-trim
|> #(#\space) (subseq fn.str (position #\space fn.str)))))
|> (t (setf fn.str "blk")))
|> (if (and (position #\space fn.str)) (setf fn.str (string-trim
|> #(#\space) (subseq fn.str (position #\space fn.str)))))
|> (concatenate 'string fn.str ".for")))
You can avoid all these string-trims by searching out the whitespace
yourself. Consider combining fn and fn-p into a single function fn-p
which returns the name of the block, I'm preserving your logic here:
(defun whitespace-p (c) (or (eql c #\Space) (eql c #\Tab)))
(defun fn-p (line)
(let ((length (length line)) p )
(and (> length 6)
(setq p (position-if-not #'whitespacep line))
(= p 6)
(flet ((foo (key)
(let ((p (search key line :start2 p :end2 length
:test #'equalp)))
(when p
(let* ((keylen (length key))
(p1 (position-if-not #'whitespacep line
:start (+ p keylen 1)
:end length))
(q0 (position #\( line :start (1+ p1)
:end length))
(q1 (position-if-not #'whitespacep line
:start (1+ p1)
:end q0
:from-end t)))
(subseq line p1 (1+ q1) ))))))
(some #'foo #("PROGRAM"
"FUNCTION"
"SUBROUTINE"
"BLOCKDATA"
"BLOCK")))))))
|> Now, I can split the whole Fortran code to individuals.
|> (defun split (path)
|> (with-open-file (stream path)
|> (loop
|> :for l1 := (string-trim #(#\return #\linefeed)(read-line stream
|> nil nil))
|> :when (fn-p l1) :do
|> (with-open-file (outstream (fn l1) :direction :output :if-exists
|> :overwrite :if-does-not-exist :create)
|> (format outstream "~&~A" l1)
|> (loop
|> :for l2 := (string-trim #(#\return #\linefeed) (read-line
|> stream nil nil))
|> :when (not (end-p l2))
|> :do (format outstream "~&~A" l2)
|> :else
|> :do (format outstream "~&~A" l2)
|> (loop-finish))))))
| But, I don't find a way to terminate the first loop...
|
|> It works. But it seems the first loop is infinite, even when it reaches
|> the end-of-file. The second loop also very ugly...
|>
|> Any suggestions? Many thanks!
READ-LINE already removes the newline and returns a string. The loop is
naturally terminated when (read-line stream nil) returns NIL instead of
a string.
Consider the following code where I use an `output-stream' to keep-track
of the state. output-stream is set to a file stream if one is in the
middle of copying a block. All other lines are copied to standard
output.
(defun split (path)
(let ((output-stream t) fname)
(unwind-protect
(with-open-file (stream path)
(loop for line = (read-line stream nil)
while line do
(cond ((eq output-stream t)
(if (setq fname (fn-p line))
(setq output-stream
(open (format nil "~A.for" fname)
:direction :output
:if-exists :supersede))))
((setq fname (end-p line))
(assert (streamp output-stream))
(close output-stream)
(setq output-stream t)))
(format output-stream line)
(terpri stream)))
(when (streamp output-stream)
(close output-stream)))))
--- Madhu