Can set-car! and set-cdr! be implemented as macros? - lisp

Is it possible to implement set-car! and set-cdr! portably as macros using set! in Scheme? Or would this require special access to the underlying storage system?
I'm asking because I'm implementing my own Scheme interpreter, and I'd like to have as much as possible out in scheme code.
My first attempt on set-cdr! was:
(define-syntax set-cdr!
(syntax-rules ()
((set-cdr! location value)
(set! location (cons (car location) value)))))
This mostly works, but not for circular lists:
#; mickey> (define x (list 1 2))
#; mickey> x
(1 2)
#; mickey> (set-cdr! x x)
#; mickey> x
(1 1 2)
Wrapping the macro body in let did not help me either, because when I do (set! (cons (car location) value), then value has already been evaluated to be '(1 2).

In
(set! location (cons (car location) value))
the expression (cons (car location) value) allocates a new pair.
The purpose of set-cdr! is to mutate an existing pair.
So implementing set-cdr! does require "special" access to the underlying storage.

Here is an example of implementing Cons, Car, Cdr, Set-car! and Set-cdr! using closures.
(define (Cons x y)
(lambda (message . val)
(cond
[(eq? message 'car) x]
[(eq? message 'cdr) y]
[(eq? message 'set-car!)
(set! x (car val))]
[(eq? message 'set-cdr!)
(set! y (car val))]
[else 'unknown-message])))
(define (Car pair)
(pair 'car))
(define (Cdr pair)
(pair 'cdr))
(define (Set-cdr! pair val)
(pair 'set-cdr! val))
(define (Set-car! pair val)
(pair 'set-car! val))
(define p (Cons 1 2))
(Car p)
(Cdr p)
(Set-car! p 3)
(Car p)
(Set-cdr! p 4)
(Cdr p)

Basically you can implement set! without set!, but I don't think you can implement set-car!/set-cdr! without either mutating pairs or simulating pairs (like soegaard's example)
Since it seems you're making your Scheme implementation in Scheme I would have used set-car!/set-cdr! to implement it in the interpreter or just not implemented them at all. I would have started with define, if, quote, pair?, eq?, cons, car and cdr (similar to The roots of LISP, but more schemish) to have a base minimum implementation to start with and then enhanced it further.
Anyway.. Your implementation, if you do implement it should be able to do this:
(define odds (list 1 3 5 7 9 11))
(set-car! (cddr odds) #f)
odds
===> (1 3 #f 7 9 11)

Related

Custom pattern-matching facility for Chez Scheme

I am trying to make my own pattern-matching system in Scheme. To begin I am making a parser for s-expressions that divides them into tokens like this:
'(1 2 b (3 4)) => '(number number symbol (number number))
It should be noted that I have not used define-syntax before in Scheme so that may be where I am messing up. Chez Scheme throws me this error:
Exception: invalid syntax classify at line 21, char 4 of pmatch.scm. Note that the line numbers won't correspond exactly to the snippet here. Does anyone know what I am doing wrong?
(define-syntax classify
(syntax-rules ()
((_ checker replacement)
((checker (car sexpr)) (cons replacement (classify-sexpr (cdr sexpr)))))))
(define (classify-sexpr sexpr)
(cond
((null? sexpr) sexpr)
(classify list? (classify-sexpr (car sexpr)))
(classify number? 'number)
(classify symbol? 'symbol)
(else
(cons 'symbol (classify-sexpr (cdr sexpr))))))
(display (classify-sexpr '(1 (b 3) (4 5) 6)))
Your code is hugely confused. In fact it's so confused I'm not sure what you're trying to do completely: I've based my answer on what you say the classifier should produce at the start of your question.
First of all your macro refers to sexpr which has no meaning in the macro, and because Scheme macros are hygienic it will definitely not refer to the sexpr which is the argument to classify-sexpr.
Secondly you don't need a macro at all here. I suspect that you may be thinking that because you are trying to write a macro you must use macros in its construction: that's not necessarily true and often a bad idea.
Thirdly the syntax of your cond is botched beyond repair: I can't work out what it's trying to do.
Finally the list classification will never be needed: if you want to classify (1 2 3 (x)) as (number number number (symbol)) then you'll simply never reach a case where you have a list which you want to classify since you must walk into it to classify its elements.
Instead just write the obvious functions do do what you want:
(define classification-rules
;; an alist of predicate / replacement which drives classigy
`((,number? number)
(,symbol? symbol)))
(define (classify thing)
;; classify thing using classification-rules
(let loop ([tail classification-rules])
(cond [(null? tail)
'something]
[((first (first tail)) thing)
(second (first tail))]
[else
(loop (rest tail))])))
(define (classify-sexpr sexpr)
;; classify a sexpr using classify.
(cond
[(null? sexpr) '()]
[(cons? sexpr) (cons (classify-sexpr (car sexpr))
(classify-sexpr (cdr sexpr)))]
[else (classify sexpr)]))
And now
> (classify-sexpr '(1 2 3 (x 2) y))
'(number number number (symbol number) symbol)
It may be that what you really want is something which classifies (1 2 (x 2)) as (list number number (list symbol number)) say. You can do this fairly easily:
(define atomic-classification-rules
;; an alist of predicate / replacements for non-conses
`((,number? number)
(,symbol? symbol)))
(define (classify-sexpr sexpr)
(cond
[(null? sexpr) '()]
[(list? sexpr)
`(list ,#(map classify-sexpr sexpr))]
[(cons? sexpr)
`(cons ,(classify-sexpr (car sexpr))
,(classify-sexpr (cdr sexpr)))]
[else
(let caloop ([rtail atomic-classification-rules])
(cond [(null? rtail)
'unknown]
[((first (first rtail)) sexpr)
(second (first rtail))]
[else
(caloop (rest rtail))]))]))
And now
> (classify-sexpr '(1 2 3 (x 2) y))
'(list number number number (list symbol number) symbol)
> (classify-sexpr '(1 2 3 (x 2) . y))
'(cons number (cons number (cons number (cons (list symbol number) symbol))))

Simplify symbolic expressions

I am new in Lisp and i need some help.
I need to simplify next expressions:
from (+ (+ A B) C) to (+ A B C)
and from (- (- A B) C) to (- A B C).
If you could help me with one of them I'll understand how i need to do this to the next one.
Thanks a lot.
Assuming you have an input that matches this pattern, (+ e1 ... en), you want to recursively simplify all e1 to en, which gives you s1, ..., sn, and then extract all the si that start with a + to move their arguments one level up, to the simplified expression you are building.
An expression e matches the above pattern if (and (consp e) (eq '+ (car e))).
Then, all the ei are just given by the list that is (cdr e).
Consider the (+) case, how could you simplify it?
To apply a function f to a list of values, call (mapcar #'f list).
To split a list into two lists, based on a predicate p, you might use a loop:
(let ((sat nil) (unsat nil))
(dolist (x list (values sat unsat))
(if (funcall predicate x)
(push x sat)
(push x unsat))))
There is a purely functional way to write this, can you figure it out?
Here is a trivial simplifier written in Racket, with an implementation of a rather mindless simplifier for +. Note that this is not intended as anything serious: it's just what I typed in when I was thinking about this question.
This uses Racket's pattern matching, probably in a naïve way, to do some of the work.
(define/match (simplify expression)
;; simplifier driver
(((cons op args))
;; An operator with some arguments
;; Note that this assumes that the arguments to operators are always
;; expressions to simplify, so the recursive level can be here
(simplify-op op (map simplify args)))
((expr)
;; anything else
expr))
(define op-table (make-hash))
(define-syntax-rule (define-op-simplifier (op args) form ...)
;; Define a simplifier for op with arguments args
(hash-set! op-table 'op (λ (args) form ...)))
(define (simplify-op op args)
;; Note the slightly arcane fallback: you need to wrap it in a thunk
;; so hash-ref does not try to call it.
((hash-ref op-table op (thunk (λ (args) (cons op args)))) args))
(define-op-simplifier (+ exprs)
;; Simplify (+ ...) by flattening + in its arguments
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
`(+ ,#(reverse results))
(loop (rest ftail)
(match (first ftail)
[(cons '+ addends)
(append (reverse addends) results)]
[expr (cons expr results)])))))
It is possible to be more aggressive than this. For instance we can coalesce runs of literal numbers, so we can simplify (+ 1 2 3 a 4) to
(+ 6 a 4) (note it is not safe in general to further simplify this to (+ 10 a) unless all arithmetic is exact). Here is a function which does this coalescing for for + and *:
(define (coalesce-literal-numbers f elts)
;; coalesce runs of literal numbers for an operator f.
;; This relies on the fact that (f) returns a good identity for f
;; (so in particular it returns an exact number). Thisis true for Racket
;; and CL and I think any Lisp worth its salt.
;;
;; Note that it's important here that (eqv? 1 1.0) is false.
;;;
(define id (f))
(let loop ([tail elts]
[accum id]
[results '()])
(cond [(null? tail)
(if (not (eqv? accum id))
(reverse (cons accum results))
(reverse results))]
[(number? (first tail))
(loop (rest tail)
(f accum (first tail))
results)]
[(eqv? accum id)
(loop (rest tail)
accum
(cons (first tail) results))]
[else
(loop (rest tail)
id
(list* (first tail) accum results))])))
And here is a modified simplifier for + which uses this. As well as coalescing it notices that (+ x) can be simplified to x.
(define-op-simplifier (+ exprs)
;; Simplify (+ ...) by flattening + in its arguments
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
(let ([coalesced (coalesce-literal-numbers + (reverse results))])
(match coalesced
[(list something)
something]
[exprs
`(+ ,#exprs)]))
(loop (rest ftail)
(match (first ftail)
[(cons '+ addends)
(append (reverse addends) results)]
[expr (cons expr results)])))))
Here is an example of using this enhanced simplifier:
> (simplify 'a)
'a
> (simplify 1)
1
> (simplify '(+ 1 a))
'(+ 1 a)
> (simplify '(+ a (+ b c)))
'(+ a b c)
> (simplify '(+ 1 (+ 3 c) 4))
'(+ 4 c 4)
> (simplify '(+ 1 2 3))
6
For yet more value you can notice that the simplifier for * is really the same, and change things to this:
(define (simplify-arith-op op fn exprs)
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
(let ([coalesced (coalesce-literal-numbers fn (reverse results))])
(match coalesced
[(list something)
something]
['()
(fn)]
[exprs
`(,op ,#exprs)]))
(loop (rest ftail)
(match (first ftail)
[(cons the-op addends)
#:when (eqv? the-op op)
(append (reverse addends) results)]
[expr (cons expr results)])))))
(define-op-simplifier (+ exprs)
(simplify-arith-op '+ + exprs))
(define-op-simplifier (* exprs)
(simplify-arith-op '* * exprs))
And now
(simplify '(+ a (* 1 2 (+ 4 5)) (* 3 4) 6 (* b)))
'(+ a 36 b)
Which is reasonably neat.
You can go further than this, For instance when coalescing numbers for an operator you can simply elide sequences of the identity for that operator: (* 1 1 a 1 1 b) can be simplified to (* a b), not (* 1 a 1 b). It may seem silly to do that: who would ever write such an expression, but they can quite easily occur when simplifying complicated expressions.
There is a gist of an elaborated version of this code. It may still be buggy.

Not numeric atoms LISP

I want to ask why this function doesn't work...
(defun nenum(ls)
(cond
((null ls) nil)
((listp car(ls)) (nenum (rest ls)))
((numberp car(ls)) (nenum (rest ls)))
(t (cons (car ls) (nenum (rest ls))))))
Example: (nenum '(l 1 i (b) (5) s -2 p)) --> (l i s p)
Thank you!
Looking at the predicate you have in one of your cond terms:
(listp car (ls))
Thus apply the function listp with the two arguments car and the result of calling the function ls with no arguments. car and ls both need to be free variables and listp needs to be a different function than the one defined in CLHS since it only takes one argument.
Perhaps you have though you were writing Algol? An Algol function call look like operator(operand) but not CL. CL is a LISP dialect and we have this form on our function calls:
(operand operator)
If we nest we do the same:
(operand (operand operator))
You got it right in the alternative (cons (car ls) (nenum (rest ls)))
Replace car(ls) with (car ls).
Here's a much easier way to write that function:
(defun nenum (list)
(remove-if (lambda (item)
(or (listp item)
(numberp item)))
list))
Note that NIL doesn't need its own test because listp covers it.
There's no need to write a function like this from scratch. Common Lisp already provides remove-if, and you can give it a predicate that matches numbers and non-atoms:
CL-USER> (remove-if #'(lambda (x)
(or (numberp x)
(not (atom x))))
'(l 1 i (b) (5) s -2 p))
;=> (L I S P)
Or, to make it even clearer that you're keeping non-numeric atoms, you can use remove-if-not with a predicate that checks for numeric atoms:
CL-USER> (remove-if-not #'(lambda (x)
(and (atom x)
(not (numberp x))))
'(l 1 i (b) (5) s -2 p))
;=> (L I S P)
Note that the empty list, which is often written as (), is just the symbol nil. As such, it too is a non-numeric atom. If you'd want to keep other symbols, e.g.,
CL-USER> (remove-if-not #'(lambda (x)
(and (atom x)
(not (numberp x))))
'(li (b) -1 (5) sp))
;=> (LI SP)
then you'll probably want to keep nil as well:
CL-USER> (remove-if-not #'(lambda (x)
(and (atom x)
(not (numberp x))))
'(van (b) () (5) a))
;=> (VAN NIL A)

Converting an s expression to a list in Scheme [duplicate]

This question already has answers here:
Flatten a list using only the forms in "The Little Schemer"
(3 answers)
Closed 9 years ago.
If I have an s expression, for example '(1 2 (3) (4 (5)) 6 7), how would I convert that into a list like (1 2 3 4 5 6 7)? I basically need to extract all of the atoms from the s expression. Is there a built in function that would help me do it?
(define (convert-to-list s) ... )
My algorithm so far is, if the first element is an atom append it onto a list. If the first element is a list then get the car of that element and then call the function (convert-to-list) with that function so it catches the base case of the recursion. And append the cdr of that list being invoked on convert-to-list to car of it. I'm trying to teach myself scheme from Structure and Interpretation of Computer Programs and I'm just trying out random things. Doing this recursively is proving to be more difficult than I anticipated.
To literally answer your question, "Is there a built in function to help me do this?", in Racket yes there is. flatten does exactly this: "Flattens an arbitrary S-expression structure of pairs into a list."
Examples:
> (flatten '((a) b (c (d) . e) ()))
'(a b c d e)
> (flatten 'a)
'(a)
However it's a great exercise to think about how you would write flatten yourself.
Chris Jester-Young's comment has a link to an elegant way. If she'd posted that as an answer, instead of as a comment, I'd suggest marking her answer as accepted, not mine. :)
Your algorithm doesn't look bad, it's just missing a step or two.
(define (flatten lst) ; 'flatten' is a better name for this function IMO
(cond
((null lst) nil)
;; Don't worry that I'm calling (flatten (cdr lst)) without any checking;
;; the above case handles it
((atom (car lst)) ; The car's okay
(cons (car lst) (flatten (cdr lst))))
((cons? (car lst)) ; The car still needs flattening; note the use of
; 'append' here (the car-list may have any number of elements)
(append (flatten (car lst)) (flatten (cdr lst))))))
Between the (flatten (car lst)) calls dealing with the first element and the (flatten (cdr lst)) calls recursively dealing with the rest of the list, the input list ends up a flat list (i.e. no elements are conses).
(Warning: I'm not a Scheme guru; the above code may contain errors.)
Your cases should cover the empty list, an atom, (car s) being an atom, and (car s) being a list.
This works, though I bashed out a list append function because I didn't remember what the built-in one was. Works in Racket Advanced Student.
(define (list-glue left-list right-list)
(cond
((null? left-list) right-list)
(else (cons (car left-list) (list-glue (cdr left-list) (right-list))))))
(define (convert-to-list s)
(cond
((null? s) '())
((not (list? s)) (cons s (quote ())))
((not (list? (car s))) (cons (car s) (convert-to-list (cdr s))))
(else
(list-glue
(convert-to-list (car s))
(convert-to-list (cdr s))))))
Now, if you want a faster implementation, you don't need append at all.
The idea is to pass around what you would append onto as a parameter. I call this tail.
If you have an empty s-exp, you just return the tail, since there is nothing to add to it.
I've got the code, flat and flat2, where flat uses a match statement, things in racket, and flat2 just uses a cond, which I find a little harder to read, but I provide it in case you haven't seen match yet.
#lang racket
(define (flat s-exp tail)
(match s-exp
['() tail]
[(cons fst rst)
(let ([new-tail (flat rst tail)])
(flat fst new-tail))]
[atom
(cons atom tail)]))
(define (flat
(cond
[(empty? s-exp) tail]
[(list? s-exp)
(let* ([fst (first s-exp)]
[rst (rest s-exp)]
[new-tail (flat])
(flat fst new-tail))]
[#t
(cons s-exp tail)]))
To use them, call them like so (flat '(1 () (2 (3)) 4) '()) ===> '(1 2 3 4).
You need to supply the empty list for them to start off on.
This can be done simply by recursing on sublists and rest-lists. You can see how easily this code reads. Like such:
(define (convert-to-list list)
(if (null? list)
'()
(let ((next (car list))
(rest (cdr list)))
(if (list? next)
(append (convert-to-list next) (convert-to-list rest))
(cons next (convert-to-list rest))))))
> (convert-to-list '(a b c))
(a b c)
> (convert-to-list '((a b) (((c d) e f) g h) i j))
(a b c d e f g h i j)
>

How do I find the index of an element in a list in Racket?

This is trivial implement of course, but I feel there is certainly something built in to Racket that does this. Am I correct in that intuition, and if so, what is the function?
Strangely, there isn't a built-in procedure in Racket for finding the 0-based index of an element in a list (the opposite procedure does exist, it's called list-ref). However, it's not hard to implement efficiently:
(define (index-of lst ele)
(let loop ((lst lst)
(idx 0))
(cond ((empty? lst) #f)
((equal? (first lst) ele) idx)
(else (loop (rest lst) (add1 idx))))))
But there is a similar procedure in srfi/1, it's called list-index and you can get the desired effect by passing the right parameters:
(require srfi/1)
(list-index (curry equal? 3) '(1 2 3 4 5))
=> 2
(list-index (curry equal? 6) '(1 2 3 4 5))
=> #f
UPDATE
As of Racket 6.7, index-of is now part of the standard library. Enjoy!
Here's a very simple implementation:
(define (index-of l x)
(for/or ([y l] [i (in-naturals)] #:when (equal? x y)) i))
And yes, something like this should be added to the standard library, but it's just a little tricky to do so nobody got there yet.
Note, however, that it's a feature that is very rarely useful -- since lists are usually taken as a sequence that is deconstructed using only the first/rest idiom rather than directly accessing elements. More than that, if you have a use for it and you're a newbie, then my first guess will be that you're misusing lists. Given that, the addition of such a function is likely to trip such newbies by making it more accessible. (But it will still be added, eventually.)
One can also use a built-in function 'member' which gives a sublist starting with the required item or #f if item does not exist in the list. Following compares the lengths of original list and the sublist returned by member:
(define (indexof n l)
(define sl (member n l))
(if sl
(- (length l)
(length sl))
#f))
For many situations, one may want indexes of all occurrences of item in the list. One can get a list of all indexes as follows:
(define (indexes_of1 x l)
(let loop ((l l)
(ol '())
(idx 0))
(cond
[(empty? l) (reverse ol)]
[(equal? (first l) x)
(loop (rest l)
(cons idx ol)
(add1 idx))]
[else
(loop (rest l)
ol
(add1 idx))])))
For/list can also be used for this:
(define (indexes_of2 x l)
(for/list ((i l)
(n (in-naturals))
#:when (equal? i x))
n))
Testing:
(indexes_of1 'a '(a b c a d e a f g))
(indexes_of2 'a '(a b c a d e a f g))
Output:
'(0 3 6)
'(0 3 6)