convert to lists

John Thingstad wrote:
> På Sat, 19 Jan 2008 19:12:43 +0100, skrev vanekl <vanek@acd.net>:
>
>>
>> you mean this? or is this cheating?
>>
>
> I like that as it has the same meaning as [ and ] have in Scheme.
> You should probably have a function disable-pf-reader also unless you
> want all brackets in all code you compile to behave like this.
>
> (defun pf-reader (stream char)
> (declare (ignore char))
> (let ((lst (read-delimited-list #\] stream t)))
> lst))
>
> (let (old-table)
> (defun enable-pf-reader ()
> (setf old-table (copy-readtable))
> (set-macro-character #\[ #'pf-reader t)
> (set-syntax-from-char #\] #\) ))
> (defun disable-pf-syntax ()
> (setf *readtable* old-table)))
>
> (defparameter *v* nil)
>
> (enable-pf-reader)
>
> (defun test ()
> (setf *v* '(1 2 3 [4 5][6 [7 8]]))
> (format t "~s~%" *v*))
>
> (disable-pf-syntax)
>
> (defun test2 ()
> (setf *v* '(1 2 3 [4 5][6 [7 8]]))
> (format t "~s~%" *v*))
>
> prints:
>
> CL-USER 1 > (test)
> (1 2 3 (4 5) (6 (7 8)))
> NIL
>
> CL-USER 2 > (test2)
> (1 2 3 [4 5][6 [7 8]])
> NIL
>
> --------------
> John Thingstad

The reader method is significantly slower than the stack/push/pop method,
but if the typist gets sloppy delimiting the brackets with white space on either side
of the bracket the reader method is probably the preferred method.
[This is just how my system is behaving; certainly not speaking for everybody.]

On Jan 19, 6:23 pm, AngelP <angelpo...@gmail.com> wrote:
> Hi,
> I have started with task to convert list '(1 2 3 4 [ 1 2 3 [ 1 2 ]
> [ 1 2 ] 3 ]) to a lisp list -
> '(1 2 3 4 ( 1 2 3 ( 1 2 ) ( 1 2 ) 3 ))
> I got to this, but it does not work
> (defun to-lisp (all)
> (let ((stack (list (list))))
> (dolist (x all)
> (print x)
> (print stack)
> (cond
> ((equal (first all) '[) (push (list) stack))
> ((equal (first all) ']) (let (( l (pop stack)))
> (setf (first stack) (append (first stack) l))))
> (t (setf (first stack) (list* x (first stack))))))
> stack))
>
> Can you give me a hint?

Very interesthing problem beside the cheating method using the reader
I could gave you this as a starting point, works in some cases but it'
not entirely debugged.
http://paste.lisp.org/display/54498
(defun matching-pos (l &optional (n 0) (pos 0))
(cond ((null l) 0)
((equal '[ (car l))
(matching-pos (cdr l) (1+ n) (1+ pos)))
((equal '] (car l))
(if (zerop n) pos
(matching-pos (cdr l) (1- n) (1+ pos))))
(t (matching-pos (cdr l) n (1+ pos)))))

(defun convert1 (l)
(cond ((null l) nil)
((equal '[ (car l))
(cons (convert (butlast (cdr l)
(- (length (cdr l))
(matching-pos (cdr l)))))
(convert (nthcdr (1+ (matching-pos (cdr l))) (cdr
l)))))
((listp (car l))
(cons (convert (car l))
(convert (cdr l))))
(t (cons (car l) (convert (cdr l))))))

(convert1 '(1 2 3 4 [ 1 2 3 [ 1 2 ] [ 1 2 ] 3 ]))
(1 2 3 4 (1 2 3 NIL 2) (1 2) 3 ])

Sorry but I'm too tired to work fix it. Maybe tomorrow

cheers
Slobodan

On 19 Jan, 17:23, AngelP <angelpo...@gmail.com> wrote:
> Hi,
> I have started with task to convert list *'(1 2 3 4 [ 1 2 3 [ 1 2 ]
> [ 1 2 ] 3 ]) to a lisp list -
> '(1 2 3 4 ( 1 2 3 ( 1 2 ) ( 1 2 ) 3 ))
> I got to this, but it does not work
> (defun to-lisp (all)
> * (let ((stack (list (list))))
> * * (dolist (x all)
> * * * (print x)
> * * * (print stack)
> * * * (cond
> * * * *((equal (first all) '[) (push (list) stack))
> * * * *((equal (first all) ']) (let (( l (pop stack)))
> * * * * * * * * * * * * * * * * *(setf (first stack) (append (first stack) l))))
> * * * *(t (setf (first stack) (list* x (first stack))))))
> * * stack))
>
> Can you give me a hint?

Actually this is the sort of problem that lends itself to language
oriented programming. Here is a solution in Qi-YACC; I used < .. >
rather than [ ... ] because [ ...] has a special meaning in Qi.

(defcc <paren>
< <paren> > <paren1> := [<paren> | <paren1>];
<token> <paren> := [<token> | <paren>];
<e> := []

(defcc <paren1>
<paren>

(defcc <token>
-*- := (if (element? -*- [< >]) #\Escape -*-)

Some examples;

(30-) (compile <paren> [< 4 < 5 > >])
[[4 [5]]]

(31-) (compile <paren> [< 4 < 5 >])
#\Escape (unbalanced parens - Mark)

(32-) (compile <paren> [< 4 < 5 > >])
[[4 [5]]]

(33-) (compile <paren> [> < 4 < 5 > >])
#\Escape (unbalanced parens - Mark)

Mark

On 20 Jan, 01:36, Mark Tarver <dr.mtar...@ukonline.co.uk> wrote:
> On 19 Jan, 17:23, AngelP <angelpo...@gmail.com> wrote:
>
>
>
>
>
> > Hi,
> > I have started with task to convert list *'(1 2 3 4 [ 1 2 3 [ 1 2 ]
> > [ 1 2 ] 3 ]) to a lisp list -
> > '(1 2 3 4 ( 1 2 3 ( 1 2 ) ( 1 2 ) 3 ))
> > I got to this, but it does not work
> > (defun to-lisp (all)
> > * (let ((stack (list (list))))
> > * * (dolist (x all)
> > * * * (print x)
> > * * * (print stack)
> > * * * (cond
> > * * * *((equal (first all) '[) (push (list) stack))
> > * * * *((equal (first all) ']) (let (( l (pop stack)))
> > * * * * * * * * * * * * * * * * *(setf(first stack) (append (first stack) l))))
> > * * * *(t (setf (first stack) (list* x (first stack))))))
> > * * stack))
>
> > Can you give me a hint?
>
> Actually this is the sort of problem that lends itself to language
> oriented programming. *Here is a solution in Qi-YACC; I used < .. >
> rather than [ ... ] because [ ...] has a special meaning in Qi.
>
> (defcc <paren>
> * < <paren> > <paren1> := [<paren> | <paren1>];
> * <token> <paren> := [<token> | <paren>];
> * <e> := []
>
> (defcc <paren1>
> * *<paren>
>
> (defcc <token>
> * -*- := (if (element? -*- [< >]) #\Escape -*-)
>
> Some examples;
>
> (30-) (compile <paren> [< 4 < 5 > >])
> [[4 [5]]]
>
> (31-) (compile <paren> [< 4 < 5 *>])
> #\Escape * *(unbalanced parens - Mark)
>
> (32-) (compile <paren> [< 4 < 5 *> >])
> [[4 [5]]]
>
> (33-) (compile <paren> [> < 4 < 5 *> >])
> #\Escape (unbalanced parens - Mark)
>
> Mark- Hide quoted text -
>
> - Show quoted text -

It occurred to me that you might want to run the generated Lisp. This
should run directly in Lisp. The resulting machine-generated Lisp
program (very lightly edited) is:

(DEFUN <paren> (Stream)
(cases
(IF (AND (CONSP (FIRST Stream)) (EQ (FIRST (FIRST Stream)) '<))
(LET
((<paren> (<paren> (LIST (REST (FIRST Stream)) (SECOND Stream)))))
(IF (NOT (failure? <paren>))
(IF (AND (CONSP (FIRST <paren>)) (EQ (FIRST (FIRST <paren>)) '>))
(LET
((<paren1> (<paren1> (LIST (REST (FIRST <paren>)) (SECOND
<paren>)))))
(IF (NOT (failure? <paren1>))
(LIST (FIRST <paren1>) (cons (SECOND <paren>) (SECOND
<paren1>)))
(LIST NIL #\Escape)))
(LIST NIL #\Escape))
(LIST NIL #\Escape)))
(LIST NIL #\Escape))
(LET ((<token> (<token> Stream)))
(IF (NOT (failure? <token>))
(LET ((<paren> (<paren> <token>)))
(IF (NOT (failure? <paren>))
(LIST (FIRST <paren>) (cons (SECOND <token>) (SECOND <paren>)))
(LIST NIL #\Escape)))
(LIST NIL #\Escape)))
(LET ((<e> (<e> Stream)))
(IF (NOT (failure? <e>)) (LIST (FIRST <e>) NIL) (LIST NIL #
\Escape)))))

(DEFUN <paren1> (Stream)
(cases
(LET ((<paren> (<paren> Stream)))
(IF (NOT (failure? <paren>))
(LIST (FIRST <paren>) (APPEND (SECOND <paren>) NIL))
(LIST NIL #\Escape)))))

(DEFUN <token> (Stream)
(cases
(IF (CONSP (FIRST Stream))
(LIST (FIRST (LIST (REST (FIRST Stream)) (SECOND Stream)))
(IF (MEMBER (CAAR Stream) (cons '< (cons '> NIL))) #\Escape
(CAAR Stream)))
(LIST NIL #\Escape))))

" to run under bare Lisp outside Qi - add"

(DEFUN compile (F X)
(LET ((O (FUNCALL F (LIST X NIL))))
(IF (OR (failure? O) (NOT (NULL (CAR O)))) #\Escape (CADR O))))

(DEFMACRO cases (&REST X)
(IF (NULL X)
'*Failure*
`(LET ((Y ,(CAR X)))
(IF (failure? Y)
,(CONS 'cases (CDR X))
Y))))

(SETQ *Failure* '(NIL #\Escape))

(DEFUN <e> (Stream) Stream)

(DEFUN failure? (X) (EQ (CADR X) #\Escape))

Mark