Clojure doseq generates huge code? - macros

I've recently been playing with clojure and reached a problem that I'm not sure how to handle. I have a doseq with 7 parameters and it expands to a huge block, almost passing the maximum class size. Why does doseq expand to such a huge block of clojure code?
Example:
(def q '(doseq
[p0 (nth (:params operator) 0 (quote (nil)))
p1 (nth (:params operator) 1 (quote (nil)))
p2 (nth (:params operator) 2 (quote (nil)))
p3 (nth (:params operator) 3 (quote (nil)))
p4 (nth (:params operator) 4 (quote (nil)))
p5 (nth (:params operator) 5 (quote (nil)))
p6 (nth (:params operator) 6 (quote (nil)))]
(do-print board (:oname operator) p0 p1 p2 p3 p4 p5 p6)))
and then:
(macroexpand q)
on my machine this gives a huge chunk of code (97331 bytes). Is this normal or am I doing something wrong? Operator is a simple defrecord. Here's a link to the expanded result if anyone is interested: http://pastebin.com/6gw1q078
edit:
By doing the same, but with a for form I get something a few orders of magnitude smaller (3653 bytes):
(def q '(for
[p0 (nth (:params operator) 0 (quote (nil)))
p1 (nth (:params operator) 1 (quote (nil)))
p2 (nth (:params operator) 2 (quote (nil)))
p3 (nth (:params operator) 3 (quote (nil)))
p4 (nth (:params operator) 4 (quote (nil)))
p5 (nth (:params operator) 5 (quote (nil)))
p6 (nth (:params operator) 6 (quote (nil)))]
(do-print board (:oname operator) p0 p1 p2 p3 p4 p5 p6)))
(macroexpand q)
the result is here: http://pastebin.com/9MAKK3VD
Why is there such a huge difference between the two? The doseq form looks innocent enough, I was really surprised when I got an error saying that java class size has been exceeded.

Well, looking at a smaller macro-expasion of doseq reveals the reason:
(loop [seq_2365 (seq [1 2])
chunk_2366 nil
count_2367 0
i_2368 0]
(if (< i_2368 count_2367)
(let [x (.nth chunk_2366 i_2368)]
(do x)
(recur seq_2365 chunk_2366 count_2367 (unchecked-inc i_2368)))
(when-let [seq_2365 (seq seq_2365)]
(if (chunked-seq? seq_2365)
(let [c__4197__auto__ (chunk-first seq_2365)]
(recur (chunk-rest seq_2365) c__4197__auto__ (int (count c__4197__auto__)) (int 0)))
(let [x (first seq_2365)]
(do x)
(recur (next seq_2365) nil 0 0))))))
Ideally we only need the last let form but doseq is emitting additional code to handle chunked-seq in a specific way such that it takes the first chunk and then for each item in the chunk execute the body of doseq and so on.
This code is generated for a single seq in doseq but when you have 2nd seq in it then similar code for handling chunked-seq is generated and hence it explod in size.

Related

How do you compare 3 arguments or more in racket?

