Lexical versus dynamic scope, let form, declare form - common-lisp

Dynamic versus lexical scope.
; One expects lexical scope.
(let (( a '(a)))
(defun func1 (x)
(setq a (cons x (cons (func2 x) a))))
(defun func2 (y)
(setq a (cons y a))))
(func1 'b)
=> (B (B A) B A)
Doing it lexically, one would expect
the following.
Substitute (a) for the a in func2.
func2 is called with x, i.e. the value b.
func2 also attaches the value of a with (a).
So the (cons y a) evaluates to (b a).
(setq a (cons y a))) is (b a).
So func1 will cons (b a) with (a).
x is then consed (b (b a) a)).
End result (b (b a) a)? Is this a contradiction?
Let us try a dynamical version.
; dynamic scope
(defparameter a '(a))
(defun func1 (x)
(setq a (cons x (cons (func2 x) a))))
(defun func2 (y)
(setq a (cons y a)))
(func1 'b)
=>(B (B A) B A)
This works as is to be expected but is the same as in lexical scope?
But the following is not accepted at all.
; This won't work.
(let (( a '(a)))
(defun func1 (x)
(declare (special a))
(setq a (cons x (cons (func2 x) a))))
(defun func2 (y)
(declare (special a))
(setq a (cons y a))))
(func1 'b)
Error: Attempt to take the value of the unbound variable `A'.
What is going on?

Thanks for the keen eyes. This example is from a 31 years old printed Lisp textbook straight out of the chapter "dynamic versus lexical scoping". The explanation comes also straight out of that book. I guess that the lexical scoping was not checked, because the authors explicitly warn the readers that lexical scoping was not done in Lisp. I am happy that this is solved. I stared some time on it, without understanding what was really going on. It seemed to be an odd contradiction.

Related

Is there a way to implement mapcar in Common Lisp using only applicative programming and avoiding recursion or iteration as programming styles?

I am trying to learn Common Lisp with the book Common Lisp: A gentle introduction to Symbolic Computation. In addition, I am using SBCL, Emacs and Slime.
In chapter 7, the author suggests there are three styles of programming the book will cover: recursion, iteration and applicative programming.
I am interested on the last one. This style is famous for the applicative operator funcall which is the primitive responsible for other applicative operators such as mapcar.
Thus, with an educational purpose, I decided to implement my own version of mapcar using funcall:
(defun my-mapcar (fn xs)
(if (null xs)
nil
(cons (funcall fn (car xs))
(my-mapcar fn (cdr xs)))))
As you might see, I used recursion as a programming style to build an iconic applicative programming function.
It seems to work:
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list ))
NIL
;; comparing the results with the official one
CL-USER> (mapcar (lambda (n) (+ n 1)) (list ))
NIL
CL-USER> (mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
Is there a way to implement mapcar without using recursion or iteration? Using only applicative programming as a style?
Thanks.
Obs.: I tried to see how it was implemented. But it was not possible
CL-USER> (function-lambda-expression #'mapcar)
NIL
T
MAPCAR
I also used Emacs M-. to look for the documentation. However, the points below did not help me. I used this to find the files below:
/usr/share/sbcl-source/src/code/list.lisp
(DEFUN MAPCAR)
/usr/share/sbcl-source/src/compiler/seqtran.lisp
(:DEFINE-SOURCE-TRANSFORM MAPCAR)
/usr/share/sbcl-source/src/compiler/fndb.lisp
(DECLAIM MAPCAR SB-C:DEFKNOWN)
mapcar is by itself a primitive applicative operator (pag. 220 of Common Lisp: A gentle introduction to Symbolic Computation). So, if you want to rewrite it in an applicative way, you should use some other primitive applicative operator, for instance map or map-into. For instance, with map-into:
CL-USER> (defun my-mapcar (fn list &rest lists)
(apply #'map-into (make-list (length list)) fn list lists))
MY-MAPCAR
CL-USER> (my-mapcar #'1+ '(1 2 3))
(2 3 4)
CL-USER> (my-mapcar #'+ '(1 2 3) '(10 20 30) '(100 200 300))
(111 222 333)
Technically, recursion can be implemented as follows:
(defun fix (f)
(funcall (lambda (x) (funcall x x))
(lambda (x) (funcall f (lambda (&rest y) (apply (funcall x x) y))))))
Notice that fix does not use recursion in any way. In fact, we could have only used lambda in the definition of f as follows:
(defconstant fix-combinator
(lambda (g) (funcall
(lambda (x) (funcall x x))
(lambda (x) (funcall
g
(lambda (&rest y) (apply (funcall x x)
y)))))))
(defun fix-2 (f)
(funcall fix-combinator f))
The fix-combinator constant is more commonly known as the y combinator.
It turns out that fix has the following property:
Evaluating (apply (fix f) list) is equivalent to evaluating (apply (funcall f (fix f)) list). Informally, we have (fix f) = (funcall f (fix f)).
Thus, we can define map-car (I'm using a different name to avoid package lock) by
(defun map-car (func lst)
(funcall (fix (lambda (map-func) (lambda (lst) ; We want mapfunc to be (lambda (lst) (mapcar func lst))
(if (endp lst)
nil
(cons (funcall func (car lst))
(funcall map-func (cdr lst)))))))
lst))
Note the lack of recursion or iteration.
That being said, generally mapcar is just taken as a primitive notion when using the "applicative" style of programming.
Another way you can implement mapcar is by using the more general reduce function (a.k.a. fold). Let's name the user-provided function f and define my-mapcar.
The reduce function carries an accumulator value that builds up the resulting list, here it is going take a value v, a sublist rest, and call cons with (funcall f v) and rest, so as to build a list.
More precisely, here reduce is going to implement a right-fold, since cons is right-associative (e.g. the recursive list is the "right" hand side, ie. the second argument of cons, e.g. (cons a (cons b (cons nil)))).
In order to define a right-fold with reduce, you pass :from-end t, which indicates that it builds-up a value from the last element and the initial accumulator to obtain a new accumulator value, then the second to last element with that new accumulator to build a new accumulator, etc. This is how you ensure that the resulting elements are in the same order as the input list.
In that case, the reducing function takes its the current element as its first argument, and the accumulator as a second argument.
Since the type of the elements and the type of the accumulator are different, you need to pass an :initial-value for the accumulator (the default behavior where the initial-value is taken from the list is for functions like + or *, where the accumulator is in the same domain as the list elements).
With that in mind, you can write it as follows:
(defun my-map (f list)
(reduce (lambda (v rest) (cons (funcall f v) rest))
list
:from-end t
:initial-value nil))
For example:
(my-map #'prin1-to-string '(0 1 2 3))
; => ("0" "1" "2" "3")

Clisp : select sublists with a given length

Working on CLISP in Sublime Text.
Exp. in CLISP : less than 1 year
It's already for a while that I'm trying to solve this exercice... without success... as you might guess.
In fact I have to create a function which will modify the list and keeps only sublists which are equals or greater than the given number (watch below)
The list on which I have to work :
(setq liste '((a b) c (d) (e f) (e g x) f))
I'm supposed to find this as result :
(lenght 2 liste) => ((a b) (e f) (e g x))
liste => ((a b) (e f) (e g x))
Here my code :
(defun lenght(number liste)
(cond
((atom liste) nil)
((listp (car liste))
(rplacd liste (lenght number (cdr liste))) )
((<= (lenght number (car liste)) number)
(I don't know what to write) )
((lenght number (cdr liste))) ) )
It will be very kind if you could give me only some clue so as to let me find the good result.
Thanks guys.
Modifying the list does not make much sense, because it gets hairy at the head of the list to retain the original reference. Return a new list.
This is a filtering operation. The usual operator in Common Lisp for that is remove-if-not (or remove-if, or remove, depending on the condition). It takes a predicate that should return whether the element should be kept. In this case, it seems to be (lambda (element) (and (listp element) (>= (length element) minlength))).
(defun filter-by-min-length (minlength list)
(remove-if-not (lambda (element)
(and (listp element)
(>= (length element) minlength)))
list))
In many cases, when the condition is known at compile time, loop produces faster compiled code:
(defun filter-by-min-length (minlength list)
(loop :for element :in list
:when (and (listp element)
(>= (length element) minlength))
:collect element))
This returns a new list that fulfills the condition. You'd call it like (let ((minlength-list (filter-by-min-length 2 raw-list))) …).
Many basic courses insist on recursively using primitive operations on cons cells for teaching purposes at first.
The first attempt usually disregards the possible stack exhaustion. At each step, you first look whether you're at the end (then return nil), whether the first element should be discarded (then return the result of recursing on the rest), or if it should be kept (then cons it to the recursion result).
If tail call optimization is available, you can refactor this to use an accumulator. At each step, instead of first recursing and then consing, you cons a kept value onto the accumulator and pass it to the recursion. At the end, you do not return nil, but reverse the accumulator and return that.
Well, I have found the answer that I was looking for, after scratching my head until blood...
Seriously, here is the solution which is working (and thanks for the correction about length which helped me to find the solution ^^) :
(defun filter-by-min-length (min-length liste)
(cond
((atom liste) nil)
((and (listp (car liste))(>= (length (car liste)) min-length))
(rplacd liste (filter-by-min-length min-length (cdr liste))) )
((filter-by-min-length min-length (cdr liste))) ) )
A non-modifying version
(defun filter-by-min-length (min-length le)
(cond ((atom le) nil)
((and (listp (car le)) (>= (length (car le)) min-length))
(cons (car le) (filter-by-min-length min-length (cdr le))))
(t (filter-by-min-length min-length (cdr le)))))
Test:
(defparameter *liste* '((a b) c (d) (e f) (e g x) f))
(filter-by-min-length 2 *liste*)
;; ((A B) (E F) (E G X))
*liste*
;; ((A B) C (D) (E F) (E G X) F) ; -> *liste* not modified
For building good habits, I would recommend to use defparameter instead of setq, since the behaviour of setq might not always be defined (see here). In the link, it is said:
use defvar, defparameter, or let to introduce new variables. Use setf
and setq to mutate existing variables. Using them to introduce new
variables is undefined behaviour

How to make deep-reverse function in Lisp

I am trying to make deep-reverse function in lisp. For example:
(a (b c d) e) -> (e (d c b) a)
Here is my code.
(defun deeprev (l)
(cond ((null l) nil)
((list (car l)) (append (deeprev (cdr l)) (deeprev (car l))))
(t (append (deeprev (cdr l))(car l)))
)
)
Whenever I compile and load, I have an error:
Error: Attempt to take the car of E which is not listp
The easiest option would be to just REVERSE the current list, and use MAPCAR to reverse all sublist with the same function.
(defun tree-reverse (tree)
"Deep reverse TREE if it's a list. If it's an atom, return as is."
(if (listp tree)
(mapcar #'tree-reverse
(reverse tree))
tree))
(tree-reverse '(a (b c d) e)) ;=> (E (D C B) A)
In your function, you assume that if the l input variable is not nil, then it is necessarily a cons-cell, because you unconditionally takes (car l) inside the (list ...) function. That's why you have an error. There are many other things that are not nil which could be bound to l at this point, like numbers or symbols.
By the way, (list ...) just builds a list, you would need to use listp instead. Since you ruled out the nil case and a list is defined as either nil or a cons, you could have used also consp.

How to write a function that calls a function with its arguments?

I'm trying to write functions that wrap another function but I'm not sure how to pass parameters correctly while maintaining a sensible lambda-list.
E.g. if I have a function
(defun f (x &key y z) ...)
I want to write something like
(defun g (x &key y z)
(h (f x :y y :z z)))
This isn't satisfactory because I want to call f from g with the exact arguments g was called with, which doesn't happen (e.g. I don't want to supply keyword arguments to f that weren't supplied to g by the caller).
I initially wrote something like:
(defun g (&rest f-args)
(apply #'f f-args))
And that's the effect I want, however the lambda list for g is now very cryptic and I keep having to navigate to f to see what the arguments should be.
I did come up with a solution (and it's mostly satisfactory so I posted it as an answer), but I need to be explicit with every single key argument, and with large lambda-lists (e.g. if I want to wrap drakma:http-request), it will be a pain. I hope that maybe there's a better way.
You could write a macro that defines a function by copying the lambda list from another function. The problem is that there isn't a standard way to get the lambda list, but for SBCL you can use SB-INTROSPECT:FUNCTION-LAMBDA-LIST (although that won't work with (declaim (optimize (debug 0)))). You could try reading Swank source code to see how it gets the lambda lists for various implementations.
(defmacro define-wrapper (name lambda-source &body body)
`(defun ,name ,(sb-introspect:function-lambda-list lambda-source)
,#body))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 (f x :y y :z z)))
(f 2) ;=> 9
(g 2) ;=> 18
That's a bit ugly since the code doesn't show the variable definitions. A bit more complex solution might be to do something like
;; Requires Alexandria.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
`(defun ,name ,lambda-list
,#(sublis `((_ . (,lambda-source ,#(loop for r in required collect r)
,#(loop for (name init suppliedp)
in optional collect name)
,#(loop for ((k-name name) init suppliedp)
in keywords
append (list k-name name)))))
body)))))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 _))
Where the _ in the wrapper is replaced with a call to the function F with the given arguments. You do still have to remember that the argument variables exist and can conflict with ones you define yourself.
That passes all arguments to the function regardless of whether they were given. That might mess up a function that behaves differently depending on whether an argument was supplied or not. You could avoid that by using APPLY, but it's a bit more complex.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(alexandria:with-gensyms (deparsed-arglist-sym
key-sym val-sym suppliedp-sym)
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
(multiple-value-bind (body declarations docstring)
(alexandria:parse-body body :documentation t)
`(defun ,name ,lambda-list
,#(when docstring (list docstring))
,#declarations
(let ((,deparsed-arglist-sym
(nconc (loop for ,val-sym in (list ,#required) collect ,val-sym)
(loop for (,val-sym . ,suppliedp-sym)
in (list ,#(loop for (name init suppliedp)
in optional
collect (list 'cons name
(or suppliedp t))))
when ,suppliedp-sym collect ,val-sym)
(loop for (,key-sym ,val-sym ,suppliedp-sym)
in (list ,#(loop for ((kname name) init suppliedp)
in keywords
collect (list 'list kname name
(or suppliedp t))))
when ,suppliedp-sym append (list ,key-sym ,val-sym)))))
,#(sublis `((_ . (apply #',lambda-source ,deparsed-arglist-sym)))
body))))))))
(define-wrapper bar drakma:http-request
"Return the length of a response to http-request."
;; HTTP-REQUEST has some &aux variables.
(declare (ignore drakma::unparsed-uri
drakma::args))
(length _))
(bar "http://www.google.com") ;=> 11400 (14 bits, #x2C88)
I came up with this:
(defun g (x &rest f-keys &key y z)
(declare (ignorable y z))
(apply #'f x f-keys))
It's great for small lambda-lists but I hope I could do better.
I also can't see default values unless I type them explicitly.

passing function as a parameter to another function in scheme

Basicly,what I want to do is this:
I have a function square(x) (define (square x) (* x x))(f(x)=x*x),and another function mul_two (define (mul_two x) (* 2 x))(g(x)=2*x), I want to construct a new function based on the above two functions, what the new function does is this: 2*(x*x)(p(x)=g(f(x))), how can I write this new function in scheme? Although its a pretty straight thing in mathmatical form I'm totally stuck on this .
The usual way to do what you're asking is by using compose, which according to the linked documentation:
Returns a procedure that composes the given functions, applying the last proc first and the first proc last.
Notice that compose is quite powerful, it allows us to pass an arbitrary number of functions that consume and produce any number of values. But your example is simple to implement:
(define (square x) ; f(x)
(* x x))
(define (mul_two x) ; g(x)
(* 2 x))
(define p ; g(f(x))
(compose mul_two square))
(p 3) ; same as (mul_two (square 3))
=> 18
If for some reason your Scheme interpreter doesn't come with a built-in compose, it's easy to code one - and if I understood correctly the comments to the other answer, you want to use currying. Let's write one for the simple case where only a single value is produced/consumed by each function, and only two functions are composed:
(define my-compose ; curried and simplified version of `compose`
(lambda (g)
(lambda (f)
(lambda (x)
(g (f x))))))
(define p ; g(f(x))
((my-compose mul_two) square))
(p 3) ; same as (mul_two (square 3))
=> 18
(define (new_fun x) (mul_two (square x)))
EDIT:
(define (square x) (* x x))
(define (mul_two x) (* 2 x))
(define (new_fun fun1 fun2) (lambda (x) (fun2 (fun1 x))))
((new_fun square mul_two) 10)
And you will get 200. (10 * 10 * 2)
Also, you can implement a general purpose my-compose function just as the compose in racket:
(define (my-compose . funcs)
(let compose2
((func-list (cdr funcs))
(func (lambda args (apply (car funcs) args))))
(if (null? func-list)
func
(compose2
(cdr func-list)
(lambda args (func (apply (car func-list) args)))))))
And you can obtain new-fun by:
(define new-fun (my-compose mul_two square))
In #!racket (the language) you have compose such that:
(define double-square (compose double square))
Which is the same as doing this:
(define (double-square . args)
(double (apply square args)))
If you want to use Scheme (the standard) you can roll your own:
#!r6rs
(import (rnrs))
(define (compose . funs)
(let* ((funs-rev (reverse funs))
(first-fun (car funs-rev))
(chain (cdr funs-rev)))
(lambda args
(fold-left (lambda (arg fun)
(fun arg))
(apply first-fun args)
chain))))
(define add-square (compose (lambda (x) (* x x)) +))
(add-square 2 3 4) ; ==> 81

Resources