From: Karol Skocik
Subject: labels and trace
Date: Tue, 06 Sep 2005 18:52:26 +0000
Message-ID: <1126032746.382877.275340@g43g2000cwa.googlegroups.com> Hi,
I am currently in the phase of "paradigm switch" and I am trying to
understand various beautiful recursive functions like flatten and prune
(especially - their invocation order, since it's not so obvious for
imperative guy like I was for several years). The functions are from On
Lisp, and many examples there are written in style, when some helper
function is defined using "labels", and that's the place where the core
stuff is done.
But when I want to trace it (I still have some problems with invocation
order), "trace" on such functions does not help, because
CL-USER> (trace flatten)
(FLATTEN)
CL-USER> *l1*
(1 2 (3 (4 5) 6) 7 8 (9))
CL-USER> (flatten *l1*)
0: (FLATTEN (1 2 (3 # 6) 7 8 ...))
0: FLATTEN returned (1 2 3 4 5 ...)
(1 2 3 4 5 6 7 8 9)
and it does not go into the function defined in "labels".
Is there any way how to see trace output in such functions?
Thanks for any ideas,
Karol From: Pascal Bourguignon
Subject: Re: labels and trace
Date: Tue, 06 Sep 2005 20:39:31 +0000
Message-ID: <87hdcyq6bg.fsf@thalassa.informatimago.com> "Karol Skocik" <············@gmail.com> writes:
> Hi,
> I am currently in the phase of "paradigm switch" and I am trying to
> understand various beautiful recursive functions like flatten and prune
> (especially - their invocation order, since it's not so obvious for
> imperative guy like I was for several years). The functions are from On
> Lisp, and many examples there are written in style, when some helper
> function is defined using "labels", and that's the place where the core
> stuff is done.
>
> But when I want to trace it (I still have some problems with invocation
> order), "trace" on such functions does not help, because
>
> CL-USER> (trace flatten)
> (FLATTEN)
> CL-USER> *l1*
> (1 2 (3 (4 5) 6) 7 8 (9))
> CL-USER> (flatten *l1*)
> 0: (FLATTEN (1 2 (3 # 6) 7 8 ...))
> 0: FLATTEN returned (1 2 3 4 5 ...)
> (1 2 3 4 5 6 7 8 9)
>
> and it does not go into the function defined in "labels".
>
> Is there any way how to see trace output in such functions?
Yes, if you're using the right IDE.
[12]> (defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
FLATTEN
[13]> (trace flatten)
;; Tracing function FLATTEN.
(FLATTEN)
[14]> (flatten '(1 (2 ((3 4) 5) 6) 7))
1. Trace: (FLATTEN '(1 (2 ((3 4) 5) 6) 7))
1. Trace: FLATTEN ==> (1 2 3 4 5 6 7)
(1 2 3 4 5 6 7)
; Now, I type M-p M-p M-p, then I edit the source of flatten to get:
[15]> (defun rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc)))))
REC
[16]> (trace rec)
;; Tracing function REC.
(REC)
[17]> (rec '(((1 2)) 3) nil)
1. Trace: (REC '(((1 2)) 3) 'NIL)
2. Trace: (REC '(3) 'NIL)
3. Trace: (REC 'NIL 'NIL)
3. Trace: REC ==> NIL
3. Trace: (REC '3 'NIL)
3. Trace: REC ==> (3)
2. Trace: REC ==> (3)
2. Trace: (REC '((1 2)) '(3))
3. Trace: (REC 'NIL '(3))
3. Trace: REC ==> (3)
3. Trace: (REC '(1 2) '(3))
4. Trace: (REC '(2) '(3))
5. Trace: (REC 'NIL '(3))
5. Trace: REC ==> (3)
5. Trace: (REC '2 '(3))
5. Trace: REC ==> (2 3)
4. Trace: REC ==> (2 3)
4. Trace: (REC '1 '(2 3))
4. Trace: REC ==> (1 2 3)
3. Trace: REC ==> (1 2 3)
2. Trace: REC ==> (1 2 3)
1. Trace: REC ==> (1 2 3)
(1 2 3)
[18]>
An alternative is to define one's own TRACING-LABELS macro to do the tracing.
;; First, some copy-and-paste reuse to get the name of the arguments.
(defstruct lambda-list
"Cached data about a lambda-list.
The purpose is to be able to determine rapidely what to do when a SPC is typed
after a COMMON-LISP symbol.
- symbol, kind and lambda-list are the raw data coming from *raw-lambda-lists*
they're not used.
- cnt-mandatory: the number of mandatory arguments.
- cnt-optional: the number of mandatory arguments.
- rest-p: whether &REST or &BODY parameters are present.
- allow-other-keys-p: whether &ALLOW-OTHER-KEYS is present.
- keys: list of keyword names.
- help: an a-list used to generate the help.
Use the lambda-list-get-help to get the help string!
- actions: a vector of action functions. Use the lambda-list-action
function to get the right action!
"
(symbol nil :type symbol)
(kind nil :type symbol)
(lambda-list '() :type list)
(cnt-mandatory 0 :type integer)
(cnt-optional 0 :type integer)
(rest-p nil :type boolean)
(allow-other-keys-p nil :type boolean)
(keys '() :type list)
(arguments '() :type list) ; name of the arguments.
(help '() :type list)
(actions #() :type vector))
(DEFPARAMETER +cl-lambda-list-keywords+
'(&WHOLE &OPTIONAL &REST &KEY &ALLOW-OTHER-KEYS &AUX &BODY &ENVIRONMENT))
(DEFPARAMETER +cl-lambda-list-kinds+
'(:ordinary :macro :method-combination :boa :generic :specialized
:defsetf :deftype :destructuring :modify-macro))
(DEFUN split-lambda-list-on-keywords (lambda-list lambda-list-kind)
"
lambda-list-kind: (member +cl-lambda-list-kinds+)
"
(let ((sing-result '())
(env (position '&ENVIRONMENT lambda-list)))
(when env
(push (list '&ENVIRONMENT (elt lambda-list (1+ env))) sing-result)
(setf lambda-list (remove-if (lambda (x) t) lambda-list :start env :end (+ env 2))))
(when (eq '&WHOLE (first lambda-list))
(push (subseq lambda-list 0 2) sing-result)
(setf lambda-list (cddr lambda-list)))
(do ((llk '(&MANDATORY &OPTIONAL &KEY &ALLOW-OTHER-KEYS &AUX &REST &BODY))
(args (if (member (first lambda-list) +cl-lambda-list-keywords+)
lambda-list
(cons '&MANDATORY lambda-list))
(cdr args))
(chunk '())
(result '()))
((null args)
(when chunk (push (nreverse chunk) result))
(nreverse (nconc sing-result result)))
(if (member (car args) llk)
(progn
(when chunk (push (nreverse chunk) result))
(setf chunk (list (car args))))
(push (car args) chunk)))));;split-lambda-list-on-keywords
(defun get-split-parameters (keyword split-lambda-list)
"
keyword: (member (cons '&MANDATORY +cl-lambda-list-keywords+))
RETURN: The selected list of arguments.
"
(cdar (MEMBER keyword split-lambda-list
:KEY (function first))));;get-split-parameters
(defun parameter-name (parameter)
"
RETURN: The name of the parameter (the variable that will be bound).
"
(etypecase parameter
(symbol parameter)
(list (etypecase (first parameter)
(symbol (first parameter))
(list (second (first parameter)))))));;parameter-name
(defun parameter-keyword (parameter)
"
RETURN: The keyword used to introduce an argument for this parameter.
"
(etypecase parameter
(symbol (INTERN (STRING parameter) "KEYWORD"))
(list (etypecase (first parameter)
(symbol (INTERN (STRING (first parameter)) "KEYWORD"))
(list (first (first parameter)))))));;parameter-keyword
(defun parameter-specializer (parameter)
"
RETURN: The specializer of the parameter (the expression used to initalize
an optional or keyword parameter).
"
(etypecase parameter
(symbol (VALUES nil nil))
(list (if (cdr parameter)
(VALUES (second parameter) t)
(VALUES nil nil)))));;parameter-specializer
(defun parameter-init-form (parameter)
"
RETURN: The init-form of the parameter (the expression used to initalize
an optional or keyword parameter).
"
(etypecase parameter
(symbol (VALUES nil nil))
(list (if (cdr parameter)
(VALUES (second parameter) t)
(VALUES nil nil)))));;parameter-init-form
(defun parameter-indicator (parameter)
"
RETURN: The name of the indicator variable for the parameter (the variable
that is bound to true or NIL to indicate whether the value of the
optional or keyword parameter comes from an argument or the init-form).
"
(etypecase parameter
(symbol (VALUES nil nil))
(list (if (cddr parameter)
(VALUES (third parameter) t)
(VALUES nil nil)))));;parameter-indicator
(DEFUN make-help-from-split-lambda-list (split-lambda-list)
(append
;; mandatory:
(mapcar (lambda (arg) (cons :mandatory (format nil "~A"
(if (consp arg)
arg
(parameter-name arg)))))
(get-split-parameters '&MANDATORY split-lambda-list))
;; optional:
(mapcar (lambda (arg) (cons :optional (format nil "[~A]" (parameter-name arg))))
(get-split-parameters '&OPTIONAL split-lambda-list))
;; keywords:
(mapcar (lambda (arg) (cons :key (format nil "~A" (parameter-keyword arg))))
(get-split-parameters '&KEY split-lambda-list))
(let (m)
(cond
((setf m (get-split-parameters '&ALLOW-OTHER-KEYS split-lambda-list))
(list (cons :allow-other-keys "other keys allowed...")))
((setf m (get-split-parameters '&REST split-lambda-list))
(list (cons :rest (format nil "~A..." (parameter-name (first m))))))
((setf m (get-split-parameters '&BODY split-lambda-list))
(list (cons :body (format nil "~A..." (parameter-name (first m))))))
(t nil)))))
(DEFUN make-argument-list-from-split-lambda-list (split-lambda-list)
(append
;; Whole
(mapcar (function parameter-name)
(get-split-parameters '&WHOLE split-lambda-list))
;; Environment
(mapcar (function parameter-name)
(get-split-parameters '&ENVIRONMENT split-lambda-list))
;; mandatory:
(mapcar (function parameter-name)
(get-split-parameters '&MANDATORY split-lambda-list))
;; optional:
(mapcar (function parameter-name)
(get-split-parameters '&OPTIONAL split-lambda-list))
;; keywords:
(mapcar (function parameter-name)
(get-split-parameters '&KEY split-lambda-list))
(mapcar (function parameter-name)
(get-split-parameters '&BODY split-lambda-list))
(mapcar (function parameter-name)
(get-split-parameters '&REST split-lambda-list))))
(DEFUN lambda-list-compute-actions (lambda-list)
nil)
(defun bool (x) (not (not x)))
(DEFUN compile-lambda-list (kind name lambda-list)
(let* ((split (split-lambda-list-on-keywords
lambda-list
(case kind
((:function :FUNCTION) :ordinary)
((:macro :MACRO) :macro)
((:special-operator :SPECIAL-OPERATOR) :macro)
((:generic :GENERIC) :generic)
(otherwise (error "Unexpected definition kind ~S" kind)))))
(arglrec
(make-lambda-list
:kind kind
:symbol name
:lambda-list lambda-list
:help (make-help-from-split-lambda-list split)
:cnt-mandatory (if (and (atom (car (car split)))
(not (member (car (car split))
+cl-lambda-list-keywords+)))
(length (car split))
0)
:cnt-optional (let ((opt (car (MEMBER '&OPTIONAL
split
:KEY (function first)))))
(if opt
(length (cdr opt))
0))
:rest-p (bool (or (MEMBER '&REST split :KEY (function first))
(MEMBER '&BODY split :KEY (function first))))
:allow-other-keys-p (bool (MEMBER '&ALLOW-OTHER-KEYS split
:KEY (function first)))
:keys (nreverse
(mapcar
(lambda (x) (if (consp x)
(if (consp (car x)) (caar x) (car x)) x))
(cdar (MEMBER '&KEY split :KEY (function first)))))
:arguments (make-argument-list-from-split-lambda-list split)))
(name (symbol-name name)))
(lambda-list-compute-actions arglrec)
arglrec))
;; Now, we can define your tracing-labels macro that do the job:
(defmacro tracing-labels (defs &body body)
`(cl:labels
,(mapcar
(lambda (def)
(let ((arguments (lambda-list-arguments
(COMPILE-LAMBDA-LIST :function (first def)
(second def))))
(res (gensym "RESULTS")))
`(,(first def) ,(second def)
,@(when (stringp (third def))
(list (third def)))
(format *trace-output*
"~&Entering ~A (·@{~S~^ ~})~%" ',(first def)
,@arguments)
(unwind-protect
(progn (format *trace-output*
"~&Exiting ~A --> ~{~S~^; ~}~%"
',(first def)
(setf ,res (multiple-value-list
(progn ,@(cddr def)))))
(values-list ,res))
(format *trace-output*
"~&Unwinding ~A~%" ',(first def))))))
defs)
,@body))
;; But we still must modify the function:
[81]> (defun flatten (x)
(tracing-labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
FLATTEN
[82]> (flatten '((1 (2)) 3))
Entering REC (((1 (2)) 3) NIL)
Entering REC ((3) NIL)
Entering REC (NIL NIL)
Exiting REC --> NIL
Unwinding REC
Entering REC (3 NIL)
Exiting REC --> (3)
Unwinding REC
Exiting REC --> (3)
Unwinding REC
Entering REC ((1 (2)) (3))
Entering REC (((2)) (3))
Entering REC (NIL (3))
Exiting REC --> (3)
Unwinding REC
Entering REC ((2) (3))
Entering REC (NIL (3))
Exiting REC --> (3)
Unwinding REC
Entering REC (2 (3))
Exiting REC --> (2 3)
Unwinding REC
Exiting REC --> (2 3)
Unwinding REC
Exiting REC --> (2 3)
Unwinding REC
Entering REC (1 (2 3))
Exiting REC --> (1 2 3)
Unwinding REC
Exiting REC --> (1 2 3)
Unwinding REC
Exiting REC --> (1 2 3)
Unwinding REC
(1 2 3)
;; So we can even shadow the LABELS macro, and redefine it:
[83]> (shadow 'labels)
T
[84]> (defmacro labels (defs &body body)
`(cl:labels
,(mapcar
(lambda (def)
(let ((arguments (lambda-list-arguments
(COMPILE-LAMBDA-LIST :function (first def)
(second def))))
(res (gensym "RESULTS")))
`(,(first def) ,(second def)
,@(when (stringp (third def))
(list (third def)))
(format *trace-output*
"~&Entering ~A (·@{~S~^ ~})~%" ',(first def)
,@arguments)
(unwind-protect
(progn (format *trace-output*
"~&Exiting ~A --> ~{~S~^; ~}~%"
',(first def)
(setf ,res (multiple-value-list
(progn ,@(cddr def)))))
(values-list ,res))
(format *trace-output*
"~&Unwinding ~A~%" ',(first def))))))
defs)
,@body))
LABELS
;; Then we can get the trace without even modifying the function:
[85]> (defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
FLATTEN
[86]> (flatten '((1 (2)) 3))
Entering REC (((1 (2)) 3) NIL)
Entering REC ((3) NIL)
Entering REC (NIL NIL)
Exiting REC --> NIL
Unwinding REC
Entering REC (3 NIL)
Exiting REC --> (3)
Unwinding REC
Exiting REC --> (3)
Unwinding REC
Entering REC ((1 (2)) (3))
Entering REC (((2)) (3))
Entering REC (NIL (3))
Exiting REC --> (3)
Unwinding REC
Entering REC ((2) (3))
Entering REC (NIL (3))
Exiting REC --> (3)
Unwinding REC
Entering REC (2 (3))
Exiting REC --> (2 3)
Unwinding REC
Exiting REC --> (2 3)
Unwinding REC
Exiting REC --> (2 3)
Unwinding REC
Entering REC (1 (2 3))
Exiting REC --> (1 2 3)
Unwinding REC
Exiting REC --> (1 2 3)
Unwinding REC
Exiting REC --> (1 2 3)
Unwinding REC
(1 2 3)
[87]>
Left as an exercice for the reader:
- keep the source of the functions in the image (overriding the DEFUN macro)
- design a designator scheme to name the local functions. For example:
·······@REC could designate the REC function in the FLATTEN
function. You may need several syntactic operators to traverse the tree:
(defun f () ; f
(labels ((f () ; ·@f
(labels ((f () ...)) ; ·@·@f
(f)) ; calls ·@·@f
(f)...)) ; calls ·@f
(f) ; calls ·@f
(labels ((f () ...)) ; ··@f
(f)) ; calls ··@f
(labels ((f () ...)) ; ···@f
(f)) ; calls ···@f
(f)) ; calls ·@f
(f)) ; calls f
- override the TRACE, UNTRACE, FLET and LABELS macros to be able to type:
(trace ·@·@f ··@f)
(f)
(untrace ··@f)
(f)
etc..
TRACE would automatically redefine f (to get the new
macroexpansion), and labels/flet would gnenerate the code to trace
the subfunctions optionally.
--
__Pascal Bourguignon__ http://www.informatimago.com/
Our enemies are innovative and resourceful, and so are we. They never
stop thinking about new ways to harm our country and our people, and
neither do we. -- Georges W. Bush From: Karol Skocik
Subject: Re: labels and trace
Date: Tue, 06 Sep 2005 22:15:39 +0000
Message-ID: <1126044939.372881.316190@g14g2000cwa.googlegroups.com> Wow, thanks!
This code will help me a lot. I am still at the beginning of the
learning curve, and I think that I will stay on it for some time, so
those exercises are delayed to the future (hopefully not too far
future).
Again, thanks for it!!
Karol From: Joe Marshall
Subject: Re: labels and trace
Date: Wed, 14 Sep 2005 14:40:08 +0000
Message-ID: <8xxzemrb.fsf@alum.mit.edu> Pascal Bourguignon <····@mouse-potato.com> writes:
> An alternative is to define one's own TRACING-LABELS macro to do the tracing.
[bunch of code snipped]
> ;; But we still must modify the function:
>
> [81]> (defun flatten (x)
> (tracing-labels ((rec (x acc)
> (cond ((null x) acc)
> ((atom x) (cons x acc))
> (t (rec (car x) (rec (cdr x) acc))))))
> (rec x nil)))
> ;; So we can even shadow the LABELS macro, and redefine it:
[snipped]
> ;; Then we can get the trace without even modifying the function:
>
> [85]> (defun flatten (x)
> (labels ((rec (x acc)
> (cond ((null x) acc)
> ((atom x) (cons x acc))
> (t (rec (car x) (rec (cdr x) acc))))))
> (rec x nil)))
> Left as an exercice for the reader:
> - keep the source of the functions in the image (overriding the DEFUN macro)
>
> - design a designator scheme to name the local functions. For example:
> ·······@REC could designate the REC function in the FLATTEN
> function. You may need several syntactic operators to traverse the tree:
>
> (defun f () ; f
> (labels ((f () ; ·@f
> (labels ((f () ...)) ; ·@·@f
> (f)) ; calls ·@·@f
> (f)...)) ; calls ·@f
> (f) ; calls ·@f
> (labels ((f () ...)) ; ··@f
> (f)) ; calls ··@f
> (labels ((f () ...)) ; ···@f
> (f)) ; calls ···@f
> (f)) ; calls ·@f
> (f)) ; calls f
>
>
> - override the TRACE, UNTRACE, FLET and LABELS macros to be able to type:
>
> (trace ·@·@f ··@f)
> (f)
> (untrace ··@f)
> (f)
> etc..
>
> TRACE would automatically redefine f (to get the new
> macroexpansion), and labels/flet would gnenerate the code to trace
> the subfunctions optionally.
This is a fantastic example of how Lisp *really* wins. Pascal has
incrementally redefined one of the basic constructs in the language
and seamlessly integrated the new definition into the system. Another
user could take existing code and *without modifying it* run it in
this system and have the output traced.
Few languages let you do this as easily.