As a follow up to my previous question, I am trying to implement a simple pattern matching in Clojure.
I would like something like the following:
(match target
[ub] expr1 ; ub should be bound to actual value in expr1
['< ub] expr2 ; match the literal less-than symbol
; and ub should be bound to actual value in expr2
[lb ub] expr3 ; lb and ub should be bound to actual values in expr3
:else expr4 ; default case if none match
)
Usage:
(match [< 5.0] ...)
should arrange to execute expr2 at runtime.
I would like to write a macro, but I am not sure of the expansion.
I am considering having each case-and-clause expand to a let with bindings to internal variables and checks that the literal symbols ('<) actually matches the pattern. Maybe for the second pattern (['< ub]):
(let [[sym1 ub] pattern]
(if (= '< sym1)
expr1)
Do I need to use (gensym) for the bindings? How?
Bigger picture:
(range-case target
[0.0 < 1.0] :greatly-disagree
[< 2.0] :disagree
[< 3.0] :neutral
[< 4.0] :agree
[5.0] :strongly-agree
42 :the-answer
:else :do-not-care)
I am trying to match the [...] patterns and convert them to the following:
[ub] (if previous-ub `(and (<= ~previous-ub ~target) (<= ~target ~ub))
`(< ~target ~ub))
['< ub] (if previous-ub `(and (<= ~previous-ub ~target) (< ~target ~ub))
`(< ~target ~ub))
[lb ub] `(and (<= ~lb ~target) (<= ~target ~ub))
['< lb ub] `(and (< ~lb ~target) (<= ~target ~ub))
[lb '< ub] `(and (<= ~lb ~target) (< ~target ~ub))
['< lb '< ub] `(and (< ~lb ~target) (< ~target ~ub))
I have a cond that checks that the case part is a vector. This pattern match should occur inside that case.
My first idea was basically the same: Bind stuff to internal locals and test on their contents in a big and. For literals the value is bound to a generated local; symbols are used directly in the binding.
I also added a check that the spec vector matches the length of the target vector. Otherwise you can't have [ub] as well as [lb ub] since neither contains a check which could fail. So always the first would be selected.
Here is the code:
(defn make-clause
[expr-g [spec expr & more :as clause]]
(when (seq clause)
(let [tests-and-bindings (map (fn [x]
(if-not (symbol? x)
(let [x-g (gensym "x")]
[`(= ~x ~x-g) x-g])
[nil x]))
spec)
tests (keep first tests-and-bindings)
bindings (map second tests-and-bindings)]
`(let [[~#bindings] ~expr-g]
(if (and (= (count ~expr-g) ~(count spec)) ~#tests)
~expr
~(make-clause expr-g more))))))
(defmacro match
[expr & clauses]
(let [expr-g (gensym "expr")]
`(let ~[expr-g expr]
~(make-clause expr-g clauses))))
And an example expansion. I didn't use syntax-quote in the example to reduce the noise in the expansion, but you should get the idea.
(let [expr98 [(quote <) 3.0]]
(let [[ub] expr98]
(if (and (= (count expr98) 1))
(if previous-ub
(and (<= previous-ub target) (<= target ub))
(< target ub))
(let [[x99 ub] expr98]
(if (and (= (count expr98) 2) (= (quote <) x99))
(if previous-ub
(and (<= previous-ub target) (< target ub))
(< target ub))
(let [[lb ub] expr98]
(if (and (= (count expr98) 2))
(and (<= lb target) (<= target ub))
nil)))))))
The invokation was:
(match ['< 3.0]
[ub] (if previous-ub
(and (<= previous-ub target) (<= target ub))
(< target ub))
['< ub] (if previous-ub
(and (<= previous-ub target) (< target ub))
(< target ub))
[lb ub] (and (<= lb target) (<= target ub))))
Hope that helps you get started.
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.
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)
I am just trying to learn some Lisp, so I am going through project euler problems. I found problem no. 14 interesting (so if you are planning to solve this problems stop reading now, because I pasted my solution at the bottom). With my algorithm it was so slow, but after using memoization (I copied the function from Paul Graham's "on Lisp" book) it was much more faster (around 4 to 8 seconds).
My question is about this bunch of warnings that I got:
Am I doing something wrong? Can I improve my style?
> ;; Loading file
> /euler-lisp/euler-14.lisp
> ... WARNING in COLLATZ-SERIE :
> COLLATZ-SERIE-M is neither declared
> nor bound, it will be treated as if it
> were declared SPECIAL. WARNING in
> COLLATZ-SERIE : COLLATZ-SERIE-M is
> neither declared nor bound, it will be
> treated as if it were declared
> SPECIAL. WARNING in COMPILED-FORM-314
> : COLLATZ-SERIE-M is neither declared
> nor bound, it will be treated as if it
> were declared SPECIAL. (525 837799)
> Real time: 18.821894 sec. Run time:
> 18.029127 sec. Space: 219883968 Bytes GC: 35, GC time: 4.080254 sec. Las
> siguientes variables especiales no han
> sido definidas: COLLATZ-SERIE-M 0
> errores, 0 advertencias ;; Loaded file
This is the code:
(defun collatz (n)
(if (evenp n) (/ n 2) (+ (* 3 n) 1)))
(defun memoize (fn)
(let ((cache (make-hash-table :test #'equal)))
#'(lambda (&rest args)
(multiple-value-bind (val win) (gethash args cache)
(if win
val
(setf (gethash args cache)
(apply fn args)))))))
(defun collatz-serie (n)
(cond ((= n 1) (list 1))
((evenp n) (cons n (funcall collatz-serie-m (/ n 2))))
(t (cons n (funcall collatz-serie-m (+ (* 3 n) 1))))))
(defun collatz-serie-len (n)
(length (collatz-serie n)))
(setq collatz-serie-m (memoize #'collatz-serie))
(defun gen-series-pairs (n)
(loop for i from 1 to n collect
(list (collatz-serie-len i) i)))
(defun euler-14 (&key (n 1000000))
(car (sort (gen-series-pairs n) #'(lambda (x y) (> (car x) (car y))))))
(time (print (euler-14)))
Thanks a lot, and forgive the probable errors, I am just beginning with Lisp.
Br
UPDATE:
i want to share the final code that i wrote. using custom external hash table for memoization and improving the final loop.
(defvar *cache* (make-hash-table :test #'equal))
(defun collatz (n)
(if (evenp n) (/ n 2) (+ (* 3 n) 1)))
(defun collatz-serie (n)
(cond ((= n 1) (list 1))
((evenp n) (cons n (collatz-serie (/ n 2))))
(t (cons n (collatz-serie (+ (* 3 n) 1))))))
(defun collatz-serie-new (n)
(labels ((helper (n len)
(multiple-value-bind (val stored?) (gethash n *cache*)
(if stored?
val
(setf (gethash n *cache*) (cond ((= n 1) len)
((evenp n) (+ len (helper (/ n 2) len)))
(t (+ len (helper (+ (* 3 n) 1) len)))))))))
(helper n 1)))
;; learning how to loop
(defun euler-14 (&key (n 1000000))
(loop with max = 0 and pos = 0
for i from n downto 1
when (> (collatz-serie-new i) max)
do (setf max (collatz-serie-new i)) and do (setf pos i)
finally (return (list max pos))))
It is bad style to setq an unknown name. It is assumed that you mean to create a new global special variable, then set it, but this should be made explicit by introducing these bindings first. You do this at the top level by using defvar (or defparameter or defconstant) instead, and in lexical blocks by using let, do, multiple-value-bind or similar constructs.
I have problems with following code: http://lisper.ru/apps/format/96
The problem is in "normalize" function, which does not work.
It fails on the fifth line: (zero-p a indexes i)
(defun normalize (a &optional indexes i)
"Returns normalized A."
(progn
(format t "Data=~A ~A ~A" a indexes i)
(if (zero-p a indexes i)
a ;; cannot normalize empty vector
(let* ((mmm (format t "Zero?=~a" (zero-p a indexes i)))
(L (sqrt (+ (do-op-on * a :x a :x indexes i indexes i)
(do-op-on * a :y a :y indexes i indexes i)
(do-op-on * a :z a :z indexes i indexes i))))
(mmm (format t "L=~a" L))
(L (/ 1D0 L))
(mmm (format t "L=~a" L))) ; L=1/length(A)
(make-V3 (* (ref-of a :x indexes i) l)
(* (ref-of a :y indexes i) l)
(* (ref-of a :z indexes i) l))))))
in function "normalize" I call the macro "zero-p", which in turn calls macro "ref-of", which is the last in the chain.
(defmacro zero-p (v &optional indexes index)
"Checks if the vector is 'almost' zero length."
`(and (< (ref-of ,v :x ,indexes ,index) *min+*)
(< (ref-of ,v :y ,indexes ,index) *min+*)
(< (ref-of ,v :z ,indexes ,index) *min+*)
(> (ref-of ,v :x ,indexes ,index) *min-*)
(> (ref-of ,v :y ,indexes ,index) *min-*)
(> (ref-of ,v :z ,indexes ,index) *min-*)))
Here is ref-of:
(defmacro ref-of (values coordinate &optional indexes index)
"Please see DATA STRUCTURE for details."
(if indexes
(cond ((eq coordinate :x) `(aref ,values (aref ,indexes ,index)))
((eq coordinate :y) `(aref ,values (+ 1 (aref ,indexes ,index))))
((eq coordinate :z) `(aref ,values (+ 2 (aref ,indexes ,index))))
(T (error "The symbol ~S is not :X, :Y or :Z." coordinate)))
(cond ((eq coordinate :x) `(aref ,values 0))
((eq coordinate :y) `(aref ,values 1))
((eq coordinate :z) `(aref ,values 2))
(T (error "The symbol ~S is not :X, :Y or :Z." coordinate)))))
Also, in "normalize" I call the macro "do-op-on", which calls "ref-of" as well.
(defmacro do-op-on (op name1 coord1 name2 coord2 &optional is1 i1 is2 i2)
"Example: (do-op-on * A :x B :y i n) == A[i[n]].x*B.y"
`(,op (ref-of ,name1 ,coord1 ,is1 ,i1) (ref-of ,name2 ,coord2 ,is2 ,i2)))
As a result, instead of having this: (aref some-array 0) I have (aref NIL NIL) which is created in "ref-of".
I suppose that I lose the symbol A from the call (normalize A). I just feel that the symbol does not survive the macroexpanson. The thing is, macroexpansoin works in REPL for each macro independently.
Can anyone explain where is the mistake?
Note that the macros ZERO-P and REF-OF are expanded when you evaluate, compile or load the DEFUN for NORMALIZE. Their arguments are the symbols INDEXES and INDEX, and both of those are not NIL, so the IFs in the REF-OF forms will all take the first branch and expand into AREF forms where INDICES and INDEX can't be bound to NIL. In short, you've gotten evaluation time and macroexpansion time confused, which is an easy thing to do when you are just starting with macros.
However, when you call the function NORMALIZE with only one argument, the variables INDICES and INDEX are bound to a default value of NIL, so AREF complains that it's getting invalid arguments.
The best solution I can offer you is to just make ZERO-P and REF-OF into functions instead of macros. They'll work just fine as functions, and you shouldn't make something a macro unless you're sure it needs to be a macro. If you really do want to keep them as macros, give default values to INDICES and INDEX that make sense and get rid of the optional values in REF-OF and ZERO-P---I'm pretty sure having INDEX default to 0 and INDICES default to #(0 1 2) will work.
EDIT to add: Wanting to avoid function call overhead is almost certainly not a good reason to use macros in Lisp. In the first place, you shouldn't even worry about function call overhead until after you've done some profiling and testing. In the second place, if you do have a problem with function call overhead, you should DECLARE the functions in question INLINE instead of using macros to do the inlining.
EDITed again to add: If your functions are being expanded inline, your compiler should be able to figure out that it can replace
(cond ((eq :x :x) 'foo)
((eq :x :y) 'bar)
((eq :x :z) 'quux)
(t (error "~A is not one of :X, :Y or :Z" :x))
with
'foo
What is PRAGMA? It is not standard. Maybe you mean PROGN (which is not even necessary since DEFUN supplies an implicit PROGN)?
Why all the macros? Is there some reason to disallow a form like (reduce (lambda (r c) (* (ref-of A c) r)) (list :x :y :z) :initial-value 1)? This seems like a case of premature optimization.
Pillsy's answer is right on: when REF-OF is expanded (from the usage of ZERO-P), its INDEXES will have the symbol INDEXES as its value, not the value passed into NORMALIZE (like wise INDEX will be I).
Learning Common Lisp (using GNU CLISP 2.43) .. so might be a noob mistake. Example is the 'print prime numbers between x and y'
(defun is-prime (n)
(if (< n 2) (return-from is-prime NIL))
(do ((i 2 (1+ i)))
((= i n) T)
(if (= (mod n i) 0)
(return NIL))))
(defun next-prime-after (n)
(do ((i (1+ n) (1+ i)))
((is-prime i) i)))
(defmacro do-primes-v2 ((var start end) &body body)
`(do ((,var (if (is-prime ,start)
,start
(next-prime-after ,start))
(next-prime-after ,var)))
((> ,var ,end))
,#body))
(defmacro do-primes-v3 ((var start end) &body body)
(let ((loop-start (gensym))
(loop-end (gensym)))
`(do ((,loop-start ,start)
(,loop-end ,end)
(,var (if (is-prime ,loop-start)
,loop-start
(next-prime-after ,loop-start))
(next-prime-after ,var)))
((> ,var ,loop-end))
,#body )))
do-primes-v2 works perfectly.
[13]> (do-primes-v2 (p 10 25) (format t "~d " p))
11 13 17 19 23
Next I tried using gensym to avoid naming clashes in macro expansion - do-primes-v3. However I'm stuck with a
*** - EVAL: variable #:G3498 has no value
Tried using macro-expand to see if i could spot the mistake but I can't.
[16]> (macroexpand-1 `(do-primes-v3 (p 10 25) (format t "~d " p)))
(DO
((#:G3502 10) (#:G3503 25)
(P (IF (IS-PRIME #:G3502) #:G3502 (NEXT-PRIME-AFTER #:G3502))
(NEXT-PRIME-AFTER P)))
((> P #:G3503)) (FORMAT T "~d " P)) ;
Use DO* instead of DO.
DO Initializes the bindings in a scope where they are not yet visible. DO* initializes the bindings in a scope where they are visible.
In this particular case var needs to reference the other binding loop-start.
You don't actually need the gensym here for avoiding variable capture, because you do not introduce any variables that would be "local to the macro". When you macroexpand your do-primes-v2, you will see that no variable is introduced that didn't exist outside of the macro.
You do need it for a different thing, though: avoiding multiple evaluation.
If you call the macro like this:
(do-primes-v2 (p (* x 2) (* y 3))
(format "~a~%" p))
it expands to
(do ((p (if (is-prime (* x 2))
(* x 2)
(next-prime-after (* x 2))
(next-prime-after p)))
((> p (* y 3))
(format "~a~%" p))
At best, this is inefficient, because those multiplications are done multiple times. However, if you use a function with side effects as inputs, like setf or incf, this can be a big problem.
Either move the binding of your loop-start and loop-end to an enclosing LET block or use DO*. The reason is that all loop variables in DO are bound "in parallel", so for the first binding, the (expanded) loop-start variable does not yet have a binding.
I know this doesn't really answer your question, but I do think it is relevant. In my experience, the type of macro you are attempting to write is a very common one. One problem I have with the way you have approached the problem is that it doesn't handle another common use case: functional composition.
I don't have the time to highlight some of the difficulties you will probably encounter using your macro, I will however highlight that, had you built your prime iterator geared towards functional composition, your macro turns out to be extremely simple, avoiding your question altogether.
Note: I have slightly modified some of your functions.
(defun is-prime (n)
(cond
((< n 2)
nil)
((= n 2)
t)
((evenp n)
nil)
(t
(do ((i 2 (1+ i)))
((= i n) t)
(when (or (= (mod n i) 0))
(return nil))))))
(defun next-prime (n)
(do ((i n (1+ i)))
((is-prime i) i)))
(defun prime-iterator (start-at)
(let ((current start-at))
(lambda ()
(let ((next-prime (next-prime current)))
(setf current (1+ next-prime))
next-prime))))
(defun map-primes/iterator (fn iterator end)
(do ((i (funcall iterator) (funcall iterator)))
((>= i end) nil)
(funcall fn i)))
(defun map-primes (fn start end)
(let ((iterator (prime-iterator start)))
(map-primes/iterator fn iterator end)))
(defmacro do-primes ((var start end) &body body)
`(map-primes #'(lambda (,var)
,#body)
,start ,end))
I too recommend that you look at Series. The generator pattern is also a very common occurrence in lisp programs. You may also want to look at Alexandria, in particular the function ALEXANDRIA:COMPOSE to see what cool stuff you can do with functional composition.
I suggest avoiding DO/DO* and macros altogether and instead going for Series (an implementation of which can be found on series.sourceforge.net).
If that's too complex then consider just generating a list of primes with recursion or a generator (for on-demand generation).