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.
Related
I want to write a function, which converts from a "normal" notation like this: "1+4*2-8" to this pre-notation: "+1-*428".
I hope you get the point here.
Important: It must be in Strings.
What I get so far:
(define (converter lst )
(let ((operand1 (car lst))
(operator (car (cdr lst)))
(operand2 (caddr lst)))
(list operator
(converter operand1)
(converter operand2)))
)
(infixLst->prefixLst '(1 + 2 * 3))
I got two problems here.
1) It's for Lists, I need it work for Strings like "1+3" and not '(1+3)
2) It doesn't work so far (even not for Lists), because it give me some errors regarding the "car", e.g: car: expects a pair, given 1
Soo starting with the List -> String change: (I know that (list is unappropriate here. As well as the other list-methods but I didnt got a better idea so far.
(define (infix->prefix str)
(let ((operand1 (car str))
(operator (cadr str))
(operand2 (caddr str)))
(list operator
(infix->prefix operand1)
(infix->prefix operand2)))
)
(infix->prefix "1 + 2")
The normal notation 1+4*2-8 is called infix notation.
If you simply need to use that notation, Racket has a ready module: (require infix), here's a link to its documentation.
If you want to practice writing your own infix parser, the shunting-yard algorithm can do that. It uses a stack to keep track of the operators in the math expression.
If you want to parse math from a string, you need to first split the string into a list of tokens (numbers and operators). Start with a math->tokens procedure that simply returns a list of the tokens without caring about their meaning. There are many ways to write it. Here is one:
(define (math->tokens s)
(let collect-tokens ((i 0) (tokens '()))
(if (= i (string-length s))
(reverse tokens)
(let ((char (string-ref s i)))
(if (not (char-numeric? char))
(let ((operator (string->symbol (string char))))
(collect-tokens (+ i 1) (cons operator tokens)))
(let collect-number ((j (+ i 1)))
(if (and (< j (string-length s))
(char-numeric? (string-ref s j)))
(collect-number (+ j 1))
(let ((number (string->number (substring s i j))))
(collect-tokens j (cons number tokens))))))))))
For example, (math->tokens "+1-*428") returns the list of tokens (+ 1 - * 428). Now you can apply the shunting-yard algorithm to that list.
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'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.
|#
A long-run function like infinite loop:
> (define appendInf
(lambda (lst)
(appendInf (cons 1 lst)))
In Chez Scheme, make-engine can achieve the stopping after ticks:
> (define eng
(make-engine
(lambda ()
(appendInf '()))))
While of course with the scope of lst I get error when:
> (eng 50
list
(lambda (new-eng)
(set! eng new-eng)
(length lst)))
Exception: variable lst is not bound
If I want to get the value 'lst' in appendInf when the time limit is reached, I use set!:
> (define lst '())
> (define appendInf
(lambda (ls)
(set! lst (cons 1 ls))
(appendInf lst)))
now I can get:
> (eng 50
list
(lambda (new-eng)
(set! eng new-eng)
(length lst)))
8
So for every variable within the function I want to trace, a global variable needs to be added, and one more transforming by adding (set!…).
is this a correct way to handle any enclosed variables?
if yes to 1, in Scheme is there a better way to achieve this?
is there any programming language that can more easily
implement this kind of debugging?
Well. I'm using racket and it has a pretty good debugger and does standard r6rs as well as non-standard racket.
;; macro to do the heavy work
(define-syntax recdb
(syntax-rules ()
((_ thunk fun a1 ...)
(let ((orig-fun fun)(ethunk thunk))
(fluid-let ((fun (lambda args
(if (ethunk)
(apply orig-fun args) ;; set breakpoint on this
(apply orig-fun args)))))
(fun a1 ...))))))
;; a time-thunk generator
(define (period-sec sec)
(let ((time-done (+ sec (current-seconds))))
(lambda ()
(if (< time-done (current-seconds))
(begin
(set! time-done (+ sec (current-seconds)))
#t)
#f))))
;; a round-thunk generator
(define (rounds n)
(let ((rounds-to-go n))
(lambda ()
(if (zero? rounds-to-go)
(begin
(set! rounds-to-go (- n 1))
#t)
(begin
(set! rounds-to-go (- rounds-to-go 1))
#f)))))
;; my never ending procedure
(define (always n)
(always (+ n 1)))
;; one of the ones below to implement
(recdb (rounds 10) always 0))
(recdb (period-sec 1) always 0)
;; functions with auxillary procedures need to have their gut changed for it to work
(define (fib n)
(define (fib-aux n a b)
(if (= n 0)
a
(fib-aux (- n 1) b (+ a b))))
(recdb (period-sec 2) fib-aux n 0 1))
;; trying it
(fib 200000)
Now. Just run the debugger and set breakpoint (right click expression in the macro and choose "Pause at this point") where it's indicated in the code and you have a way to examine the variables every x seconds or x times.
Happy debugging :)
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.