I'm using Chez Scheme and I'd like to introduce some top-level bindings based on the contents of a directory. The usage of this hypothetical macro might look like this:
(bind-files f "~/my-dir/")
;; Expanding to:
(begin (define f0 "~/my-dir/a.wav")
(define f1 "~/my-dir/b.wav"))
I'm getting comfortable with syntax-case, datum->syntax and with-syntax as described in the Scheme book's examples. But I can't imagine how one could create identifiers based on the result of something 'runtime-y' like (directory-list "~/") - is it even possible?
(By the way, this is for a live-coding musical application, so there's no need to comment that this is a bad idea for reliable software - it's for a very specific interactive context.)
You can use something like this macro:
#!r6rs
(import (rnrs) (chezscheme))
(define-syntax bind-file
(lambda (x)
(define (name&file k dir)
(define (->fn i)
(string->symbol (string-append "f" (number->string i))))
(let ((files (directory-list (syntax->datum dir))))
(datum->syntax k (do ((i 0 (+ i 1)) (files files (cdr files))
(r '() (cons (list (->fn i) (car files)) r)))
((null? files) r)))))
(syntax-case x ()
((k dir)
(string? (syntax->datum #'dir))
(with-syntax ((((name file) ...) (name&file #'k #'dir)))
#'(begin (define name file) ...))))))
(bind-file ".")
#|
;; depending on the number of files
f0 ... fn variables are defined.
|#
Related
In "The Scheme Programming Language 4th Edition" section 3.3 Continuations the following example is given:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
I can confirm it works in chezscheme as written:
> (product '(1 2 3 4 5))
120
What is 'f' in the above let? Why is the given ls being assigned to itself? It doesn't seem to match what I understand about (let ...) as described in 4.4 local binding:
syntax: (let ((var expr) ...) body1 body2 ...)
If 'f' is being defined here I would expect it inside parenthesis/square brackets:
(let ([f some-value]) ...)
This is 'named let', and it's a syntactic convenience.
(let f ([x y] ...)
...
(f ...)
...)
is more-or-less equivalent to
(letrec ([f (λ (x ...)
...
(f ...)
...)])
(f y ...))
or, in suitable contexts, to a local define followed by a call:
(define (outer ...)
(let inner ([x y] ...)
...
(inner ...)
...))
is more-or-less equivalent to
(define (outer ...)
(define (inner x ...)
...
(inner ...)
...)
(inner y ...))
The nice thing about named let is that it puts the definition and the initial call of the local function in the same place.
Cavemen like me who use CL sometimes use macros like binding, below, to implement this (note this is not production code: all its error messages are obscure jokes):
(defmacro binding (name/bindings &body bindings/decls/forms)
;; let / named let
(typecase name/bindings
(list
`(let ,name/bindings ,#bindings/decls/forms))
(symbol
(unless (not (null bindings/decls/forms))
(error "a syntax"))
(destructuring-bind (bindings . decls/forms) bindings/decls/forms
(unless (listp bindings)
(error "another syntax"))
(unless (listp decls/forms)
(error "yet another syntax"))
(multiple-value-bind (args inits)
(loop for binding in bindings
do (unless (and (listp binding)
(= (length binding) 2)
(symbolp (first binding)))
(error "a more subtle syntax"))
collect (first binding) into args
collect (second binding) into inits
finally (return (values args inits)))
`(labels ((,name/bindings ,args
,#decls/forms))
(,name/bindings ,#inits)))))
(t
(error "yet a different syntax"))))
f is bound to a procedure that has the body of let as a body and ls as a parameter.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.16
Think of this procedure:
(define (sum lst)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc))))
(helper lst 0))
(sum '(1 2 3)) ; ==> 6
We can use named let instead of defining a local procedure and then use it like this:
(define (sum lst-arg)
(let helper ((lst lst-arg) (acc 0))
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc)))))
Those are the exact same code with the exception of some duplicate naming situations. lst-arg can have the same name lst and it is never the same as lst inside the let.
Named let is easy to grasp. call/ccusually takes some maturing. I didn't get call/cc before I started creating my own implementations.
I am attempting to read and write a matrix from file "data.txt".
The matrix is lists with strings inside of them.
When I am writing I want to write from the begining an override the data. Basically I delete the file every time. I need bether solusion for this.
May main problem is that after a couple readings and writhings of the file corrupts.
system error: Access is denied.; errno=5
My code:
;reading file returning matix of strings
(define (file-reader file-name)
(define pointer (open-input-file file-name))
(define (helper line)
(cond
((equal? line eof) '())
((cons (list line) (helper (read-line pointer))))))
(list-matr (helper (read-line pointer)))
)
;converting matrix of string to matrix of lists with strings inside
(define (list-matr str-matr)
(define (helper str-matr line-num)
(cond
((null? str-matr) '())
((= line-num 1) (cons (map (lambda (x) (string-append x "?")) (string-split (caar str-matr) "? ")) (helper (cdr str-matr) (+ line-num 1))))
((cons (string-split (caar str-matr) " ") (helper (cdr str-matr) (+ line-num 1))))))
(helper str-matr 1))
;saving in file
(define (writer file-name questions answers)
(cond
((file-exists? file-name) (delete-file file-name)))
(write-to-file file-name (string-append (string-join questions) "\n"))
(define (helper cur-l ans)
(cond
((null? ans))
((helper (write-to-file file-name (string-append (string-join (car ans)) "\n")) (cdr ans)))))
(helper '() answers)
)
(define (write-to-file path string)
(call-with-output-file path #:exists 'append
(lambda (newline)
(display string newline))))
Commands for calling the functions.
(file-reader "data.txt")
(writer "data.txt" questions answers)
I think the problem coming from that I don't close the files, but I can't figure out where to put the command for that.
If my code is very bad you can give me other examples for reading and writing matrix from file.
Thank you.
You are correct that the file will corrupt - it's never properly closed.
Without overwriting the file each time, you will need something outside of the normal R5RS/R7RS-small specification, and I'm not aware off the top of my head of any (final) SRFI that allows random file access. That said, many/most Scheme implementations provide some form of low-level I/O interface. The disadvantage of such is that you will have to track the structure very carefully so as to overwrite or add only the correct amount, which will probably be more work than rewriting the entire file.
I would recommend restructuring this completely. First, the call-with-output-file/with-output-to-file procedures will automatically overwrite the output file unless flagged otherwise (in most implementations - though the specifications state that the behaviour is undefined). They will also automatically close the file upon completion. Similar behaviour for the call-with-input-file/with-input-from-file procedures.
You can probably simplify everything by something like the following:
; reader
; this could be further simplified by replacing the cons call with
; (cons (<parse-procedure> l) r), to parse the input at the same time
(define (matrix-read filename)
(with-input-from-file filename (lambda ()
(let loop ((l (read-line))
(r '()))
(if (eof-object? l)
(reverse r)
(loop (read-line) (cons l r))))))
; I don't understand the input/output format...
; writer
(define (matrix-write filename data)
(with-output-to-file filename (lambda ()
(for-each
(lambda (l)
; again, I don't know the actual structure outside of a list
(display l)
(newline))
data))))
If you explain the input format, I can modify the answer.
I'm trying to write a macro in racket/scheme that operates like a for loop across some arbitrary code such that the body of the loop is unrolled. For example, the following code
(macro-for ((i '(0 1 2 3))
(another-macro
(with i)
(some (nested i))
(arguments (in (it (a b c i))))))
should have the same result as if the code had been written as
(another-macro
(with 0)
(some (nested 0))
(arguments (in (it (a b c 0))))))
(another-macro
(with 1)
(some (nested 1))
(arguments (in (it (a b c 1))))))
(another-macro
(with 2)
(some (nested 2))
(arguments (in (it (a b c 2))))))
I've made an attempt of implementing it but I'm new to macros and they don't seem to work as I expect them to. Here's my attempt - which doesn't compile because match apparently is not allowed to be used within macros - but hopefully it conveys the idea I'm trying to achieve.
(module test racket
(require (for-syntax syntax/parse))
(begin-for-syntax
(define (my-for-replace search replace elem)
(if (list? elem)
(map (lambda (e) (my-for-replace search replace e)) elem)
(if (equal? elem search)
replace
elem))))
(define-syntax (my-for stx)
(syntax-case stx ()
((my-for args-stx body-stx)
(let ((args (syntax-e #'args-stx)))
(if (list? args)
(map (lambda (arg)
(match arg
((list #'var #'expr)
(my-for-replace #'var #'expr #'body))
(else
(raise-syntax-error #f
"my-for: bad variable clause"
stx
#'args))))
args)
(raise-syntax-error #f
"my-for: bad sequence binding clause"
stx
#'args))))))
(define-syntax (my-func stx)
(syntax-parse stx
((my-func body)
#'body)))
(my-for ((i '(0 1 2)))
(my-func (begin
(display i)
(newline))))
)
Here's how I would write that (if I were going to write something like that):
First, we need a helper function that substitutes in one syntax object wherever an identifier occurs in another syntax object. Note: never use syntax->datum on something that you intend to treat as an expression (or that contains expressions, or definitions, etc). Instead, recursively unwrap using syntax-e and after processing put it back together just like it was before:
(require (for-syntax racket/base))
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (syntax-substitute stx id replacement)
(let loop ([stx stx])
(cond [(and (identifier? stx) (bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Unwrapped data cases:
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; FIXME: also traverse vectors, etc?
[else stx]))))
Use bound-identifier=? when you're implementing a binding-like relationship, like substitution. (This is a rare case; usually free-identifier=? is the right comparison to use.)
Now the macro just interprets the for-clause, does the substitutions, and assembles the results. If you really want the list of terms to substitute to be a compile-time expression, use syntax-local-eval from racket/syntax.
(require (for-syntax racket/syntax))
(define-syntax (macro-for stx)
(syntax-case stx ()
[(_ ([i ct-sequence]) body)
(with-syntax ([(replaced-body ...)
(for/list ([replacement (syntax-local-eval #'ct-sequence)])
(syntax-substitute #'body #'i replacement))])
#'(begin replaced-body ...))]))
Here's an example use:
> (macro-for ([i '(1 2 3)]) (printf "The value of ~s is now ~s.\n" 'i i))
The value of 1 is now 1.
The value of 2 is now 2.
The value of 3 is now 3.
Notice that it replaces the occurrence of i under the quote, so you never see the symbol i in the output. Is that what you expect?
Disclaimer: This is not representative of typical Racket macros. It's generally a bad idea to go searching and replacing in unexpanded forms, and there are usually more idiomatic ways to achieve what you want.
If the for-loop is to be evaluated at compile-time, you can use the builtin for loop.
#lang racket/base
(require (for-syntax syntax/parse
racket/base)) ; for is in racket/base
(define-syntax (print-and-add stx)
(syntax-parse stx
[(_ (a ...))
; this runs at compile time
(for ([x (in-list (syntax->datum #'(a ...)))])
(displayln x))
; the macro expands to this:
#'(+ a ...)]))
(print-and-add (1 2 3 4 5))
Output:
1
2
3
4
5
15
UPDATE
Here is an updated version.
#lang racket
(require (for-syntax syntax/parse racket))
(define-syntax (macro-for stx)
(syntax-parse stx
[(_macro-for ((i (a ...))) body)
(define exprs (for/list ([x (syntax->list #'(a ...))])
#`(let-syntax ([i (λ (_) #'#,x)])
body)))
(with-syntax ([(expr ...) exprs])
#'(begin expr ...))]))
(macro-for ((i (1 2 3 4)))
(displayln i))
Output:
1
2
3
4
Ryan Culpepper's answer only supports use of one induction variable, so here's an extension which supports multiple induction variables:
(begin-for-syntax
;; syntax-substitute : Syntax Identifier Syntax -> Syntax
;; Replace id with replacement everywhere in stx.
(define (instr-syntax-substitute stx id replacement index)
(let loop ([stx stx])
(cond [(and (identifier? stx)
(bound-identifier=? stx id))
replacement]
[(syntax? stx)
(datum->syntax stx (loop (syntax-e stx)) stx stx)]
;; Special handling of (define-instruction id ...) case
[(and (pair? stx)
(syntax? (car stx))
(equal? (syntax-e (car stx)) 'define-instruction))
(let ((id-stx (car (cdr stx))))
(cons (loop (car stx))
(cons (datum->syntax id-stx
(string->symbol
(format "~a_~a"
(symbol->string
(syntax-e id-stx))
index))
id-stx
id-stx)
(loop (cdr (cdr stx))))))]
;; Unwrap list case
[(pair? stx)
(cons (loop (car stx)) (loop (cdr stx)))]
;; Do nothing
[else stx]))))
(begin-for-syntax
(define instr-iter-index 0)
(define (instr-iter-arg body arg argrest)
(let loop ([body body]
[arg arg]
[argrest argrest])
(let ([i (car (syntax-e arg))]
[ct-sequence (cadr (syntax-e arg))]
[replaced-bodies '()])
(for ([replacement (syntax-e ct-sequence)])
(let ([new-body (instr-syntax-substitute body
i
replacement
instr-iter-index)])
(if (null? argrest)
(begin
(set! replaced-bodies
(append replaced-bodies (list new-body)))
(set! instr-iter-index (+ instr-iter-index 1)))
(let* ([new-arg (car argrest)]
[new-argrest (cdr argrest)]
[new-bodies (loop new-body
new-arg
new-argrest)])
(set! replaced-bodies
(append replaced-bodies new-bodies))))))
replaced-bodies))))
(provide instr-for)
(define-syntax (instr-for stx)
(syntax-case stx ()
[(instr-for args body)
(with-syntax ([(replaced-body ...)
(let ([arg (car (syntax-e #'args))]
[argrest (cdr (syntax-e #'args))])
(instr-iter-arg #'body arg argrest))])
#'(begin replaced-body ...))]))
MIT Scheme has string->input-port, Racket has open-input-string. How to implement this in pure Scheme (no Racket, Chicken, Gambit, or any implementation-specific extension).
According to Chis' answer we have a new Scheme standard, R7RS. It has open-input-string provided.
For the older R6RS, it's trivial to implement the same with make-custom-textual-input-port from (rnrs io ports (6)) library. Here is something I put together:
#!r6rs
(import (rnrs base (6))
(rnrs io ports (6))
(rnrs mutable-strings (6))
(rnrs io simple (6)))
(define (open-input-string str)
;; might not be so important to have a different indentifier
;; but this will make debugging easier if implementations use the
;; id provided
(define get-id
(let ((n 0))
(lambda (str)
(set! n (+ n 1))
(string->symbol
(string-append "string-port" str "-"
(number->string n))))))
(let ((len (string-length str))
(pos 0))
(make-custom-textual-input-port
(get-id str)
(lambda (string start count)
(let loop ((cur-dst start)
(cur-src pos)
(n 0))
(cond ((or (>= cur-src len)
(>= n count))
(set! pos cur-src)
n)
(else
(string-set! string cur-dst (string-ref str cur-src))
(loop (+ cur-dst 1)
(+ cur-src 1)
(+ n 1))))))
(lambda () pos)
(lambda (new-pos) (set! pos new-pos))
#f)))
(define test (open-input-string "(1 2 3 4)(5 6 7 8)"))
(define str (read test)) ; str == (1 2 3 4)
(define str2 (read test)) ; str2 == (5 6 7 8)
With R5RS there is not way to do this except using a file.
In the recently-ratified R7RS, open-input-string is provided directly. (Thanks to Sylwester for reminding me to look beyond R5RS. :-))
In R5RS, a pure Scheme implementation of string ports is not trivial, as it requires you to redefine all the standard I/O functions. See SRFI 6 for a reference implementation.
It really is better if your implementation supports string ports directly.
Write the string to a (temporary) file, then return an input port to read it back in. Like this:
(define (open-input-string string)
(let ((file "/tmp/foo"))
(call-with-output-file file
(lambda (port)
(display string port)))
(open-input-file file)))
> (define ps (open-input-string "This is a test; it is only a test"))
> ps
#<input-port (textual) "/tmp/foo">
> (read-line ps)
"This is a test; it is only a test"
Note, you'll need to be more sophisticated with use of file. For example, the above code only works once; it will fail with 'file exists' on a second call. But the above is a simple answer to your question.
This seems to work, it's a macro that expands to successive integers depending on how many times it has been expanded.
;; Library (test macro-state)
(library
(test macro-state)
(export get-count incr-count)
(import (rnrs))
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1)))
)
;; Program
(import (rnrs) (for (test macro-state) expand))
(define-syntax m
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count)))))))
(write (list (m) (m) (m)))
(newline)
;; prints (1 2 3)
But it's clumsy to me because the macro state *count* and the macro m itself are in different modules. Is there a better way to do this in r6rs, preferably one that doesn't split the implementation over two modules?
EDIT
I should make it clear that although this example is just a single macro, in reality I'm looking for a method that works when multiple macros need to share state.
You can make the state local to the macro transformer:
(define-syntax m
(let ()
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1)))
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count))))))))
Edited to add: In Racket, you can also do this:
(begin-for-syntax
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1))))
(define-syntax m
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count)))))))
But I don't think R6RS has anything that corresponds to begin-for-syntax.