Here is just a simplified code snipped I have not managed to work. I do not understand what is wrong.
(defun enumerate-indicies (func)
(let ((index 0))
(while (< index 5)
(funcall func index)
(setq index (1+ index)))))
(defun enumerate-multiplied-indicies (func)
(enumerate-indicies #'(lambda (index)
(funcall func (* 10 index)))))
The following testing code returns 10 as expected:
(defun test/enumerate-indicies ()
(let ((sum 0))
(enumerate-indicies #'(lambda (index)
(setq sum (+ sum index))))
sum))
(test/enumerate-indicies)
But the below causes error Lisp nesting exceeds max-lisp-eval-depth in my Emacs:
(defun test/enumerate-multiplied-indicies ()
(let ((sum 0))
(enumerate-multiplied-indicies #'(lambda (index)
(setq sum (+ sum index))))
sum))
(test/enumerate-multiplied-indicies)
Could you please give my a clue? That is not supposed be a recursive call here but seems that it is. Thanks.
How about using lexical-let to penetrate the lambda? Is the correct answer 100?
(defun enumerate-indicies (func)
(let ((index 0))
(while (< index 5)
(funcall func index)
(setq index (1+ index)))))
(defun enumerate-multiplied-indicies (func)
(lexical-let ((func func))
(enumerate-indicies #'(lambda (index)
(funcall func (* 10 index))))))
(defun test/enumerate-multiplied-indicies ()
(lexical-let ((sum 0))
(enumerate-multiplied-indicies #'(lambda (index)
(setq sum (+ sum index))))
sum))
(test/enumerate-multiplied-indicies)
Related
I write a macro that accepts a list of lambdas to be called and generates a function. The lambdas are always evaluated in defun argument list, but not in defmacro. How can I avoid call to eval inside defmacro?
This code works:
(defmacro defactor (name &rest fns)
(let ((actors (gensym)))
`(let (;(,actors ',fns)
(,actors (loop for actor in ',fns
collect (eval actor)))) ; This eval I want to avoid
(mapcar #'(lambda (x) (format t "Actor (type ~a): [~a]~&" (type-of x) x)) ,actors)
(defun ,name (in out &optional (pos 0))
(assert (stringp in))
(assert (streamp out))
(assert (or (plusp pos) (zerop pos)))
(loop for actor in ,actors
when (funcall actor in out pos)
return it)))))
;; Not-so-relevant use of defactor macros
(defactor invert-case
#'(lambda (str out pos)
(let ((ch (char str pos)))
(when (upper-case-p ch)
(format out "~a" (char-downcase ch))
(1+ pos))))
#'(lambda (str out pos)
(let ((ch (char str pos)))
(when (lower-case-p ch)
(format out "~a" (char-upcase ch))
(1+ pos)))))
This code evaluates as expected to:
Actor (type FUNCTION): [#<FUNCTION (LAMBDA (STR OUT POS)) {100400221B}>]
Actor (type FUNCTION): [#<FUNCTION (LAMBDA (STR OUT POS)) {100400246B}>]
INVERT-CASE
And its usage is:
;; Complete example
(defun process-line (str &rest actors)
(assert (stringp str))
(with-output-to-string (out)
(loop for pos = 0 then (if success success (1+ pos))
for len = (length str)
for success = (loop for actor in actors
for ln = len
for result = (if (< pos len)
(funcall actor str out pos)
nil)
when result return it)
while (< pos len)
unless success do (format out "~a" (char str pos)))))
(process-line "InVeRt CaSe" #'invert-case) ; evaluates to "iNvErT cAsE" as expected
Without eval, the defactor above evaluates to:
Actor (type CONS): [#'(LAMBDA (STR OUT POS)
(LET ((CH (CHAR STR POS)))
(WHEN (UPPER-CASE-P CH)
(FORMAT OUT ~a (CHAR-DOWNCASE CH))
(1+ POS))))]
Actor (type CONS): [#'(LAMBDA (STR OUT POS)
(LET ((CH (CHAR STR POS)))
(WHEN (LOWER-CASE-P CH)
(FORMAT OUT ~a (CHAR-UPCASE CH))
(1+ POS))))]
and all the rest obviously doesn't work.
If I transform defmacro into defun, it doesn't need eval:
(defun defactor (name &rest fns)
(defun name (in out &optional (pos 0))
(assert (stringp in))
(assert (streamp out))
(assert (or (plusp pos) (zerop pos)))
(loop for actor in fns
when (funcall actor in out pos)
return it)))
However, it always defines the function name instead of the passed function name argument (which should be quoted).
Is it possible to write defactor with the possibility to pass the function name unlike defun version, and without eval in macro version of it?
You're making things more complex than necessary with the first loop... just collect the parameters instead
(defmacro defactor (name &rest fns)
(let ((actors (gensym)))
`(let ((,actors (list ,#fns)))
(mapcar #'(lambda (x) (format t "Actor (type ~a): [~a]~&" (type-of x) x)) ,actors)
(defun ,name (in out &optional (pos 0))
(assert (stringp in))
(assert (streamp out))
(assert (or (plusp pos) (zerop pos)))
(loop for actor in ,actors
when (funcall actor in out pos)
return it)))))
This mostly doesn’t need to be a macro as-is. You can mostly use a helper function:
(defun make-actor (&rest funs)
(lambda (in out &optional (pos 0)
(loop for actor in funs
when (funcall actor in out pos) return it)))
And write a simple macro:
(defmacro defactor (name &rest funs)
`(let ((f (make-actor ,#funs)))
(defun ,name (in out &optional (pos 0)) (funcall f in out pos))))
However this doesn’t gain much in terms of expressivity (you practically call the macro like a function) or efficiency (the compiler has to be quite clever to work out how to improve the code by inclining a bunch of complicated things).
Here is another way one might implement something like this:
(defmacro defactor (name (in out pos) &rest actors)
(let ((inv (gensym "IN"))
(outv (gensym "OUT"))
(posv (gensym "POS")))
`(defun ,name (,inv ,outv &optional (,posv 0))
;; TODO: (declare (type ...) ...)
(or ,#(loop for form in actors
collect `(let ((,in ,inv) (,out ,outv) (,pos ,posv)) ,form)))))
And then use it like:
(defactor invert-case (in out pos)
(let ((ch (char str pos)))
(when (upper-case-p ch)
(format out "~a" (char-downcase ch))
(1+ pos)))
(let ((ch (char str pos)))
(when (lower-case-p ch)
(format out "~a" (char-upcase ch))
(1+ pos))))
I'm trying to create lambda functions that use the same code but have different Internal parameters.
To clarify, I'm putting here the code:
(defun testes ()
(setf lol '())
(loop for i in (list 1 2 3 4 5 )
do (loop for j in (list 1 2 3 4 5)
do (setf lol (append lol (list (cons i j))))))
lol
)
(defun mainff ()
(setf lol (testes))
(setf res ())
(print lol)
(loop for i in lol
do (setf res (append res (list #'(lambda ()
(print i)
))))
)
res
)
(defun fun()
(setf res (mainff))
(loop for i in res
do (funcall i)
)
)
Returning to the inicial question, i in the append of res must be unique to each lambda that is created. However it only saves the last value that it assumes (5 5). Any way to solve this?
Use LET to create a different binding for each i.
(loop for element in list
...
(let ((i element))
(lambda ()
(print i)))
...
)
From reading a Lisp book I remember they showed an example of an OOP-style method dispatcher based on closures:
(defun create-object ()
(let ((val 0)
(get (lambda () val))
(set (lambda (new-val) (setq val new-val)))
(inc (lambda () (setq val (+ 1 val)))))
(lambda (method)
(cond ((eq method 'get)
get)
((eq method 'set)
set)
((eq method 'inc)
inc)))))
(let ((obj (create-object)))
(funcall (obj 'set) 1)
(funcall (obj 'inc))
(funcall (obj 'get))) ;; 2
Since it's just a function with a string symbol argument, I guess code intel won't be of much help here, not completing the method names or their signatures. (Compare with a similar JavaScript object.)
Is this problem generally solved? How do you program an object system in Scheme so that an editor (like Emacs) can be more intelligent with your code?
P.S. The example may be not a valid Scheme code, but you should get the idea.
I've made some starting code for you.
It's for Emacs Lisp, but it's should be very easily portable to Scheme.
Here's your usage example:
(defun create-object ()
(lexical-let* ((val 0)
(get (lambda() val))
(set (lambda(x) (setq val x))))
(generate-dispatch-table get set)))
(setq obj (create-object))
(funcall (funcall obj 'get))
;; => 0
(funcall (funcall obj 'set) 1)
;; => 1
(funcall (funcall obj 'get))
;; => 1
(scheme-completions obj)
;; => (get set)
And here's how it's implemented:
(defmacro generate-dispatch-table (&rest members)
`(lambda (method)
(cond ,#(mapcar
(lambda (x) `((eq method ',x) ,x)) members))))
(defun collect (pred x)
(when (and x (listp x))
(let ((y (funcall pred x))
(z (append
(collect pred (car x))
(collect pred (cdr x)))))
(if y
(append (list y) z)
z))))
(defun scheme-completions (obj)
(collect
(lambda(x) (and (eq (car x) 'eq)
(eq (cadr x) 'method)
(eq (caaddr x) 'quote)
(cadr (caddr x))))
obj))
And here's a simple visual interface for completions:
(require 'helm)
(defun scheme-completions-helm ()
(interactive)
(let ((y (and
(looking-back "(funcall \\([^ ]*\\) +")
(intern-soft (match-string 1)))))
(when y
(helm :sources
`((name . "members")
(candidates . ,(scheme-completions (eval y)))
(action . (lambda(x) (insert "'" x))))))))
I'm not a Emacs user, but use DrRacket and it does have an object system and do what an IDE should do, but I know Emacs is very customizable since it uses elisp so you can make support for your own syntax both in syntax highlighting and tab-completion. So you do:
Make your own object system
Edit your Emacs editor to do what you want
Many of my colleagues use it and they fix their Emacs in such ways.
Another thing, this question makes me think about the resources at schemewiki.org on the subject where the different approaches are mentioned and even a similar code to the one you posted is posted as example. It's a good read.
I would avoid double notion of symbols in create-object via an obarray.
Furthermore, the interface of the object are all functions. Therefore, use fset and avoid the double funcall.
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (intern (symbol-name method) _oa) args))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
Example for inheritance:
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (or (intern-soft (symbol-name method) _oa)
(error "Undefined function: %s" method))
args))))
(defun create-object-add10 ()
(lexical-let ((base (create-object))
(_oa (make-vector 11 0)))
(fset (intern "inc" _oa) (lambda () (funcall base 'set (+ (funcall base 'get) 10))))
(lambda (method &rest args)
(let ((call (intern-soft (symbol-name method) _oa)))
(if call
(apply 'funcall call args)
(apply 'funcall base method args))))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object-add10))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
The definition of create-object-like methods should additionally be supported through macros. That is not done here.
For more features, note, there is a CLOS-compatible object oriented system in emacs:
https://www.gnu.org/software/emacs/manual/html_node/eieio/index.html
The function "greaterthan", (< NUM1 NUM2), allows only for returning t/nil for comparing 2 values.
I would like to test (var1 > var2 < var3 < var4), is there any way to do that using only one function in lisp? If not, what is the best procedure?
The best procedure is not to bother: (and (< var2 var1) (< var2 var3) (< var3 var4)) is not harder to read that your ..>..<..<.. chain.
It makes sense to test for the ascending order:
(require 'cl)
(defun cl-< (&rest args)
(every '< args (cdr args))
These days I don't hesitate to (require 'cl) anymore, but if you do,
here is another variant:
(defun cl-< (arg &rest more-args)
(or (null more-args)
(and (< arg (first more-args))
(apply #'cl-< more-args))))
The following is a macro implementation for variadic <
(defmacro << (x y &rest args)
(if args
(if (or (symbolp y)
(numberp y))
`(and (< ,x ,y) (<< ,y ,#args))
(let ((ys (make-symbol "y")))
`(let (,ys)
(and (< ,x (setq ,ys ,y))
(<< ,ys ,#args)))))
`(< ,x ,y)))
for simple cases just expands to (and ...) chains
(<< x y z) ==> (and (< x y) (< y z))
where the expression is not a number and not a symbol expands to a more complex form to avoid multiple evaluations in presence of side effects
(<< (f x) (g y) (h z)) ==> (let ((gy)) (and (< (f x) (setq gy (g y)))
(< gy (h z))))
for example
(setq foo (list))
nil
(defun call (x) (push x foo) x)
call
(<< (call 1) (call 2) (call 5) (call 4) (call 0))
nil
foo
(4 5 2 1)
every function has been called once, except for 0 that didn't need to be called because of short circuiting (I'm not 100% sure if short circuiting is a really good idea or not... #'< in Common Lisp is a regular function with all arguments all evaluated exactly once in left-to-right order without short circuiting).
(defun << (arg1 arg2 arg3 arg4)
(when (and (< arg1 arg2) (< arg2 arg3) (< arg3 arg4)))
)
(<< 1 2 3 4)
Probably possible to extend with any amount of arguments, but such a general form would seem useful.
(defmacro << (&rest args)
(let ((first (car args))
(min (gensym))
(max (gensym))
(forms '(t)) iterator)
(setq args (reverse (cdr args))
iterator args)
`(let ((,min ,first) ,max)
,(or
(while iterator
(push `(setq ,min ,max) forms)
(push `(< ,min ,max) forms)
(push `(setq ,max ,(car iterator)) forms)
(setq iterator (cdr iterator))) `(and ,#forms)))))
(macroexpand '(<< 10 20 30 (+ 30 3) (* 10 4)))
(let ((G99730 10) G99731)
(and (setq G99731 20)
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 30)
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 (+ 30 3))
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 (* 10 4))
(< G99730 G99731)
(setq G99730 G99731) t))
This is the idea similar to 6502's, but it may create less code, in a less trivial situation, but it will create more code in a trivial situation.
I'm playing around in CL, making a One-Dimensional version of Battleship before I try to tackle a full Two-Dimensional version, and I've hit a hangup. To check if the boat is there, I've represented it with zeroes, and when a spot is hit, I replace it with an asterisk, so I can check the list with numberp. However, when I run (new-game), it immediately finishes, which tells me that I'm not entering the zeroes correctly so that they are recognized as numbers. What am I doing wrong? I know it must be a rookie mistake.
;;;; Suez-Canal.lisp
;;;;
;;;; A simple, 1-Dimensional version of Battleship
;;;; The computer places a boat randomly, and you must sink it.
(setf *random-state* (make-random-state t))
(defparameter *boat-length* 3)
(defparameter *canal-length* 10)
(defparameter *shots-fired* 0)
(defun new-game ()
(init-canal *canal-length*)
(place-boat)
(game-loop)
(format t "It took you ~a shots to sink the boat." *shots-fired*))
(defun init-canal (len)
(defparameter *canal* (make-list len)))
(defun place-boat ()
(let ((pos (random-spot)))
(setf (nth pos *canal*) 'O)
(setf (nth (+ pos 1) *canal*) 'O)
(setf (nth (+ pos 2) *canal*) 'O)))
(defun random-spot ()
(let ((x (random 7)))
x))
(defun game-loop ()
(loop until (notany #'numberp *canal*)
do (progn
(prompt-for-guess)
(check-guess (read-guess))
(incf *shots-fired*))))
(defun prompt-for-guess ()
(format t "~&Enter in a number between 1 and 10 to fire a shot.~&"))
(defun read-guess ()
(parse-integer (read-line *query-io*) :junk-allowed t))
(defun check-guess (guess)
(if (and (<= guess 9)
(>= guess 0))
(fire-shot guess)
(progn
(format t "~&Invalid selection~&")
(check-guess (read-guess)))))
(defun fire-shot (pos)
(if (= (nth (- pos 1) *canal*) 0)
(progn
(setf (nth (- pos 1) *canal*) #\*)
(print "Hit!"))
(print "Miss!")))
You are not entering zeroes at all, but rather the letter 'O'.
Other notes:
Do not use DEFPARAMETER inside DEFUN. Define the variable at top level, and inside the initialization function just SETF it.
Do not use lists for random access. Use arrays.
Numerical comparison operators will signal an error when given a non-numeric value. Use EQL for general comparisons.
Here is a corrected version:
(setf *random-state* (make-random-state t))
(defparameter *boat-length* 3)
(defparameter *canal-length* 10)
(defparameter *shots-fired* 0)
;;; you need to declare *canal* at toplevel.
(defparameter *canal* nil)
(defun new-game ()
(init-canal *canal-length*)
(place-boat)
(game-loop)
(format t "It took you ~a shots to sink the boat." *shots-fired*))
;;; just set the the variable.
(defun init-canal (length)
(setq *canal* (make-list length)))
;;; you need to set those positions to 0 and not to O
(defun place-boat ()
(let ((pos (random-spot)))
(setf (nth pos *canal*) 0)
(setf (nth (+ pos 1) *canal*) 0)
(setf (nth (+ pos 2) *canal*) 0)))
;;; no need for a LET
(defun random-spot ()
(random 7))
;;; no need for progn
;;; you could also replace UNTIL NOTANY with WHILE SOME
(defun game-loop ()
(loop until (notany #'numberp *canal*)
do
(prompt-for-guess)
(check-guess (read-guess))
(incf *shots-fired*)))
(defun prompt-for-guess ()
(format t "~&Enter in a number between 1 and 10 to fire a shot.~&"))
(defun read-guess ()
(parse-integer (read-line *query-io*) :junk-allowed t))
;;; <= can take more than two arguments
;;; typically this recursive version might be replaced with a LOOP
(defun check-guess (guess)
(if (<= 0 guess 9)
(fire-shot guess)
(progn
(format t "~&Invalid selection~&")
(check-guess (read-guess)))))
;;; use EQL, = only compares numbers
(defun fire-shot (pos)
(if (eql (nth (- pos 1) *canal*) 0)
(progn
(setf (nth (- pos 1) *canal*) #\*)
(print "Hit!"))
(print "Miss!")))