LispWorks program will not build as application - common-lisp

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.

Related

What exactly does the #. (sharpsign dot) do in Common Lisp? Is it causing a variable has no value error?

Edit: Title updated to reflect what my question should have been, and hopefully lead other users here when they have the same problem.
Little bit of a mess, but this is a work-in-progress common lisp implementation of anydice that should output some ascii art representing a probability density function for a hash-table representing dice rolls. I've been trying to figure out exactly why, but I keep getting the error *** - SYSTEM::READ-EVAL-READER: variable BAR-CHARS has no value when attempting to run the file in clisp. The error is originating from the output function.
The code is messy and convoluted (but was previously working if the inner most loop of output is replaced with something simpler), but this specific error does not make sense to me. Am I not allowed to access the outer let* variables/bindings/whatever from the inner most loop/cond? Even when I substitute bar-chars for the list form directly, I get another error that char-decimal has no value either. I'm sure there's something about the loop macro interacting with the cond macro I'm missing, or the difference between setf, let*, multiple-value-bind, etc. But I've been trying to debug this specific problem for hours with no luck.
(defun sides-to-sequence (sides)
(check-type sides integer)
(loop for n from 1 below (1+ sides) by 1 collect n))
(defun sequence-to-distribution (sequence)
(check-type sequence list)
(setf distribution (make-hash-table))
(loop for x in sequence
do (setf (gethash x distribution) (1+ (gethash x distribution 0))))
distribution)
(defun distribution-to-sequence (distribution)
(check-type distribution hash-table)
(loop for key being each hash-key of distribution
using (hash-value value) nconc (loop repeat value collect key)))
(defun combinations (&rest lists)
(if (endp lists)
(list nil)
(mapcan (lambda (inner-val)
(mapcar (lambda (outer-val)
(cons outer-val
inner-val))
(car lists)))
(apply #'combinations (cdr lists)))))
(defun mapcar* (func lists) (mapcar (lambda (args) (apply func args)) lists))
(defun dice (left right)
(setf diceprobhash (make-hash-table))
(cond ((integerp right)
(setf right-distribution
(sequence-to-distribution (sides-to-sequence right))))
((listp right)
(setf right-distribution (sequence-to-distribution right)))
((typep right 'hash-table) (setf right-distribution right))
(t (error (make-condition 'type-error :datum right
:expected-type
(list 'integer 'list 'hash-table)))))
(cond ((integerp left)
(sequence-to-distribution
(mapcar* #'+
(apply 'combinations
(loop repeat left collect
(distribution-to-sequence right-distribution))))))
(t (error (make-condition 'type-error :datum left
:expected-type
(list 'integer))))))
(defmacro d (arg1 &optional arg2)
`(dice ,#(if (null arg2) (list 1 arg1) (list arg1 arg2))))
(defun distribution-to-probability (distribution)
(setf probability-distribution (make-hash-table))
(setf total-outcome-count
(loop for value being the hash-values of distribution sum value))
(loop for key being each hash-key of distribution using (hash-value value)
do (setf (gethash key probability-distribution)
(float (/ (gethash key distribution) total-outcome-count))))
probability-distribution)
(defun output (distribution)
(check-type distribution hash-table)
(format t " # %~%")
(let* ((bar-chars (list 9617 9615 9614 9613 9612 9611 9610 9609 9608))
(bar-width 100)
(bar-width-eighths (* bar-width 8))
(probability-distribution (distribution-to-probability distribution)))
(loop for key being each hash-key of
probability-distribution using (hash-value value)
do (format t "~4d ~5,2f ~{~a~}~%" key (* 100 value)
(loop for i from 0 below bar-width
do (setf (values char-column char-decimal)
(truncate (* value bar-width)))
collect
(cond ((< i char-column)
#.(code-char (car (last bar-chars))))
((> i char-column)
#.(code-char (first bar-chars)))
(t
#.(code-char (nth (truncate
(* 8 (- 1 char-decimal)))
bar-chars)))))))))
(output (d 2 (d 2 6)))
This is my first common lisp program I've hacked together, so I don't really want any criticism about formatting/style/performance/design/etc as I know it could all be better. Just curious what little detail I'm missing in the output function that is causing errors. And felt it necessary to include the whole file for debugging purposes.
loops scoping is perfectly conventional. But as jkiiski says, #. causes the following form to be evaluated at read time: bar-chars is not bound then.
Your code is sufficiently confusing that I can't work out whether there's any purpose to read-time evaluation like this. But almost certainly there is not: the uses for it are fairly rare.

Lisp variable using itself in definition

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

Quoting in macro-defining macro

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.

Brainf**k implemented in Common Lisp

I tried implementing Brainf**k in Common Lisp, SBCL. I have encountered some problems.
(defparameter *tape* (make-array '(1) :adjustable t))
(defparameter *pointer* 0)
(defparameter *tape-size* 1)
(defparameter *output* (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))
(defun move-pointer-right (a b)
(declare (ignore a))
(declare (ignore b))
'(progn
(incf *tape-size*)
(adjust-array *tape* (list *tape-size*))
(incf *pointer*)))
(defun move-pointer-left (a b)
(declare (ignore a))
(declare (ignore b))
'(progn (decf *pointer*)))
(defun increment-byte (a b)
(declare (ignore a))
(declare (ignore b))
'(incf (aref *tape* *pointer*)))
(defun decrement-byte (a b)
(declare (ignore a))
(declare (ignore b))
'(decf (aref *tape* *pointer*)))
(defun start-loop (stream ch)
(declare (ignore ch))
(let ((loop-body (read-delimited-list #\] stream t)))
`(loop :until (zerop (aref *tape* *pointer*))
:do ,#loop-body)))
(defun print-one-char (a b)
(declare (ignore a))
(declare (ignore b))
'(with-output-to-string (s *output*) (write-char (code-char (aref *tape* *pointer*)) s)))
(defun read-one-char (a b)
(declare (ignore a))
(declare (ignore b))
'(setf (aref *tape* *pointer*) (char-code (read-char *standard-input*))))
(defun flush-output (a b)
(declare (ignore a))
(declare (ignore b))
'(progn *output*))
(defun reset-me (a b)
(declare (ignore a))
(declare (ignore b))
'(progn
(setf *output* (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t))
(adjust-array *tape* '(1))
(setf (aref *tape* 0) 0)
(setf *pointer* 0)))
(set-macro-character #\< #'move-pointer-left)
(set-macro-character #\> #'move-pointer-right)
(set-macro-character #\+ #'increment-byte)
(set-macro-character #\[ #'start-loop)
(set-macro-character #\= #'flush-output)
(set-macro-character #\. #'print-one-char)
(set-macro-character #\, #'read-one-char)
(set-macro-character #\! #'reset-me)
(set-macro-character #\- #'decrement-byte)
input doesn't work
I am not sure whether nested loops would work because "[" reads to "]" and if you try "[/commands[/more]/dubious]" I don't how /dubious could be loaded with this methods.
I tried "++[->+>+<<]". As far as I know array should have: "0 2 2" but I got "0 2 0" instead. I conclude something is deeply wrong.
I am getting a lot of warnings from SBCL - it would be better to not have them:/
Is there a quick way to output all generated code (returned from functions such as "move-pointer-right") to file?
output is saved in one string to be printed at "=" command. I did it, because other operations were printing a lot of useless things to standard output. It is not a big problem for me - it seems easy to imagine just printing to file, instead of this workaround.
I am sorry for possible mistakes in my English.
Edit: I edited code (again - thank you for help, Sylwester). Everything but input seems to work.
As for input: I used read-char, but it doesn't work the way I want it. For example ,D inputs "D". I would like to redo it so it stops evaluation at each , and waits for user input.
Question: Is there an alternative to progn that does not return values (I want to just evaluate but not return)? For example (what-i-look-for (setf a 1) 1 2) sets a to 1 but does not return 2.
Without knowing too much about how you think its supposed to work you need to define tape, pointer and output as global variables, preferrably with *earmuffs* so that you can see they are globals.
(defparameter *tape* (make-array '(1) :adjustable t))
Then I noticed > extends the *tape* with a default element nil. Thus for every > you do you should set it to 0 if it's not true (every value is true except nil) It also seem to think that pointer is always at the end of the tape. When doing >>>++++<<< the element with 4 in it is long gone.
loop-body is a global variable. You should have used let here to not clobber package level variables. You use loopwrong. See examples in Loop for black belts. Eg.
(defun start-loop (stream ch)
(declare (ignore ch))
(let ((loop-body (read-delimited-list #\] stream t)))
`(loop :until (zerop (aref *tape* *pointer*))
:do ,#loop-body)))
Notice the declare there that tells Common Lisp to ignore ch not being used. The nesting is done automatically since read-deliited-list calls start-loop at a new [.
print-one-char doesn't add the char based on the ascii value but adds it as a number. Also usually it's common to print right away in BF so print-char might be better. You can print to a string input stream if you want to continue keeping it in memory until you press =.
read reads lisp data. Thus you would need to give it #\a instead of an a. Use read-char instead.
I guess you have enough to tacke at this point. Doing it with macros and reader-macros looked cool, but it is difficult to debug and extending since after the reader macros are added you have problems with code consisting those characters. Making one function for each operation except [ would simplify testing since you can test that and the macro would just expand to calling it.
(defun move-pointer-left ()
(assert (> *pointer* 0) (*pointer*) "Tape pointer out of bounds: ~a" *pointer*)
(decf *pointer*))
(set-macro-character #\< (constantly '(move-pointer-left)))

How to get rid of funcall in common lisp

According to this document: http://cl-cookbook.sourceforge.net/functions.html
(defun adder (n)
(lambda (x) (+ x n)))
(funcall (adder 12) 1)
I have to use funcall to call (adder 12), And it is very ignoring to write funcall over and over, is there any way to write code like it in scheme:
((adder 12) 1)
No. There is none.
You can also see it as a feature: it makes calls of function objects explicit and improves understandability of source code.
However, you could use something like this (not sure why would you, but the number of characters typed would be the same as it is in Scheme):
(set-macro-character
#\[
#'(lambda (stream char)
(declare (ignore char))
(set-syntax-from-char #\] #\;)
(let ((forms (read-delimited-list #\] stream t)))
(set-syntax-from-char #\] #\x)
(append '(funcall) forms))))
(defun adder (n)
#'(lambda (x) (+ x n)))
(format t "sum: ~s~&" [(adder 12) #x128]) ;; 308
This may give you some problems if you will encounter a variable name with brackets in it. Sure, using it is up to you, consider yourself warned.

Resources