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)))
The below code gives wrong answer. It should give approximately 0.5 which is the average of an array with many random numbers between 0 an 1. I think the problem is because N is "to big", or perhaps the precision on the generated random number?. The code works well for smaller values of N (10^7, 10^6, etc). Some advices will be helpful.
Thank you in advance.
(defun randvec(n)
(let ((arr (make-array n)))
(dotimes (i n)
(setf (aref arr i) (random 1.0))
)
arr
)
)
(defparameter N (expt 10 8))
(setf *random-state* (make-random-state t))
(defparameter vector1 (randvec N))
(format t "~a~%" (/ (reduce #'+ vector1) (length vector1)))
Precision of floating point numbers
You are computing with single precision floating point numbers. By adding up all random numbers you get a single-float number. The more numbers you add, the larger the float will be. This eventually causes your result to have not enough precision.
double-floats like 1.0d0 have a higher precision than single-floats like 1.0s0. By default 1.0 is read as a single-float. (RANDOM 1.0d0) will compute a double float.
(defun randvec (n)
(let ((v (make-array n)))
(dotimes (i n v)
(setf (aref v i) (random 1.0d0))))) ; create a double float random number
(defun test (&optional (n 10))
(setf *random-state* (make-random-state t))
(let ((v (randvec n)))
(/ (reduce #'+ v) (length v))))
Example:
CL-USER 58 > (test (expt 10 8))
0.4999874882753848D0
Style
Please use common Lisp programming style when programming in Common Lisp:
don't use global variables, if not necessary. Write functions with local variables instead.
if you define a global variable with defparameter, don't name it n, but *n*.
format and indent your code correctly. Indentation should be done with editor help.
don't use parentheses on their own line.
See my example above.
Let's say I have the floating point number 1234.9
I want to format it as 1.234,90
Is there a format directive combination for that? ~D ,which can handle the grouping and the group char, handles only integers. ~F doesn't handle grouping at all. And none as far as I know can change the decimal point from . to ,
The only solution I see is to use ~D for the integer part digit grouping and concatenate it with , and the decimal part. Any better ideas?
You can define a function to be called with tilde-slash, which most of the other answers have already done, but in order to get output similar to ~F, but with comma chars injected, and with the decimal point replaced, I think it's best to call get the output produced by ~F, and then modify it and write it to the string. Here's a way to do that, using a utility inject-comma that adds a comma character at specified intervals to a string. Here's the directive function:
(defun print-float (stream arg colonp atp
&optional
(point-char #\.)
(comma-char #\,)
(comma-interval 3))
"A function for printing floating point numbers, with an interface
suitable for use with the tilde-slash FORMAT directive. The full form
is
~point-char,comma-char,comma-interval/print-float/
The point-char is used in place of the decimal point, and defaults to
#\\. If : is specified, then the whole part of the number will be
grouped in the same manner as ~D, using COMMA-CHAR and COMMA-INTERVAL.
If # is specified, then the sign is always printed."
(let* ((sign (if (minusp arg) "-" (if (and atp (plusp arg)) "+" "")))
(output (format nil "~F" arg))
(point (position #\. output :test 'char=))
(whole (subseq output (if (minusp arg) 1 0) point))
(fractional (subseq output (1+ point))))
(when colonp
(setf whole (inject-comma whole comma-char comma-interval)))
(format stream "~A~A~C~A"
sign whole point-char fractional)))
Here are some examples:
(progn
;; with # (for sign) and : (for grouping)
(format t "~','.2#:/print-float/ ~%" 12345.6789) ;=> +1.23.45,679
;; with no # (no sign) and : (for grouping)
(format t "~'.'_3:/print-float/ ~%" 12345.678) ;=> 12_345.678
;; no # (but sign, since negative) and : (for grouping)
(format t "~'.'_3:/print-float/ ~%" -12345.678) ;=> -12_345.678
;; no # (no sign) and no : (no grouping)
(format t "~'.'_3#/print-float/ ~%" 12345.678)) ;=> +12345.678 (no :)
Here are the examples from coredump-'s answer, which actually helped me catch a bug with negative numbers:
CL-USER> (loop for i in '(1034.34 -223.12 -10.0 10.0 14 324 1020231)
do (format t "~','.:/print-float/~%" i))
1.034,34
-223,12
-10,0
10,0
14,0
324,0
1.020.231,0
NIL
Here's inject-comma, with some examples:
(defun inject-comma (string comma-char comma-interval)
(let* ((len (length string))
(offset (mod len comma-interval)))
(with-output-to-string (out)
(write-string string out :start 0 :end offset)
(do ((i offset (+ i comma-interval)))
((>= i len))
(unless (zerop i)
(write-char comma-char out))
(write-string string out :start i :end (+ i comma-interval))))))
(inject-comma "1234567" #\, 3)
;;=> "1,234,567"
(inject-comma "1234567" #\. 2)
;;=> "1.23.45.67"
As the comment of jkiiski suggests, you could use the ~/func/ directive.
This is just an example, you can elaborate more with the function:
CL-USER> (defun q(stream arg &rest args)
(declare (ignore args))
(format stream
"~,,'.,:D,~a"
(truncate arg)
(let ((float-string (format nil "~f" arg)))
(subseq float-string (1+ (position #\. float-string))))))
Q
CL-USER> (format t "~/q/~%" 1024.36)
1.024,36
NIL
CL-USER> (format t "~/q/~%" -1024.36)
-1.024,36
NIL
Edited
The first version had round, which is wrong, truncate is the right operator to use.
If you don't mind splitting integer and fractional part, you can do the following:
(multiple-value-bind (int rest) (floor 1234.56)
(let ((rest (round (* rest 1000))))
(format t "~,,'.,:D,~D~%" int rest)))
1.234,560
The multiplication before rounding tells how many digits after comma you would like to print. Not sure if this approach lands itself nicely into automatic control of precision printing, i.e. 1.5 printed as "1,5" and not as "1,500".
Other answers currently use round, which is probably not the intended behavior when rounding up (positive numbers) or down (negative numbers). Here is another approach for a ~/custom/ directive, derived mostly from Renzo's answer.
(defun custom (stream number &rest args)
(declare (ignore args))
(multiple-value-bind (integer decimal) (truncate number)
(format stream "~,,'.,:D~#[,~a~]"
integer
(unless (zerop decimal)
(let ((decimal-string (princ-to-string (abs decimal))))
(subseq decimal-string (1+ (position #\. decimal-string))))))))
TESTS
(loop for i in '(1034.34 -223.12 -10.0 10.0 14 324 1020231)
collect (custom nil i))
=> ("1.034,33996582" "-223,11999512" "-10" "10" "14" "324" "1.020.231")
I've come to this little solution for positive numbers.
(defun comma-point (stream arg &rest args)
(declare (ignore args))
(multiple-value-bind (i r) (truncate arg)
(format stream "~,,',,:D.~2,'0D" i (truncate (* 100 r)))))
;; ^ ^
;; | `Decimal point
;; `Thousands separator
(defun point-comma (stream arg &rest args)
(declare (ignore args))
(multiple-value-bind (i r) (truncate arg)
(format stream "~,,'.,:D,~2,'0D" i (truncate (* 100 r)))))
(defun space-comma (stream arg &rest args)
(declare (ignore args))
(multiple-value-bind (i r) (truncate arg)
(format stream "~,,' ,:D,~2,'0D" i (truncate (* 100 r)))))
The testing numbers:
(dolist (value '(1034.34 -223.12 -10.0 10.0 14 324 1020231.099))
(format t "~16#A" (format nil "~/comma-point/" value))
(format t "~16#A" (format nil "~/point-comma/" value))
(format t "~16#A~%" (format nil "~/space-comma/" value)))
;; 1,034.33 1.034,33 1 034,33
;; -223.-11 -223,-11 -223,-11
;; -10.00 -10,00 -10,00
;; 10.00 10,00 10,00
;; 14.00 14,00 14,00
;; 324.00 324,00 324,00
;; 1,020,231.12 1.020.231,12 1 020 231,12
The second test number shows that does not work for negative numbers (-223.11 => -223,-11). Also, using truncate (or other similar functions) implies that a loss of accuracy appears, as can be seen in the last test number (1020231.099 => 1.020.231,12).
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.
Macroexpand-all in SBCL gives me the following expansion:
(SB-CLTL2:MACROEXPAND-ALL
'(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ A
B)))))
=>
(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ (THE (SIGNED-BYTE 4) 1)
2))))
Why does A get expanded to (THE (SIGNED-BYTE 4) 1) and not just 1?
I understand that this comes from the (DECLARE ((SIGNED-BYTE 4) A)),
but should this affect SYMBOL-MACROLET at all?
Shouldn't it even be valid to
expand to something that is not a (SIGNED-BYTE 4)?
Disclaimer I don't know if this really answer the question. Comments and edits are welcome.
An open issue
As Dirk said in the comment, in Common Lisp The Language is said that (section dedicated to the declare form (link)):
There are certain aspects peculiar to symbol-macrolet. [..] a type
declaration of a name defined by symbol-macrolet is equivalent in
effect to wrapping a the form mentioning that type around the
expansion of the defined symbol.
As far as I can tell, the issue is somewhat controversial, e.g. it seems to be an open issue. Is it mandatory or no? Read here:
Issue SYMBOL-MACROLET-TYPE-DECLARATION Writeup
[..] must (or might) the value returned by MACROEXPAND or
MACROEXPAND-1 include a THE form if there are type declarations that
apply to the symbol-macro being expanded?
There are four proposals, YES, NO, MAYBE, and PROBABLY. Read about them in the article I linked above. Each of the four proposal has a rationale.
SBCL does this. It's a choice of the implementors, I think.
Why? Well, the rationale for the YES gives a reason.
There are some advantages(?)
For example, optimization of the code may be somewhat 'easier' for the compiler. Check this.
No declarations, no the in the expansion:
Take this:
(SB-CLTL2:MACROEXPAND-ALL
'(LAMBDA (A B)
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ A B)))))
the result is simply:
(LAMBDA (A B)
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ 1 2))))
if you put the latter in a file you badly want to optimize, say with something like this:
(declaim (optimize (speed 3) (debug 0) (safety 0)))
and you compile it, SBCL will give you a bunch of warns like this:
; note: forced to do GENERIC-+ (cost 10)
; unable to do inline fixnum arithmetic (cost 1) because:
; The first argument is a NUMBER, not a FIXNUM.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
; unable to do inline fixnum arithmetic (cost 2) because:
; The first argument is a NUMBER, not a FIXNUM.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
; etc.
With declarations, SBCL puts the in the expansion:
Now try this:
(SB-CLTL2:MACROEXPAND-ALL
'(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(declare ((signed-byte 4) B))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ A B)))))
this is the expansion:
(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(DECLARE ((SIGNED-BYTE 4) B))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ (THE (SIGNED-BYTE 4) 1) (THE (SIGNED-BYTE 4) 2)))))
Put the latter in a file, put the declaim for optimization, compile. Guess what? No Warn. SBCL no longer complains about not being able to do some hardocore optimization to your code. It can do it. Because of the (THE (SIGNED-BYTE 4) 1) part.
More about the the special form
So maybe it's a way to ensure your type declaration will affect the variables in the macrolet form too, providind type checking, and enforcing the ability of the compiler to optimize code?
In Common Lisp, let and symbol-macrolet shadow lexical bindings, and the (declare ((signed-byte 4) a)) is a bound declaration, so this is a bug if what SBCL is doing is to propagate the declaration to the shadowing binding.
This example might make it more clear (not a good practice, but it serves the purpose):
(let ((a 1))
(declare (type fixnum a))
(let ((a "1"))
a))
The second a binding shadows the first, so the first becomes inaccessible within the scope of the second.
The second a doesn't have any type declaration, and it shouldn't inherit any from previous lexical bindings with the same name. Type declarations for lexical bindings are supposed to be applied to that specific binding only, no matter its name.
Thus, the output form of macroexpand-all should not have a the wrapping the access to the second a, at least one that clearly comes from the first binding. That is, a compiler may be sufficiently smart to see that the second a is always a string, so it could possibly declare it as a string.
The following examples just exercise the shadowing with both let and symbol-macrolet:
(let ((a 1))
(declare (type fixnum a))
(symbol-macrolet ((a "1"))
a))
(symbol-macrolet ((a 1))
(declare (type fixnum a))
(let ((a "1"))
a))
(symbol-macrolet ((a 1))
(declare (type fixnum a))
(symbol-macrolet ((a "1"))
a))