I know that in Racket to compare for example two numbers you will have something like this.
(define (myMax x y)
(if (< x y) y x))
My question is how do you compare for a function with 3 arguments or more. For example to get the highest number from the arguments.
(define (myMax x y z)
If you want to process an undefined number of elements, you need to work with list.
The idiomatic way is to use recursion to process the elements. Each function call need to process one element (car) and the rest of the list cdr.
You can find an implementation on a another post:
https://stackoverflow.com/a/42463097/10953006
EDIT 1: EXAMPLE
(define (maximum L)
(if (null? (cdr L))
(car L)
(if (< (car L) (maximum (cdr L)))
(maximum (cdr L))
(car L))))
(maximum '( 1 2 3 ))
(maximum '( 1 2 3 4))
(maximum '( 1 2 3 4 5))
Give the results:
3
4
5
EDIT 2: if the real question is about variable number of arguments in Racket, you could use the following notation:
(define (test-function . L)
(printf "~S~%" L)) ;; Here: L is the list (1 2 3)
(test-function 1 2 3)
Which will display (printf):
(1 2 3)

Writing the Foo Function In LISP With the following Specification

I am struggling to find the right approach to solve the following function
(FOO #'– '(1 2 3 4 5))
=> ((–1 2 3 4 5) (1 –2 3 4 5) (1 2 –3 4 5) (1 2 3 –4 5) (1 2 3 4 –5))
The first Parameter to the foo function is supposed to be a function "-" that has to be applied to each element returning a list of list as shown above. I am not sure as to what approach I can take to create this function. I thought of recursion but not sure how I will preserve the list in each call and what kind of base criteria would I have. Any help would be appreciated. I cannot use loops as this is functional programming.
It's a pity you cannot use loop because this could be elegantly solved like so:
(defun foo (fctn lst)
(loop
for n from 0 below (length lst) ; outer
collect (loop
for elt in lst ; inner
for i from 0
collect (if (= i n) (funcall fctn elt) elt))))
So we've got an outer loop that increments n from 0 to (length lst) excluded, and an inner loop that will copy verbatim the list except for element n where fctn is applied:
CL-USER> (foo #'- '(1 2 3 4 5))
((-1 2 3 4 5) (1 -2 3 4 5) (1 2 -3 4 5) (1 2 3 -4 5) (1 2 3 4 -5))
Replacing loop by recursion means creating local functions by using labels that replace the inner and the outer loop, for example:
(defun foo (fctn lst)
(let ((len (length lst)))
(labels
((inner (lst n &optional (i 0))
(unless (= i len)
(cons (if (= i n) (funcall fctn (car lst)) (car lst))
(inner (cdr lst) n (1+ i)))))
(outer (&optional (i 0))
(unless (= i len)
(cons (inner lst i) (outer (1+ i))))))
(outer))))
Part of the implementation strategy that you choose here will depend on whether you want to support structure sharing or not. Some of the answers have provided solutions where you get completely new lists, which may be what you want. If you want to actually share some of the common structure, you can do that too, with a solution like this. (Note: I'm using first/rest/list* in preference to car/car/cons, since we're working with lists, not arbitrary trees.)
(defun foo (operation list)
(labels ((foo% (left right result)
(if (endp right)
(nreverse result)
(let* ((x (first right))
(ox (funcall operation x)))
(foo% (list* x left)
(rest right)
(list* (revappend left
(list* ox (rest right)))
result))))))
(foo% '() list '())))
The idea is to walk down list once, keeping track of the left side (in reverse) and the right side as we've gone through them, so we get as left and right:
() (1 2 3 4)
(1) (2 3 4)
(2 1) (3 4)
(3 2 1) (4)
(4 3 2 1) ()
At each step but the last, we take the the first element from the right side, apply the operation, and create a new list use revappend with the left, the result of the operation, and the rest of right. The results from all those operations are accumulated in result (in reverse order). At the end, we simply return result, reversed. We can check that this has the right result, along with observing the structure sharing:
CL-USER> (foo '- '(1 2 3 4 5))
((-1 2 3 4 5) (1 -2 3 4 5) (1 2 -3 4 5) (1 2 3 -4 5) (1 2 3 4 -5))
By setting *print-circle* to true, we can see the structure sharing:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((l '(1 2 3 4 5)))
(list l (foo '- l)))
((1 . #1=(2 . #2=(3 . #3=(4 . #4=(5))))) ; input L
((-1 . #1#)
(1 -2 . #2#)
(1 2 -3 . #3#)
(1 2 3 -4 . #4#)
(1 2 3 4 -5)))
Each list in the output shares as much structure with the original input list as possible.
I find it easier, conceptually, to write some of these kind of functions recursively, using labels, but Common Lisp doesn't guarantee tail call optimization, so it's worth writing this iteratively, too. Here's one way that could be done:
(defun phoo (operation list)
(do ((left '())
(right list)
(result '()))
((endp right)
(nreverse result))
(let* ((x (pop right))
(ox (funcall operation x)))
(push (revappend left (list* ox right)) result)
(push x left))))
The base case of a recursion can be determined by asking yourself "When do I want to stop?".
As an example, when I want to compute the sum of an integer and all positive integers below it, I can do this recusively with a base case determined by answering "When do I want to stop?" with "When the value I might add in is zero.":
(defun sumdown (val)
(if (zerop val)
0
(+ (sumdown (1- val)) val)))
With regard to 'preserve the list in each call', rather than trying to preserve anything I would just build up a result as you go along. Using the 'sumdown' example, this can be done in various ways that are all fundamentally the same approach.
The approach is to have an auxiliary function with a result argument that lets you build up a result as you recurse, and a function that is intended for the user to call, which calls the auxiliary function:
(defun sumdown1-aux (val result)
(if (zerop val)
result
(sumdown1-aux (1- val) (+ val result))))
(defun sumdown1 (val)
(sumdown1-aux val 0))
You can combine the auxiliary function and the function intended to be called by the user by using optional arguments:
(defun sumdown2 (val &optional (result 0))
(if (zerop val)
result
(sumdown2 (1- val) (+ val result))))
You can hide the fact that an auxiliary function is being used by locally binding it within the function the user would call:
(defun sumdown3 (val)
(labels ((sumdown3-aux (val result)
(if (zerop val)
result
(sumdown3-aux (1- val) (+ val result)))))
(sumdown3-aux val 0)))
A recursive solution to your problem can be implemented by answering the question "When do I want to stop when I want to operate on every element of a list?" to determine the base case, and building up a result list-of-lists (instead of adding as in the example) as you recurse. Breaking the problem into smaller pieces will help - "Make a copy of the original list with the nth element replaced by the result of calling the function on that element" can be considered a subproblem, so you might want to write a function that does that first, then use that function to write a function that solves the whole problem. It will be easier if you are allowed to use functions like mapcar and substitute or substitute-if, but if you are not, then you can write equivalents yourself out of what you are allowed to use.

making same-parity function with g . w in mit scheme

I am trying to write a function that takes one or more integers and returns a list of all the arguments that have the same even-odd parity as the first argument, for example
(same-parity 1 2 3 4 5 6 7)->(1 3 5 7)
(same-parity 2 3 4 5 6)->(2 4 6).
my code is
(define (same-parity g . w)
(define (iter-parity items)
(if (= (length items) 1)
(if (= (remainder items 2) (remainder g 2))
item
'())
(if (= (remainder g 2) (remainder (car items) 2))
(cons (car items) (iter-parity (cdr items)))
(iter-parity (cdr items)))))
(cons g (iter-parity w)))
when try this (same-parity (list 1 2 3 4)), I got an error message:
the object (), passed as the first argument to car, is not the correct type.
Can I somebody tell me what is going on?
Your code
Here's a refactoring proposal, keeping with your basic structure:
(define (same-parity g . w)
(define filter-predicate? (if (odd? g) odd? even?))
(define (iter-parity items)
(if (null? items)
'()
(if (filter-predicate? (car items))
(cons (car items) (iter-parity (cdr items)))
(iter-parity (cdr items)))))
(cons g (iter-parity w)))
Note that it is more idiomatic
to use the procedures odd? and even? rather than remainder
to have as a base case when the list is empty, not when it has only one item (in your code this clearly avoids repetition as a positive effect).
Also, since there is a built-in filter procedure in Scheme, you could express it as follows:
(define (same-parity g . w)
(cons g (filter (if (odd? g) odd? even?) w)))
Your question
As for your question regarding (same-parity (list 1 2 3 4)): you need either (as described in your specification) use your procedure like so
(same-parity 1 2 3 4)
or to use apply here:
> (apply same-parity (list 1 2 3 4))
'(1 3)
because apply will transform (same-parity (list 1 2 3 4)) (1 parameter, a list) into (same-parity 1 2 3 4) (4 parameters).

reduce using cl-loop facility

CL library manual "map over sequences" says "All of these mapping operations can be expressed conveniently in terms of the cl-loop macro" but I don't see how cl-reduce can be expressed in terms of cl-loop
Not sure how "conveniently" expressed it is, but here's my take on it:
(defun loop-reduce (func sequence &rest initial-element)
(loop with result =
(or (car initial-element)
(prog1 (car sequence)
(setf sequence (cdr sequence))))
for x in sequence do (setf result (funcall func result x))
finally (return result)))
(loop-reduce '+ '(1 2 3 4 5))
;; 15
(loop-reduce '+ '(1 2 3 4 5) 10)
;; 25

Is there a common lisp macro for popping the nth element from a list?

I'm pretty fresh to the Common Lisp scene and I can't seem to find an quick way to get the nth element from a list and remove it from said list at the same time. I've done it, but it ain't pretty, what I'd really like is something like "pop" but took a second parameter:
(setf x '(a b c d))
(setf y (popnth 2 x))
; x is '(a b d)
; y is 'c
I'm pretty sure that "popnth" would have to be a macro, in case the parameter was 0 and it had to behave like "pop".
EDIT: Here's my crap first version:
(defmacro popnth (n lst)
(let ((tempvar (gensym)))
`(if (eql ,n 0)
(pop ,lst)
(let ((,tempvar (nth ,n ,lst)))
(setf (cdr (nthcdr ,(- n 1) ,lst)) (nthcdr ,(+ n 1) ,lst))
,tempvar))))
Something like this:
Removing the nth element of a list:
(defun remove-nth (list n)
(remove-if (constantly t) list :start n :end (1+ n)))
constantly returns a function, that always returns its argument.
As a macro that accepts a place, using define-modify-macro:
(define-modify-macro remove-nth-f (n) remove-nth "Remove the nth element")
POP-NTH
(defmacro pop-nth (list n)
(let ((n-var (gensym)))
`(let ((,n-var ,n))
(prog1 (nth ,n-var ,list)
(remove-nth-f ,list ,n-var)))))
Example:
CL-USER 26 > (defparameter *list* (list 1 2 3 4))
*LIST*
CL-USER 27 > (pop-nth *list* 0)
1
CL-USER 28 > *list*
(2 3 4)
CL-USER 29 > (pop-nth *list* 2)
4
CL-USER 30 > *list*
(2 3)
Yes, Lisp has a macro for popping the N-th element of a list: it is called pop.
$ clisp -q
[1]> (defvar list (list 0 1 2 3 4 5))
LIST
[2]> (pop (cdddr list))
3
[3]> list
(0 1 2 4 5)
[4]>
pop works with any form that denotes a place.
The problem is that, unlike cddr, nthcdr isn't an accessor; a form like (nthcdr 3 list) does not denote a place; it works only as a function call.
Writing a specialized form of pop is not the best answer; rather, we can achieve a more general fix by writing a clone of nthcdr which behaves like a place accessor. Then the pop macro will work, and so will every other macro that works with places like setf and rotatef.
;; our clone of nthcdr called cdnth
(defun cdnth (idx list)
(nthcdr idx list))
;; support for (cdnth <idx> <list>) as an assignable place
(define-setf-expander cdnth (idx list &environment env)
(multiple-value-bind (dummies vals newval setter getter)
(get-setf-expansion list env)
(let ((store (gensym))
(idx-temp (gensym)))
(values dummies
vals
`(,store)
`(let ((,idx-temp ,idx))
(progn
(if (zerop ,idx-temp)
(progn (setf ,getter ,store))
(progn (rplacd (nthcdr (1- ,idx-temp) ,getter) ,store)))
,store))
`(nthcdr ,idx ,getter)))))
Test:
$ clisp -q -i cdnth.lisp
;; Loading file cdnth.lisp ...
;; Loaded file cdnth.lisp
[1]> (defvar list (list 0 1 2 3 4 5))
LIST
[2]> (pop (cdnth 2 list))
2
[3]> list
(0 1 3 4 5)
[4]> (pop (cdnth 0 list))
0
[5]> list
(1 3 4 5)
[6]> (pop (cdnth 3 list))
5
[7]> list
(1 3 4)
[8]> (pop (cdnth 1 list))
3
[9]> list
(1 4)
[10]> (pop (cdnth 1 list))
4
[11]> list
(1)
[12]> (pop (cdnth 0 list))
1
[13]> list
NIL
[14]>
A possible improvement to the implementation is to analyze the idx form and optimize away the generated code that implements the run-time check on the value of idx. That is to say, if idx is a constant expression, there is no need to emit the code which tests whether idx is zero. The appropriate code variant can just be emitted. Not only that, but for small values of idx, the code can emit special variants based on the "cadavers": cddr, cdddr, rather than the general nthcdr. However, some of these optimizations might be done by the Lisp compiler and thus redundant.
I came up with a solution that is a little more efficient than my first attempt:
(defmacro popnth (n lst)
(let ((t1 (gensym))(t2 (gensym)))
`(if (eql ,n 0)
(pop ,lst)
(let* ((,t1 (nthcdr (- ,n 1) ,lst))
(,t2 (car (cdr ,t1))))
(setf (cdr ,t1) (cddr ,t1))
,t2))))
Here is it in action:
[2]> (defparameter *list* '(a b c d e f g))
*LIST*
[3]> (popnth 3 *list*)
D
[4]> *list*
(A B C E F G)
[5]> (popnth 0 *list*)
A
[6]> *list*
(B C E F G)
I have same suspicion as #6502...If I remember right...Neither push nor pop can be defined as modify-macros, the former because the place is not its first argument, and the latter because its return value is not the modified object.
Definition of define-modify-macro
An expression of the form (define-modify-macro m (p1 ... pn) f) defines a new macro m, such that a call of the form (m place a1 ... an) will cause place to be set to (f val a1 ... an), where val represents the value of place. The parameters may also include rest and optional parameters. The string, if present, becomes the documentation of the new macro.
I have this popnth works just fine:
(defun nthpop (index lst)
(pop (nthcdr (1- index) lst)))
> *list*
(1 2 3 4 5)
> (nthpop 2 *list*)
2
> *list*
(1 3 4 5)