This question already has an answer here:
Unusual stack overflow when inserting nodes in binary tree
(1 answer)
Closed 3 years ago.
I was getting stack overflow with the following code, then I tried it in SBCL and it worked. Wondering what causes the difference there.
Specifically: While I do plan to move to SBCL at some point, can
this be made to work in CLISP?
(defvar *objs* nil) ; [1]
(defun parents (obj) (gethash :parents obj))
(defun obj (&rest parents) ; [2]
(let ((obj (make-hash-table)))
(push obj *objs*)
(setf (parents obj) parents)
obj))
(defun (setf parents) (val obj) ; [3]
(prog1 (setf (gethash :parents obj) val)
(make-precedence obj)))
(defun make-precedence (obj) ; [4]
(setf (gethash :preclist obj) (precedence obj))
(dolist (x *objs*)
(if (member obj (gethash :preclist x))
(setf (gethash :preclist x) (precedence x)))))
(defun precedence (obj) ; [5]
(delete-duplicates (traverse obj)))
(defun traverse (x) ; [6]
(cons x (mapcan #'traverse (gethash :parents x))))
;; [1] We'll store a list of objects we create in *obj*.
;; [2] Function to create an object, called like (setf scoundrel (obj)).
;; [3] Set an objects (multiple) parents & rebuild precedence list for all affected objs.
;; [4] Rebuild precedence list for obj, then for all affected objs.
;; [5] Returns a list of object and all its ancestors in precedence order as we define it.
;; (Can read it like (-> obj traverse delete-duplicates) if it helps)
;; [6] Cons an object to all its parents recursively; depth first search.
;; I pulled this out of labels in precedence above it for clarity & testability.
;; Source: PG's ANSI Common Lisp, Chapter 17, "Example: Objects".
Example - SBCL
(setf scoundrel (obj))
; #<HASH-TABLE :TEST EQL :COUNT 2 {1001A01893}>
(setf sc2 (obj scoundrel))
; #<HASH-TABLE :TEST EQL :COUNT 2 {1001A1F153}>
*objs*
; (#<HASH-TABLE :TEST EQL :COUNT 2 {1001A1F153}>
; #<HASH-TABLE :TEST EQL :COUNT 2 {1001A01893}>)
(parents scoundrel)
; NIL
; T
(parents sc2)
; (#<HASH-TABLE :TEST EQL :COUNT 2 {1001A01893}>)
; T
Example - GNU CLISP
(setf scoundrel (obj))
;; - Lisp stack overflow. RESET
*objs*
;; - Lisp stack overflow. RESET
It might be worth mentioning that I haven't studied the dual interpreted and compiled nature of lisp a lot yet. So far I've simply been using it as an interpreted language; by pasting the above functions into the clisp repl.
So I suspect that compiling all these functions could be one thing to consider. I note we can compile and compile-file, I can't see an operator which compiles all user defined functions though.
GNU CLISP prints the contents of the hash table by default. In your case, it contains circular structures.
Either set *PRINT-CIRCLE* to T, to enable printing circular structures without stack overflow.
> (setq *print-circle* t)
T
> *objs*
(#1=#S(HASH-TABLE :TEST FASTHASH-EQL (:PRECLIST . (#1#)) (:PARENTS . NIL)))
Or set *PRINT-ARRAY* and *PRINT-READABLY* to NIL, to disable printing the contents of the hash table.
> (setq *print-circle* nil *print-array* nil *print-readably* nil)
NIL
> *objs*
(#<HASH-TABLE :TEST FASTHASH-EQL :COUNT 2 #x000335098D40>)
Related
I am working on a complicated macro and have run into a roadblock.
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o
(with-hash-table-iterator (next-entry ,on)
(destructuring-bind
,(apply #'append vars)
(let ((current-band (list ,#(mapcar #'not (apply #'append vars)))))
(for (i 1 ,(length (apply #'append vars)) 2)
(multiple-value-bind
(succ k v) (next-entry)
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
im getting "Evaluation aborted on #<UNDEFINED-FUNCTION NEXT-ENTRY {100229C693}>"
i dont understand why next-entry appears to be invisible to the macro i have created.
I've tried stripping down this to a small replicable example but i couldnt find a minimal scenario without the macro i created where next-entry would be invisible besides this scenario no matter what I tried, i've always managed to find a way to call next-entry in my other examples so im stumped as to why i cannot get it working here
I've tested the for macro ive created and it seems to generally work in most cases but for some reason it cannot see this next-entry variable. How do i make it visible?
In your code there are multiple places where the macro generates bindings in a way that is subject to variable capture (pdf).
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o ;; VARIABLE CAPTURE
(with-hash-table-iterator (next-entry ,on) ;; VARIABLE CAPTURE
(destructuring-bind ,(apply #'append vars)
(let ((current-band ;;; VARIABLE CAPTURE
(list ,#(mapcar #'not (apply #'append vars)))))
(for
(i ;;; VARIABLE CAPTURE
1 ,(length (apply #'append vars)) 2)
(multiple-value-bind (succ k v) ;;; VARIABLE CAPTURE
,(next-entry) ;;; WRONG EVALUATION TIME
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
A simplified example of such a capture is:
`(let ((x 0)) ,#body)
Here above, the x variable is introduced, but if the code is expanded in a context where xis already bound, then body will not be able to reference that former x binding and will always see x bound to zero (you generally don't want this behavior).
Write a function instead
Instead of writing a big macro for this, let's first try understanding what you want to achieve and write instead a higher-order function, ie. a function that calls user-provided functions.
If I understand correctly, your function iterates over a hash-table by bands of entries. I assume vars holds a list of (key value) pairs of symbols, for example ((k1 v1) (k2 v2)). Then, body works on all the key/value pairs in the band.
In the following code, the function map-each-hashtable-band accepts a function, a hash-table, and instead of vars it accepts a size, the width of the band (the number of pairs).
Notice how in your code, you only have one loop, which builds a band using the hash-table iterator. But then, since the macro is named for-each-hashtable-band, I assume you also want to loop over all the bands. The macro with-hash-table-iterator provides an iterator but does not loop itself. That's why here I have two loops.
(defun map-each-hashtable-band (function hash-table band-size)
(with-hash-table-iterator (next-entry hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(apply function current-band))
(unless next-p
(return-from outer-loop)))))))
For example:
(map-each-hashtable-band (lambda (&rest band) (print `(:band ,band)))
(alexandria:plist-hash-table
'(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5 :g 6))
2)
NB. Iterating over a hash-table happens in an arbitrary order, there is no guarantee that you'll see the entries in any particular kind of order, this is implementation-dependant.
With my current version of SBCL this prints the following:
(:BAND (:A 0 :B 1))
(:BAND (:C 2 :D 3))
(:BAND (:E 4 :F 5))
(:BAND (:G 6))
Wrap the function in a macro
The previous function might not be exactly the behavior you want, so you need to adapt to your needs, but once it does what you want, you can wrap a macro around it.
(defmacro for-each-hashtable-band (vars hash-table &body body)
`(map-each-hashtable-band (lambda ,(apply #'append vars) ,#body)
,hash-table
,(length vars)))
For example:
(let ((test (alexandria:plist-hash-table '(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5))))
(for-each-hashtable-band ((k1 v1) (k2 v2)) test
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2 v2)))
This prints:
A -> 0 && B -> 1
C -> 2 && D -> 3
E -> 4 && F -> 5
Macro-only solution, for completeness
If you want to have only one, single macro, you can start by inlining the body of the above function in the macro, you don't need to use apply anymore, but instead you need to establish bindings around the body, using destructuring-bind as you did. A first draft would be to simply as follows, but notice that this is not a proper solution:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (next-entry ,hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat ,band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(destructuring-bind ,(apply #'append vars) current-band
,#body))
(unless next-p
(return-from outer-loop))))))))
In order to be free of variable capture problems with macros, each temporary variable you introduce must be named after a symbol that cannot exist in any context you expand your code. So instead we first unquote all the variables, making the macro definition fail to compile:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop))))))))
When compiling the macro, the macro is supposed to inject symbols into the code, but here we have a compilation error that says undefined variables:
;; undefined variables: CURRENT-BAND KEY NEXT-ENTRY NEXT-P OUTER-LOOP VALUE
So now, those variables should be fresh symbols:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
(let ((current-band (gensym))
(key (gensym))
(next-entry (gensym))
(next-p (gensym))
(outer-loop (gensym))
(value (gensym)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop)))))))))
This above is a bit verbose, but you could simplify that.
Here is what the previous for-each-hashtable-band example expands into with this new macro:
(with-hash-table-iterator (#:g1576 test)
(loop :named #:g1578
:do (loop :with #:g1575
and #:g1579
and #:g1577
:repeat 2
:do (multiple-value-setq (#:g1577 #:g1575 #:g1579) (#:g1576))
:while #:g1577
:collect #:g1575 into #:g1574
:collect #:g1579 into #:g1574
:finally (progn
(when #:g1574
(destructuring-bind
(k1 v1 k2 v2)
#:g1574
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2
v2)))
(unless #:g1577 (return-from #:g1578))))))
Each time you expand it, the #:gXXXX variables are different, and cannot possibly shadow existing bindings, so for example, the body can use variables named like current-band or value without breaking the expanded code.
I am building a window application in Lisp using the LTK library. I want a button that does an action and, possibly, hides itself. However, this code:
(let* ((left (button 0 0 f "←" #'(lambda ()
(decf start page-length)
(funcall redraw)
(if (>= start page-length)
(ltk:configure left :state :visible))
(ltk:configure left :state :hidden))))))
claims that "left" is an undefined variable (the rest is defined in code beyond the scope of this problem).
Worst case scenario, I avoid the "button" function I wrote and rework the code for this particular situation, but the scenario begs a general solution. Is there any way in Lisp to use a variable in a function in the definition of the variable?
A let* with only one binding is the same as a let binding. A let binding does not exist until the body is executed. During the execution of button the reference for left must be from an earlier closure or global as left is created after the expression is evaluated. You can do this:
(let ((left nil))
(setf left (button 0 0 f "←" #'(lambda ()
(decf start page-length)
(funcall redraw)
(if (>= start page-length)
(ltk:configure left :state :visible)
(ltk:configure left :state :hidden))))))
NB: There was a bug in the if such that the lambda always would execute (ltk:configure left :state :hidden)
For what it's worth here is a version of letrec in CL:
(defmacro letrec (bindings &body decls/forms)
(assert (and (listp bindings)
(every (lambda (b)
(or (symbolp b)
(and (consp b)
(symbolp (first b))
(null (cddr b)))))
bindings))
(bindings) "malformed bindings")
(multiple-value-bind (names values)
(loop for b in bindings
collect (etypecase b
(symbol b)
(cons (first b)))
into vars
collect (etypecase b
(symbol nil)
(cons (second b)))
into vals
finally (return (values vars vals)))
`(let ,names
(psetf ,#(loop for name in names
for val in values
collect name
collect val))
(locally
,#decls/forms))))
Then
> (letrec ((x (lambda (y)
(if (null y)
'done
(funcall x (cdr y))))))
(funcall x '(1 2 3)))
done
I'm trying to write a macro that defines some helpers for struct-of-arrays data structure (based on this snippet). Inside that macro I define another macro that helps with traversing all of the slot values in struct. The thing is I can't make double unquoting work properly. Here's the code:
(defmacro defcomponent (name-and-options &body slots)
(setf name-and-options (ensure-list name-and-options))
(let ((struct (first name-and-options))
(slot-names (iter (for s in slots)
(collecting
(ematch s
((or (and name (symbol)
(<> _ '*)
(<> _ nil))
(list* name _ (plist :type _ :read-only _)))
name))))))
`(progn (defstruct ,name-and-options
;; some task-specific stuff omitted here
)
(defmacro ,(symbolicate 'with- struct) (components &rest body)
`(loop
,#',(iter (for s in slot-names)
(appending `(for ,s across (,(symbolicate struct '- s) components))))
do ,#body)))))
So for instance (defcomponent buzz x y) macroexpands to
(PROGN
(DEFSTRUCT (BUZZ)
X Y) ;; details omitted
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP ,#'(FOR X ACROSS (BUZZ-X COMPONENTS) FOR Y ACROSS (BUZZ-Y COMPONENTS))
DO ,#BODY))
which kinda works, but I want to access components parameter of the internal with-buzz macro, i.e. something like this
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP FOR X ACROSS (BUZZ-X ,COMPONENTS) FOR Y ACROSS (BUZZ-Y ,COMPONENTS)
DO ,#BODY))
How do I possibly acheive that? I've tried a lot of the combinations of , and ,# to no avail.
Sometimes it helps not to work with backquote patterns. Then scope problems can be easier understood with the help of a compiler, which would warn about the usual variable scope problems.
As a slightly simplified exercise, we will write a function, which generates code. The generated code is a macro definition, which itself generates code.
(defun makeit (name slots)
(labels ((symbolicate (pattern &rest things)
(intern (apply #'format nil pattern things)))
(compute-for-clauses (slots)
(loop for s in slots
append (list ''for (list 'quote s)
''across (list 'list
(list 'quote
(symbolicate "~a-~a" name s))
'components)))))
(list 'progn
(list 'defmacro
(symbolicate "WITH-~a" name)
'(components &rest body)
(append '(list* 'loop)
(compute-for-clauses slots)
(list ''do 'body))))))
Example
CL-USER 51 > (pprint (makeit 'buzz '(x y)))
(PROGN
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
(LIST* 'LOOP
'FOR
'X
'ACROSS
(LIST 'BUZZ-X COMPONENTS)
'FOR
'Y
'ACROSS
(LIST 'BUZZ-Y COMPONENTS)
'DO
BODY)))
CL-USER 52 > (eval *)
NIL
CL-USER 53 > (macroexpand-1 '(with-buzz a (+ 12) (+ 30)))
(LOOP FOR X ACROSS (BUZZ-X A) FOR Y ACROSS (BUZZ-Y A) DO (+ 12) (+ 30))
T
All right, I've managed to do it by resorting to manual list construction + eval instead of quasiquoting, but sweet mother of god it looks so hakish.
;; skip
(defmacro ,(symbolicate 'with- struct) (components &rest body)
(append
'(loop)
(eval
`(iter (for s in ',',slot-names)
(appending `(for ,s across (,(symbolicate ',',struct '- ,'s) ,,components)))))
'(do)
body))
I'll gladly accept any other answer solving the problem more idiomatically.
How do I join a series of path components in common lisp?
In python, I can do,
`os.path.join("/home/", username, "dira", "dirb", "dirc");`
What would be the equivalent in common lisp?
Of course I can write my own function, but I suspect I should be able to use something built-in.
If you insist on using strings to represent pathnames, then there seems to be no built-in solution except rolling your own.
(defun join-strings (list &key (separator "/") (force-leading nil))
(let* ((length (length list))
(separator-size (length separator))
(text-size (reduce #'+ (mapcar #'length list) :initial-value 0))
(size (+ text-size (* separator-size (if force-leading length (1- length)))))
(buffer (make-string size)))
(flet ((copy-to (position string)
(loop
:with wp := position
:for char :across string
:do (setf (char buffer (prog1 wp (incf wp))) char)
:finally (return wp))))
(loop
:with wp := 0
:for string :in list
:do (when (or force-leading (plusp wp)) (setf wp (copy-to wp separator)))
(setf wp (copy-to wp string)))
buffer)))
(join-strings '("home" "kurt" "source" "file.txt") :force-leading t)
==> "/home/kurt/source/file.txt"
However, if you can use pathnames, then you could, for example, do:
(merge-pathnames #P"subdir1/subdir2/file.type" #P"/usr/share/my-app")
==> #P"/usr/share/my-app/subdir1/subdir2/file.type"
The pathname API also provides functions to manipulate pathnames symbolically, extract the components of a pathname, etc.:
(pathname-directory #P"subdir1/subdir2/file.type")
==> '(:relative "subdir1" "subdir2")
(pathname-name #P"subdir1/subdir2/file.type")
==> "file"
(pathname-type #P"subdir1/subdir2/file.type")
==> "type"
(make-pathname :name "file" :type "type" :directory '(:relative "subdir1" "subdir2"))
==> #P"subdir1/subdir2/file.type"
In particular, the directory component of a pathname is represented as a list, and thus, you can use the full set of list handling functions to derive directory values from others:
(make-pathname :directory (append '(:absolute "usr" "share") '("more" "stuff"))
:name "packages" :type "lisp")
A simpler join-strings
(defun join-strings (lst sep)
(if
(atom lst)
lst
(reduce
(lambda (a b)
(concatenate 'string a sep b))
(cdr lst)
:initial-value (car lst))))
This is my second proper attempt at a Lisp program, as a dice-roller for Mythender (a freely distributed tabletop RPG). It has a couple of problems though:
When it's loaded I get a prompt to confirm creation of the package. Surely this file should be creating it?
When I try to build it standalone with the LispWorks application builder it gives an error saying that I am trying to invoke a CAPI function at compile-time, but I don't see where that is.
I've gotten negative comments from some lisp folks I spoke to about the (the null ()) sections which are meant to indicate a function has no return so no point leaving anything on the stack - is this proper or not? Is there a better way to do it?
Any general suggestions would also be welcome.
(defpackage :mythender (:add-use-defaults t) (:use "CAPI"))
(in-package :mythender)
(defun d6 () (the fixnum (+ 1 (random 6))))
(defun d6s (count)
(declare (type fixnum count))
(the list (loop for x from 1 to count collecting (d6))))
(defun d6over (count threshold)
(declare (type fixnum count threshold))
(the fixnum (count-if
(lambda (x) (> threshold x))
(d6s count))))
(defvar *storm* 3)
(defvar *thunder* 3)
(defvar *lightning* 0)
(declare (ftype (function) printstate))
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(the null ()))
(defun roll ()
(incf *lightning* (d6over *thunder* 3))
(incf *thunder* (d6over *storm* 3))
(the null ()))
(defun damage (threshold)
(setf *thunder* (d6over *thunder* threshold))
(the null ()))
(defun doroll (&rest args)
(roll)
(update-interface)
(the null ()))
(define-interface mythender-interface () ()
(:panes
(roll-button push-button :data "Roll" :callback #'doroll)
(damage-button push-button :data "Damage")
(storm-pane display-pane :title "Storm:" :title-position :left)
(thunder-pane display-pane :title "Thunder:" :title-position :Left)
(lightning-pane display-pane :title "Lightning:" :title-position :left))
(:layouts
(main-layout column-layout '(storm-pane thunder-pane lightning-pane buttonlayout))
(buttonlayout row-layout '(roll-button damage-button))))
(defvar *interface*)
(defun update-interface-slot (slotname value)
(declare (type string slotname) (type fixnum value))
(setf (display-pane-text (slot-value *interface* slotname)) (write-to-string value))
(the null ()))
(defun update-interface ()
(update-interface-slot 'storm-pane *storm*)
(update-interface-slot 'thunder-pane *thunder*)
(update-interface-slot 'lightning-pane *lightning*)
(the null ()))
(defun start ()
(setf *interface* (make-instance 'mythender-interface))
(display *interface*)
(the null (update-interface)))
An answer to your build problem has to wait until you tell us the build statement and the error message.
Your last question:
(declare (ftype (function) printstate))
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(the null ()))
It's known that it is a function. No need to declare that. Declaring types like that, have in plain Common Lisp only the purpose of optimization hints to the compiler, which the compiler may ignore. Only CMUCL (and derived compilers like SBCL and SCL) actually does more with declared types.
Nobody writes such code in Lisp. Better omit the types. Remember: Lisp is not a statically typed language.
(defun printstate ()
(print *storm*)
(print *thunder*)
(print *lightning*)
(values))
Using (values) causes the function to not return a value. That's usually preferred, not returning NIL.
If you want to actually check types in a meaningful way at runtime, then make use of ASSERT, CHECK-TYPE and/or DEFMETHOD.
(defun d6s (count)
(declare (type fixnum count))
(the list (loop for x from 1 to count collecting (d6))))
Is just:
(defmethod d6s ((n integer))
"Returns a list of n dice rolls."
(loop repeat n collect (d6)))
Don't forget to describe the semantics of your function in human readable form.