I have a condition statement such as:
(cond
[ (and (null? E1) (not (null? E2))) #f]
[ (and (not (null? E1)) (null? E2)) #f]
[ (or (= (length E1) 1) (= (length E2) 1))
(cond
[ (equal? E1 E2) #t]
[ (equal? (reverse E1) E2) #t]
[ else #f break]
)]
[ .... conditions continue
Is there a way of exiting out of the cond statement, after either the #f or #t is reached, and not continuing to the bottom, checking all the rest of the conditions? Just like in python, there is 'break' to get out of loops.
Hmm... If I understand you correctly, then the behavior you want is the behavior that's built in. Here's an example:
#lang racket
(define (my-fun E1 E2)
(cond
[(and (null? E1) (not (null? E2))) #f]
[(and (not (null? E1)) (null? E2)) #f]
[(or (= (length E1) 1) (= (length E2) 1))
(cond
[(equal? E1 E2) #t]
[(equal? (reverse E1) E2) #t]
[else #f])] ;; <-- the break was here.
[(dont-run-this-check) #t]
[(dont-run-this-check-either) #f]
[(really-really-dont-run-this-check) #t]))
(my-fun '(a b c) '(d))
(define (dont-run-this-check) (error))
(define (dont-run-this-check-either) (error))
(define (really-really-dont-run-this-check) (error))
This evaluates to #f
In this example, the code "breaks" on the line labeled "the break was here", and never evaluates any of the following tests (if it did, you'd see an error). That's because once the outer 'cond' has chosen a clause, none of the rest of them will be evaluated.
Is that what you're looking for?
In a cond
(cond
(predicate1 consequent1)
(predicate2 consequent2)
(else alternative))
It is the same as:
(if predicate1
consequent1
(if predicate2
consequent2
alternative))
Thus if predicate1 matches the expression consequent1 will be the evaluateion of the whole cond form.
If you nest cond the evaluation of the whole cond will be the evaluation of the inner when the predicate for the nested cond matches.
One other difference between if is that cond can have more than one consequent/alternative expression since it has explicit begin.. Thus you code where you have `
(cond ...
[else #f break])
Here if the other predicates don't match it will always match else. Then if will first evaluate #f (which is redundant since it doesn't do any side effects) before it evaluates break and it's value will be the result.
Related
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.
I have a recursive function in Scheme that returns when I return it:
lambda: expected only one expression for the function body, but found 3 extra parts
What I am trying to do is to call this function with value in the list 'lst'. This recursively gets all possible partitions in the list,
A define must be the first expression in a lambda. Thus your defien are ill placed.
In addition you cond ended after the first term such that the rest of the code would be executed unconditionally and the cond being dead code as it did not change the outcome.
The closest correct syntax with minimal changes would be:
(define glcm
(lambda (lst s1 s2)
(cond
[(null? lst) (lcm s1 s2)]
[else
(let ([a (glcm (cdr lst) (+ s1 (car lst)) s2)]
[b (glcm (cdr lst) s1 (+ s2 (car lst)))])
(if (< a b) a b))])))
Alternative, because let is a lambda call you can define inside a let:
(define glcm
(lambda (lst s1 s2)
(cond
[(null? lst) (lcm s1 s2)]
[else
(let ()
(define a (glcm (cdr lst) (+ s1 (car lst)) s2))
(define b (glcm (cdr lst) s1 (+ s2 (car lst))))
(if (< a b) a b))])))
However I would have done it like this:
(define (glcm lst s1 s2)
(if (null? lst)
(lcm s1 s2)
(min (glcm (cdr lst) (+ s1 (car lst)) s2)
(glcm (cdr lst) s1 (+ s2 (car lst))))))
They most likely become very similar object code. Use whatever you think is most readable for you.
Notice I use [...]. These are really indistinguishable with (...) so it's only a visual queue to make it more readable. Before R5RS you'd have to only use (...) to be compatible. DrRacket IDE even rewrites the ending parenthesis to match the type of the matching beginning parenthesis.
For a college project we're working on learning scheme however we've been thrown into a difficult assignment with little knowledge. We're given certain functions like "'let", "'cond", "and'" etc. and asked to add macros.
(define eval
(λ (e env)
(cond ((symbol? e) (lookup-var e env))
((not (list? e)) e) ; non-list non-symbol is self evaluatory
;; special forms go here:
((equal? (car e) 'λ) ; (λ VARS BODY)
(let ((vars (cadr e)) (body (caddr e)))
(list '%closure vars body env)))
((equal? (car e) 'if)
(eval_ (if (eval_ (cadr e) env) (caddr e) (cadddr e)) env))
((equal? (car e) 'quote) (cadr e))
;; Add More Macros Here:
;; ((equal? (car e) 'let) xxx)
;;((equal? (car e) 'cond) xxx)
;;((equal? (car e) 'and) xxx)
;((equal? (car e) 'or) xxx)
(else (let ((eeoe (map (λ (e0) (eval_ e0 env)) e)))
(apply_ (car eeoe) (cdr eeoe)))))))
So basically we're asked to fill in the blanks, where the ';;' comments are.
I tried doing the 'cond part and got this
((equal? (car e) 'cond)
(env (cdr e) env))
But I have no idea if it's correct (very little knowledge of scheme). Any help in figuring this out will be much appreciated. Thanks.
It's not really macros but special forms you are adding. If you know that let is just syntax sugar for anonymous function call. eg.
(let ((a expr1) (b expr2)) body ...)
is supported in you evaluator already if you change and evaluate:
((lambda (a b) body ...) expr1 expr2)
To get you going let works like this:
(let ((bindings (cadr e))
(body (cddr e)))
(eval_ `((lambda ,(map car bindings) ,#body) ,#(map cadr bindings))))
Now real macros you would introduce a new type of %closure so that whenever you find it as operator you bind the symbols not their evaluation, run the evaluator on it as if it was a function, then do _eval on the result. Then instead of implementing cond and let you could just add a function on how to rewrite it down to something you already support. Thus you could make let like this:
((lambda (let)
(let ((a expr1) (b expr2))
(cons a b)))
(~ (bindings . body) `((lambda ,(map car bindings) ,#body) ,#(map cadr bindings))))
It assumes you have quasiquote and map, but it could easily be implemented without these with more verbose code. ~ is just chosen randomly to be the macro version of λ. When evaluated it makes perhaps a %mclosure structure and you need to handle it specially to not evaluate its arguments, but evalaute the result. From that on you could support the special forms by having predefined %mclosure in the boot environment.
So for a college assignment we've been asked to work with macros and I'm finding it hard to understand how to implement code in scheme (we went from reversing a string to building an interpreter in one lecture).
(define macro-alist
`((and ,(λ (e)
(let ((forms (cdr e)))
(cond ((null? forms) '#t)
((null? (cdr forms)) (car forms))
(else `(if ,(car forms) (and ,#(cdr forms)) #f))))))
;(or ,error)
;(let ,error)
;(cond ,error)
(if ,(λ (e) (let ((guard (cadr e))
(then-part (caddr e))
(else-part (cadddr e)))
`((%if ,guard (λ () ,then-part) (λ () ,else-part))))))
))
We were asked to 'fill in the error holds in macro-alist' for the weekend and I'm finding it difficult.
I found some resources and combining them with my own brief knowledge I have :
`((or ,(lambda (e)
(and (list-strictly-longer-than? e 0)
(equal? (list-ref e 0) 'or)
(letrec ([visit (lambda (i)
(if(null? i)
#t
(and (is-exression? (car i))
(visit (cdr i)))))])
(visit (cdr e)))))))
`((let ,(lambda (e)
(and (proper-list-of-given-length? e 3)
(equal? (car e) 'let)
(list? (cadr e))
(is-expression? (list-ref e 2))
(lectrec ([visit (trace-lambda visit (i a)
(if(null? i)
#t
(and (proper-list-of-given-length? (car i) 2)
(is-identifier? (caar i))
(is-expression? (cadar i))
(not (member (caar i) a))
(visit (cdr i) (cons (caar i) a)))))])
(visit (cadr e) '()))))))
`((cond ,(lambda (e)
(and (list-strictly-longer-than? e 1)
(equal? (car v) 'cond)
(lectrec ([visit (lambda (i)
(if (null? (cdr i))
(is-else-clause? (car i))
(if (pair? (cdr i))
(and (cond? (car i))
(visit (cdr i))))))])
(visit (cdr e)))))))
For or, let and cond. I'm wondering if these are correct or if I'm close. I don't understand much about macros or scheme in general so some information/help on what to do would be appreciated.
If you look at the implementation of and:
(define expand-and
(λ (e)
(let ((forms (cdr e)))
(cond ((null? forms) '#t)
((null? (cdr forms)) (car forms))
(else `(if ,(car forms) (and ,#(cdr forms)) #f))))))
(expand-and '(and)) ; ==> #t
(expand-and '(and a)) ; ==> a
(expand-and '(and a b)) ; ==> (if a (and b) #f)
I notice two things. It doesn't really double check that the first element is and or if it's a list. Perhaps the interpreter doesn't use this unless it has checked this already?
Secondly it doesn't seem like you need to expand everything. As you see you might end up with some code + and with fewer arguments. No need for recursion since the evaluator will do that for you.
I think you are overthinking it. For or it should be very similar:
(expand-or '(or)) ; ==> #f
(expand-and '(or a b c)) ; ==> (let ((unique-var a)) (if unique-var unique-var (or b c)))
The let binding prevents double evaluation of a but if you have no side effects you might just rewrite it to (if a a (or b)). As with and or might expand to use or with fewer arguments than the original. This trick you can do with cond as well:
(cond (a b c)
...) ; ==>
(if a
(begin b c)
(cond ...))
let does not need this since it's perhaps the simplest one if you grasp map:
(let ((a x) (c y))
body ...) ; ==>
((lambda (a c) body ...) x y)
The report has examples of how the macros for these are made, but they might not be the simplest to rewrite to functions that takes code as structure like your interpeter. However using the report to understand the forms would perhaps worked just as well as posting a question here on SO.
I have found the code from this lesson online (http://groups.csail.mit.edu/mac/ftpdir/6.001-fall91/ps4/matcher-from-lecture.scm), and I am having a heck of a time trying to debug it. The code looks pretty comparable to what Sussman has written:
;;; Scheme code from the Pattern Matcher lecture
;; Pattern Matching and Simplification
(define (match pattern expression dictionary)
(cond ((eq? dictionary 'failed) 'failed)
((atom? pattern)
(if (atom? expression)
(if (eq? pattern expression)
dictionary
'failed)
'failed))
((arbitrary-constant? pattern)
(if (constant? expression)
(extend-dictionary pattern expression dictionary)
'failed))
((arbitrary-variable? pattern)
(if (variable? expression)
(extend-dictionary pattern expression dictionary)
'failed))
((arbitrary-expression? pattern)
(extend-dictionary pattern expression dictionary))
((atom? expression) 'failed)
(else
(match (cdr pattern)
(cdr expression)
(match (car pattern)
(car expression)
dictionary)))))
(define (instantiate skeleton dictionary)
(cond ((atom? skeleton) skeleton)
((skeleton-evaluation? skeleton)
(evaluate (evaluation-expression skeleton)
dictionary))
(else (cons (instantiate (car skeleton) dictionary)
(instantiate (cdr skeleton) dictionary)))))
(define (simplifier the-rules)
(define (simplify-exp exp)
(try-rules (if (compound? exp)
(simplify-parts exp)
exp)))
(define (simplify-parts exp)
(if (null? exp)
'()
(cons (simplify-exp (car exp))
(simplify-parts (cdr exp)))))
(define (try-rules exp)
(define (scan rules)
(if (null? rules)
exp
(let ((dictionary (match (pattern (car rules))
exp
(make-empty-dictionary))))
(if (eq? dictionary 'failed)
(scan (cdr rules))
(simplify-exp (instantiate (skeleton (car rules))
dictionary))))))
(scan the-rules))
simplify-exp)
;; Dictionaries
(define (make-empty-dictionary) '())
(define (extend-dictionary pat dat dictionary)
(let ((vname (variable-name pat)))
(let ((v (assq vname dictionary)))
(cond ((null? v)
(cons (list vname dat) dictionary))
((eq? (cadr v) dat) dictionary)
(else 'failed)))))
(define (lookup var dictionary)
(let ((v (assq var dictionary)))
(if (null? v)
var
(cadr v))))
;; Expressions
(define (compound? exp) (pair? exp))
(define (constant? exp) (number? exp))
(define (variable? exp) (atom? exp))
;; Rules
(define (pattern rule) (car rule))
(define (skeleton rule) (cadr rule))
;; Patterns
(define (arbitrary-constant? pattern)
(if (pair? pattern) (eq? (car pattern) '?c) false))
(define (arbitrary-expression? pattern)
(if (pair? pattern) (eq? (car pattern) '? ) false))
(define (arbitrary-variable? pattern)
(if (pair? pattern) (eq? (car pattern) '?v) false))
(define (variable-name pattern) (cadr pattern))
;; Skeletons & Evaluations
(define (skeleton-evaluation? skeleton)
(if (pair? skeleton) (eq? (car skeleton) ':) false))
(define (evaluation-expression evaluation) (cadr evaluation))
;; Evaluate (dangerous magic)
(define (evaluate form dictionary)
(if (atom? form)
(lookup form dictionary)
(apply (eval (lookup (car form) dictionary)
user-initial-environment)
(mapcar (lambda (v) (lookup v dictionary))
(cdr form)))))
;;
;; A couple sample rule databases...
;;
;; Algebraic simplification
(define algebra-rules
'(
( ((? op) (?c c1) (?c c2)) (: (op c1 c2)) )
( ((? op) (? e ) (?c c )) ((: op) (: c) (: e)) )
( (+ 0 (? e)) (: e) )
( (* 1 (? e)) (: e) )
( (* 0 (? e)) 0 )
( (* (?c c1) (* (?c c2) (? e ))) (* (: (* c1 c2)) (: e)) )
( (* (? e1) (* (?c c ) (? e2))) (* (: c ) (* (: e1) (: e2))) )
( (* (* (? e1) (? e2)) (? e3)) (* (: e1) (* (: e2) (: e3))) )
( (+ (?c c1) (+ (?c c2) (? e ))) (+ (: (+ c1 c2)) (: e)) )
( (+ (? e1) (+ (?c c ) (? e2))) (+ (: c ) (+ (: e1) (: e2))) )
( (+ (+ (? e1) (? e2)) (? e3)) (+ (: e1) (+ (: e2) (: e3))) )
( (+ (* (?c c1) (? e)) (* (?c c2) (? e))) (* (: (+ c1 c2)) (: e)) )
( (* (? e1) (+ (? e2) (? e3))) (+ (* (: e1) (: e2))
(* (: e1) (: e3))) )
))
(define algsimp (simplifier algebra-rules))
;; Symbolic Differentiation
(define deriv-rules
'(
( (dd (?c c) (? v)) 0 )
( (dd (?v v) (? v)) 1 )
( (dd (?v u) (? v)) 0 )
( (dd (+ (? x1) (? x2)) (? v)) (+ (dd (: x1) (: v))
(dd (: x2) (: v))) )
( (dd (* (? x1) (? x2)) (? v)) (+ (* (: x1) (dd (: x2) (: v)))
(* (dd (: x1) (: v)) (: x2))) )
( (dd (** (? x) (?c n)) (? v)) (* (* (: n) (+ (: x) (: (- n 1))))
(dd (: x) (: v))) )
))
(define dsimp (simplifier deriv-rules))
(define scheme-rules
'(( (square (?c n)) (: (* n n)) )
( (fact 0) 1 )
( (fact (?c n)) (* (: n) (fact (: (- n 1)))) )
( (fib 0) 0 )
( (fib 1) 1 )
( (fib (?c n)) (+ (fib (: (- n 1)))
(fib (: (- n 2)))) )
( ((? op) (?c e1) (?c e2)) (: (op e1 e2)) ) ))
(define scheme-evaluator (simplifier scheme-rules))
I'm running it in DrRacket with the R5RS, and the first problem I ran into was that atom? was an undefined identifier. So, I found that I could add the following:
(define (atom? x) ; atom? is not in a pair or null (empty)
(and (not (pair? x))
(not (null? x))))
I then tried to figure out how to actually run this beast, so I watched the video again and saw him use the following:
(dsimp '(dd (+ x y) x))
As stated by Sussman, I should get back (+ 1 0). Instead, using R5RS I seem to be breaking in the extend-dictionary procedure at the line:
((eq? (cadr v) dat) dictionary)
The specific error it's returning is: mcdr: expects argument of type mutable-pair; given #f
When using neil/sicp I'm breaking in the evaluate procedure at the line:
(apply (eval (lookup (car form) dictionary)
user-initial-environment)
The specific error it's returning is: unbound identifier in module in: user-initial-environment
So, with all of that being said, I'd appreciate some help, or the a good nudge in the right direction. Thanks!
Your code is from 1991. Since R5RS came out in 1998, the code must be written for R4RS (or older).
One of the differences between R4RS and later Schemes is that the empty list was interpreted as false in the R4RS and as true in R5RS.
Example:
(if '() 1 2)
gives 1 in R5RS but 2 in R4RS.
Procedures such as assq could therefore return '() instead of false.
This is why you need to change the definition of extend-directory to:
(define (extend-dictionary pat dat dictionary)
(let ((vname (variable-name pat)))
(let ((v (assq vname dictionary)))
(cond ((not v)
(cons (list vname dat) dictionary))
((eq? (cadr v) dat) dictionary)
(else 'failed)))))
Also back in those days map was called mapcar. Simply replace mapcar with map.
The error you saw in DrRacket was:
mcdr: expects argument of type <mutable-pair>; given '()
This means that cdr got an empty list. Since an empty list has
no cdr this gives an error message. Now DrRacket writes mcdr
instead of cdr, but ignore that for now.
Best advice: Go through one function at a time and test it with
a few expressions in the REPL. This is easier than figuring
everything out at once.
Finally begin your program with:
(define user-initial-environment (scheme-report-environment 5))
Another change from R4RS (or MIT Scheme in 1991?).
Addendum:
This code http://pages.cs.brandeis.edu/~mairson/Courses/cs21b/sym-diff.scm almost runs.
Prefix it in DrRacket with:
#lang r5rs
(define false #f)
(define user-initial-environment (scheme-report-environment 5))
(define mapcar map)
And in extend-directory change the (null? v) to (not v).
That at least works for simple expressions.
Here is the code that works for me with mit-scheme (Release 9.1.1).
You also may use this code. It runs on Racket.
For running "eval" without errors, the following needed to be added
(define ns (make-base-namespace))
(apply (eval '+ ns) '(1 2 3))