I'm playing around with Racket and missed a byte-string comprehension. When I found for/fold/derived with examples in the documentation, I decided to roll my own byte-string comprehension macro, as any beginner would:
(define-syntax (for/bytes stx)
(syntax-case stx ()
((_ clauses . defs+exprs)
(with-syntax ((original stx))
#'(let-values
(((bstr i max-length)
(for/fold/derived original ((bstr (make-bytes 16)) (c 0) (ln-incr 32)) clauses
(define el (let () . defs+exprs))
(let-values (((new-bstr new-ln-incr)
(if (eq? c (bytes-length bstr))
(values (bytes-append bstr (make-bytes ln-incr)) (* ln-incr 2))
(values bstr ln-incr))))
(bytes-set! new-bstr c el)
(values new-bstr (+ c 1) new-ln-incr)))))
(subbytes bstr 0 i))))))
I've got a few related questions:
Is this the Racket way anyhow?
Is the macro ok? Basically I combined the examples from the for/fold/derived documentation with a macro-expaned for/vector
Are there any obvious performance optimizations?
Sadly, it's not really faster than (list->bytes (for/list ... This micro-benchmark:
(define size 50000)
(define (custom-byte-test) (for/bytes ((i (in-range size))) (modulo i 256)))
(define (standard-list-test) (list->bytes (for/list ((i (in-range size))) (modulo i 256))))
(profile-thunk custom-byte-test #:repeat 1000)
(profile-thunk standard-list-test #:repeat 1000)
gives 3212ms vs 3690ms. For sizes much smaller than 50000 my for/bytes loses, for sizes bigger than that it wins.
My answers:
Is this the Racket way anyhow?
Yes.
Is the macro ok? Basically I combined the examples from the for/fold/derived documentation with a macro-expand for/vector
Yes, I think it looks good.
Are there any obvious performance optimizations? Sadly, it's not really faster than (list->bytes (for/list ...
I'm not aware of how to do it faster. The "win" here is that the complexity of buffer resizing is hidden from users of for/bytes.
I sped your code up a little.
1) The bytes-length calculation in the inner loop is unneeded since you already know the current length. I replaced your ln-incr with a bstr-len that represents both the current length and the amount to increase the length.
This gave ~15% improvement.
2) Since you already do length checking, you can safely use unsafe-bytes-set!, which speeds things up another ~10%.
On my machine, custom-byte-test is now ~1200ms vs ~1750ms for standard-list-test.
#lang racket
(require racket/unsafe/ops profile)
(define-syntax (for/bytes stx)
(syntax-case stx ()
[(_ clauses . defs+exprs)
(with-syntax ([original stx])
#'(let ([init-bstr-len 32])
(let-values
([(bstr i max-length)
(for/fold/derived
original
([bstr (make-bytes init-bstr-len)]
[c 0]
[bstr-len init-bstr-len]) ; <-- use as curr len + extend len
clauses
(define el (let () . defs+exprs))
(let-values
([(new-bstr new-bstr-len)
(if (= c bstr-len) ; <-- remove len calculation
(values
(bytes-append bstr (make-bytes bstr-len))
(* bstr-len 2))
(values bstr bstr-len))])
(unsafe-bytes-set! new-bstr c el) ; <-- unsafe op
(values new-bstr (add1 c) new-bstr-len)))])
(subbytes bstr 0 i))))]))
(define size 50000)
(define (custom-byte-test)
(for/bytes ([i (in-range size)]) (modulo i 256)))
(define (standard-list-test)
(list->bytes (for/list ([i (in-range size)]) (modulo i 256))))
(profile-thunk custom-byte-test #:repeat 1000)
(profile-thunk standard-list-test #:repeat 1000)
Related
I have code like this:
(define-syntax macron
(syntax-rules ()
((_ name)
(lambda (x)
(eval (cons 'name x) (interaction-environment))))))
(define x (map (macron lambda)
'(((x) (display x)) ((a b) (+ a b)))))
(let ((square (car x))
(sum (cadr x)))
(display (square 10))
(newline)
(display (sum 1 2 3))
(newline))
the code is working it use macro as value by wrapping it with lambda. My question is how can I put inside syntax-rule macro literal symbol 'name instead of (cons 'lambda ...) so the output code is:
(lambda (x)
(eval (cons 'name x) (interaction-environment)))
so it work with code like this:
(define (name x)
(display x)
(newline))
(for-each (macron lambda) ;; lambda can be anything
'((1) (2) (3)))
and it print all the numbers.
I know that I can change the name in pattern into something else, but I want to know more about syntax-rules and it's edge cases. So is it possible to have name if I use it as input pattern?
I'm looking for answers with R7RS, that have more of this type of edge cases covered.
All macros happens in compile time so runtime stuff might not exist. That means that you should think of it as syntax sugar and use it as susch. eg.
(for-each (macron something) '((1) (2) (3)))
Should then have an expansion based on that. Your current expansion is that it turns into this:
(for-each (lambda (x)
(eval (cons 'someting x) (interaction-environment))
'((1) (2) (3)))
For something being a macro this will apply the macro in runtime. It is bad. It also removes the need for the macro in the first place. You could do this instead:
(define (macron-proc name)
(lambda (x)
(eval (cons name x) (interaction-environment))))
(for-each (macron-proc 'something) '((1) (2) (3)))
I made a programming language that had passable macros:
(define xor (flambda (a b) `(if ,a (not ,b) ,b)))
(define (fold comb init lst)
(if (null? lst)
init
(fold comb (comb (car lst) init) (cdr lst))))
(fold xor #f '(#t #t)) ; ==> #f
It's not a very good approach if you are targeting an efficient compiled end product. The first macros were indeed like this and they removed it in LISP 1.5 before Common Lisp. Scheme avoided macros for many years and opted for syntax-rules in R4RS as an optional feature. R6RS is the only version that has full power macros.
With a procedure instead of macros this is actually the same as the following code with the bad eval removed:
(for-each (lambda (x)
(apply something x))
'((1) (2) (3)))
Which means you can implement macron much easier:
(define-syntax macron
(syntax-rules ()
((_ name)
(lambda (x)
(apply name x)))))
But from looking at this now you don't need a macro at all. This is partial application.
(define (partial proc arg)
(lambda (lst)
(apply proc arh lst)))
(map (partial + 3) '((1 2) (3 4) (4 5)))
; ==> (6 10 12)
There is actually a SRFI-26 called cut/cute which allows us to do something similar where it wraps it in a lambda:
(map (cut apply + 3 <>) '((1 2) (3 4) (4 5)))
The syntax-rules are the macros with the least power. You cannot do anything unhygienic and you cannot make new identifiers based on other ones. Eg. it' impossible to implement a racket style struct where you can do (struct complex [real imag]) and have the macro create complex?, complex-real, and complex-imag as procedures. You need to do as SRFI-57 does and require th euser to specify all the names such that you don't need to concatenate to new identifiers.
Right now R7RS-small only has syntax-rules. I think it was a mistake not to have a more powerful macro as an alternative since now the R7RS-large cannot be implemented with R7RS-small.
For example,
(require racket/generator)
(define f add1)
(define init 0)
(in-producer (generator () (let loop ([x init]) (yield x) (loop (f x)))))
Is there any better way to do this? I don't quite like generators since they have hidden states.
Streams
Using streams is probably the easiest:
(require racket/stream)
;; X [X -> X] -> [Streamof X]
(define (repeated-fn-stream init f)
(stream-cons init (repeated-fn-stream (f init) f)))
(repeated-fn-stream 0 add1)
Sequences
Alternatively, using sequences and make-do-sequence:
(require racket/sequence)
;; X [X -> X] -> [Sequenceof X]
(define (repeated-fn-sequence init f)
;; A "Pos" is an X that's the result of applying f repeatedly to init
(define (pos->element pos) pos)
(define (next-pos pos) (f pos))
(define init-pos init)
(make-do-sequence
(λ ()
(values pos->element
next-pos
init-pos
#false
#false
#false))))
(repeated-fn-sequence 0 add1)
If you wanted to use sequences, and you wanted to use define-sequence-syntax to make for loops specialize it:
(this is completely unnecessary for "pure" functionality, but it may have different performance characteristics)
(require (for-syntax syntax/parse))
(define-sequence-syntax in-repeated-fn-sequence
(λ () #'repeated-fn-sequence) ; when used as a normal expression
(syntax-parser ; when used *directly* as a for-loop clause
[[(x) (_ init-expr f-expr)]
#'[(x) (:do-in
([(init) init-expr] [(f) f-expr])
#true
([x init])
#true
()
#true
#true
[(f x)])]]))
(for/list ([x (in-repeated-fn-sequence 0 add1)]
[i (in-range 10)])
x)
When using define-sequence-syntax, you should make sure that for everything there is a "single point of truth". Because of that you often see this pattern:
(define-sequence-syntax in-___
(λ () #'in-___/proc) ; when used as a normal expression
(syntax-parser
....everything that defines the actual functionality....))
;; This is completely determined by the sequence-syntax above,
;; that way there is NO duplicated functionality and NO chance for
;; it to get "out of sync".
(define (in-___/proc parameter ...)
(for/stream ([elem (in-___ parameter ...)])
elem))
What that means for this is that once you decide you want to use define-sequence-syntax, you should define the repeated-fn-sequence function in terms of it:
(define (repeated-fn-sequence init f)
(for/stream ([elem (in-repeated-fn-sequence init f)])
elem))
That way if the in-repeated-fn-sequence needs to be changed to fix a bug or switch representations, the function version changes with it automatically.
The best function for this job is an unfold… but unfortunately, Racket does not provide a built-in sequence-unfold or stream-unfold operation. However, there is a stream-unfold operation in the srfi/41 library, which will meet your needs. You can see this in action with the following program:
#lang racket
(require (only-in srfi/41 stream-unfold))
(define nats (stream-unfold identity (const #t) add1 0))
(for/list ([i (in-range 20)] [n nats]) n)
This produces the following output:
'(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
If you don’t want to use srfi/41, you can write stream-unfold yourself in terms of the racket/stream API without too much difficulty, and without any statefulness:
(define (stream-unfold mapper pred? gen base)
(let loop ([base base])
(if (pred? base)
(stream-cons (mapper base) (loop (gen base)))
empty-stream)))
I need to implement my_let* using defmacro which works similarly to let*, but while let* is expanded to a series of nested let calls (behind the scenes), my_let* needs to be expanded to a single let call, and use the define statement to define the arguments i get.
an example of using my_let*:
(my_let* ((a 2)
(b 3)
(c (+ a b)))
(+ a b c))
and the return value of this code should be 10. just as if it was use let*.
the code above will be expanded in my_let* to the following:
(let ()
(define a 2)
(define b 3)
(define c (+ a b))
(+ a b c))
I'm new to using macro, though i successfully written some macros, this one got me lost.
Thank you in advance.
Use syntax-parse. At the least don't even consider using defmacro in Racket.
#lang racket
(require (for-syntax syntax/parse))
(define-syntax (my-let* stx)
(syntax-parse stx
[(_my-let* ([name:id e:expr] ...) body ...)
#'(let ()
(define name e) ...
body ...)]))
The name:id means that name must be an identifier and e:expr means
that e must an expression. These simple annotations help syntax-parse
to give you better error messages.
Example:
(my-let* ((4 2)
(b 3)
(c (+ a b)))
(+ a b c))
Here the DrRacket will color the 4 read and give the message:
my-let*: expected identifier in: 4
The Scheme way is using syntax-rules
(define-syntax my-let*
(syntax-rules ()
((_ ((binding expression) ...) body ...)
(let ()
(define binding expression) ...
body ...))))
Using defmacro is more like making a procedure.
(define (my-let-fun* bindings . body)
...)
How it should work is like this:
(my-let-fun* '((a 1) (b 2) (c (+ a b))) "test" '(list a b c))
; ==> (let () (define a 1) (define b 2) (define c (+ a b)) "test" (list a b c))
If you have not called my-let-fun* in your implementation it's just changing it to a defmacro and you're done.
(defmacro my-let* (bindings . body)
...)
It's quite simple to do either with a helper to do recursion or foldr to do the bindings. Good luck!
Your my-let* will only work in #lang racket and perhaps #!r6rs and later. In R5RS you will get an error in this case:
(my-let* ((a 1) (b 2) (c (+ a b)))
(list a b c))
; signals an error that a is undefined.
The reason is that it expands to something like this:
(let ((a 'undefined) (b 'undefined) (c 'undefined))
(let ((tmp1 1) (tmp2 2) (tmp3 (+ a b)))
(set! a tmp1)
(set! b tmp2)
(set! c tmp3))
(list a b c))
Between the error messages and some judicious use of the macro stepper I think it's hard to go too wrong here. The trouble is just making sure you've put things together right using either conses or unquote-splicing. I believe the standard practice in such macros is heavy use of quasiquote and unquote-splicing in order for the output to as closely match the intended statement as possible, otherwise the macro can become quite inscrutable. But I am not a defmacro expert.
#lang racket/base
(require (for-syntax racket/base)
compatibility/defmacro)
(defmacro my-let* (binding-pairs . body)
(define defines (map (lambda (bp) (cons 'define bp)) binding-pairs))
`(let ()
,#defines
,#body))
(my-let* ((a 2)
(b (expt a 3)))
(printf "a:~a\nb:~a\n" a b)
(+ a b))
As an exercise in learning the Racket macro system, I've been implementing a unit testing framework, based on the C++ catch framework. One of the features of that framework is that if I write a check like this:
CHECK(x == y); // (check x y)
When the check is violated the error message will print out the values of x and y, even though the macro used is completely generic, unlike other test frameworks that require you to use macros like CHECK_EQUALS, CHECK_GREATER, etc. This is possible through some hackery involving expression templates and operator overloading.
It occurs to me that in Racket you should be able to do an even better job. In the C++ version the macro can't see inside subexpressions, so if you write something like:
CHECK(f(x, g(y)) == z); // (check (= (f x (g y)) z))
When the check is violated you only find out the values of the left and right hand side of the equal sign, and not the values of x, y, or g(y). In racket I expect it should be possible to recurse into subexpressions and print a tree showing each step of the evaluation.
Problem is I have no idea what the best way to do this is:
I've gotten fairly familiar with syntax-parse, but this seems beyond its abilities.
I read about customizing #%app which almost seems like what I want, but if for example f is a macro, I don't want to print out every evaluation of the expressions that are in the expansion, just the evaluations of the expressions that were visible when the user invoked the check macro. Also not sure if I can use it without defining a language.
I could use syntax-parameterize to hijack the meaning of the basic operators but that won't help with function calls like g(y).
I could use syntax->datum and manually walk the AST, calling eval on subexpressions myself. This seems tricky.
The trace library almost looks like what it does what I want, but you have to give it a list of functions upfront, and it doesn't appear to give you any control over where the output goes (I only want to print anything if the check fails, not if it succeeds, so I need to save the intermediate values to the side as execution proceeds).
What would be the best or at least idiomatic way to implement this?
Here is something to get you started.
#lang racket
(require (for-syntax syntax/parse racket/list))
(begin-for-syntax
(define (expression->subexpressions stx)
(define expansion (local-expand stx 'expression '()))
(syntax-parse expansion
#:datum-literals (#%app quote)
[x:id (list #'x)]
[b:boolean (list #'b)]
[n:number (list #'n)]
; insert other atoms here
[(quote literal) (list #'literal)]
[(#%app e ...)
(cons stx
(append-map expression->subexpressions (syntax->list #'(e ...))))]
; other forms in fully expanded syntax goes here
[else
(raise-syntax-error 'expression->subexpressions
"implement this construct"
stx)])))
(define-syntax (echo-and-eval stx)
(syntax-parse stx
[(_ expr)
#'(begin
(display "] ") (displayln (syntax->datum #'expr))
(displayln expr))]))
(define-syntax (echo-and-eval-subexpressions stx)
(syntax-parse stx
[(_ expr)
(define subs (expression->subexpressions #'expr))
(with-syntax ([(sub ...) subs])
#'(begin
; sub expressions
(echo-and-eval sub)
...
; original expression
(echo-and-eval expr)))]))
(echo-and-eval-subexpressions (+ 1 2 (* 4 5)))
The output:
] (+ 1 2 (* 4 5))
23
] +
#<procedure:+>
] 1
1
] 2
2
] (#%app * '4 '5)
20
] *
#<procedure:*>
] 4
4
] 5
5
] (+ 1 2 (* 4 5))
23
An alternative to printing everything is to add a marker for stuff that should be shown. Here's a rough simple sketch:
#lang racket
(require racket/stxparam)
(define-syntax-parameter ?
(λ(stx) (raise-syntax-error '? "can only be used in a `test' context")))
(define-syntax-rule (test expr)
(let ([log '()])
(define (log! stuff) (set! log (cons stuff log)))
(syntax-parameterize ([? (syntax-rules ()
[(_ E) (let ([r E]) (log! `(E => ,r)) r)])])
(unless expr
(printf "Test failure: ~s\n" 'expr)
(for ([l (in-list (reverse log))])
(for-each display
`(" " ,#(add-between (map ~s l) " ") "\n")))))))
(define x 11)
(define y 22)
(test (equal? (? (* (? x) 2)) (? y)))
(test (equal? (? (* (? x) 3)) (? y)))
which results in this output:
Test failure: (equal? (? (* (? x) 3)) (? y))
x => 11
(* (? x) 3) => 33
y => 22
I've attempted to solve Euler Problem 2 with the following tail recursive functions:
(defun fib (num)
(labels ((fib-helper (num a b)
(cond ((or (zerop num)
(eql num 1))
a)
(t (fib-helper (decf num)
(+ a b)
a)))))
(fib-helper num 1 1)))
(defun sum-even-fib (max)
(labels ((helper (sum num)
(cond ((oddp num) (helper sum (decf num)))
((zerop num) sum)
(t (helper (+ sum (fib num))
(decf num))))))
(helper 0 max)))
Now, when I try to print the result using the function
(defun print-fib-sum (max dir file)
(with-open-file
(fib-sum-str
(make-pathname
:name file
:directory dir)
:direction :output)
(format fib-sum-str "~A~%" (sum-even-fib max))))
with a max value of 4000000, I get the error
("bignum overflow" "[Condition of type SYSTEM::SIMPLE-ARITHMETIC-ERROR]" nil)
from *slime-events*. Is there any other way to handle the number and print to the file?
First, a few small issues:
Use time instead of top.
Common Lisp standard does not require tail recursion optimization. While many implementation do it, not all of them optimize all cases (e.g., labels).
Your algorithm is quadratic in max because it computes the nth Fibonacci number separately for all indexes. You should make it linear instead.
You are computing the sum of even-indexed numbers, not even-valued numbers.
Now, the arithmetic error you are seeing: 4,000,000th Fibonacci number is pretty large - about 1.6^4M ~ 10^835951. Its length is about 2,776,968.
Are you sure your lisp can represent bignums this big?
So I've solved Euler #2 with the following tail recursive code:
(defun rev-sum-even-fib (max-val)
(labels ((helper (sum a b)
(cond ((oddp a)
(helper sum (+ a b) a))
((> a max-val)
sum)
(t
(helper (+ sum a) (+ a b) a)))))
(helper 0 1 0)))
Here, the algorithm is linear in max and evaluates in
(time (rev-sum-even-fib 4000000))
Real time: 3.4E-5 sec.
Run time: 0.0 sec.
Space: 0 Bytes
Where I've omitted the numerical answer for obvious reasons.
Since CL does not promise that it supports TCO (for example ABCL on the JVM does not support TCO - tail call optimization), it makes sense to write it portably as a loop:
(defun rev-sum-even-fib (max-val)
(loop for a = 1 then (+ a b) and b = 0 then a
until (> a max-val)
when (evenp a) sum a))