Test if error occurred in a Guile function - scheme

I'm trying to create a function in Guile which tests if an arbitrary expression threw an error or not, but have hit a wall.
(define (error-or-not qqx)
(if
(catch
#t
(lambda () ,qqx)
(lambda (k . args) #t))
#t
#f))
(display (error-or-not `(/ 1 0))) ; => #t (1)
(newline)
(display (error-or-not `(/ 1 1))) ; => #t (2)
(newline)
qqx is a quasiquoted expression that is evaluated inside the error-or-not function and tested to see if it causes an error.
The Guile manual in effect says that, if evaluating qqx throws an error, the catch function returns the value it gets from calling its third argument (the lambda which takes the arguments). This works fine if qqx actually does cause an error (see above #1).
But the manual also says that if there is no error, the catch function returns the value from evaluating qqx. This is not working out so well for me because I can't distinguish between the two cases (see above #2).
Can someone point out how to definitively tell when an error did not occur?
Update
Chris Jester-Young has pointed out my mistake--see the accepted answer below. For completeness, I'm posting the version of his code I'm using (backported to Guile 1.8.8):
(use-syntax (ice-9 syncase))
(define (stub retval) (lambda args retval))
(define-syntax error-or-not
(syntax-rules ()
((_ expr ...)
(catch #t (lambda () expr ... #f) (stub #t)))))
(display (error-or-not (/ 1 0))) ; => #t
(newline)
(display (error-or-not (/ 1 1))) ; => #f
(newline)

You are misusing quasiquoting; it doesn't do what you expect. In particular, it isn't a substitute for eval. The (lambda () ,qqx) you have creates a function that always fails when called, because unquote cannot be used outside of a quasiquote form.
The best way to implement the functionality you want is as a macro:
(define-syntax-rule (error-or-not expr ...)
(catch #t
(lambda () expr ... #f)
(const #t)))
Example:
(error-or-not (/ 1 0)) ; => #t
(error-or-not (/ 1 1)) ; => #f
Guile 1.8-compatible version:
(use-syntax (ice-9 syncase))
(define-syntax error-or-not
(syntax-rules ()
((_ expr ...)
(catch #t (lambda () expr ... #f)
(lambda _ #t)))))

Related

How to check that a macro parameter is an empty list within syntax-case?

How can I test whether a syntax pattern parameter is an empty list? I am testing in guile.
(define-syntax mkl
(lambda (x)
(syntax-case x ()
[(_ var params code)
(if (null? (syntax->datum #'params)); doesn't match anyway !!!???
#'(lambda (var) code)
#'(lambda (var) (cons 1 code)))])))
;;; try: expecting: (100 200) but got: (1 100 200)
(display
((mkl s '() s) '(100 200)))
(newline)
However, if I test against a number, it works:
(define-syntax mkl2
(lambda (x)
(syntax-case x ()
[(_ var params code)
(if (= (syntax->datum #'params) 0); matches OK
#'(lambda (var) code)
#'(lambda (var) (cons 1 code)))])))
;;; try: expecting: (100 200) and it works OK
(display
((mkl2 s 0 s) '(100 200)))
(newline)
It appears that there's an extra quotation in there. In the macro, you should perform the check like this:
(if (null? (cadr (syntax->datum #'params))) ; access the actual list
Or as a workaround, you could call the macro like this:
((mkl s () s) '(100 200)) ; quote was removed

Macro that unrolls a 'for' loop in racket/scheme?

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 ...))]))

Is there anyway to check if a function return nothing in Scheme?

Is there anyway to check if a function return nothing in Scheme?
For example:
(define (f1)
(if #f #f)
)
or
(define (f2) (values) )
or
(define (f3) (define var 10))
How can I check if f return nothing?
Thanks in advance.
Yes. You can wrap the call in something that makes a list of the values. eg.
(define-syntax values->list
(syntax-rules ()
((_ expression)
(call-with-values (lambda () expression)
(lambda g (apply list g))))))
(apply + 5 4 (values->list (values))) ; ==> 9
(null? (values->list (values))) ; ==> #t
Your procedure f2 does return exactly one value and it's undefined in the report (Scheme standard). That means it can change from call to call and the result of (eq? (display "test1") (display "test2")) is unknown.
Implementations usually choose a singleton value to represent the undefined value, but you can not depend on it. Implementations are free to do anything. eg. I know that in at least one Scheme implementations this happens:
(define test 10)
(+ (display 5) (set! test 15))
; ==> 20 (side effects prints 5, and test bound to 15)
It would be crazy to actually use this, but it's probably useful in the REPL.
In GNU Guile the function for checking this is unspecified?:
(unspecified? (if #f #f)); returns #t
(unspecified? '()); returns #f

understanding call/cc in scheme

Could someone please explain what happens once the continuation is called for this.
((cdr (or (call/cc (lambda (cc) (cons 2 (lambda () (cc #f))))) (cons 3 5))))
((cdr (or (call/cc (lambda (cc) (cons 2 (lambda () (cc #f))))) (cons 3 (lambda() (+ 3 2))))))
The first statement gives error but the second one returns 5. My question is why is call/cc searching for a procedure like the second statement and not output 5 directly.
In ((cdr X)) you will get an error, if X doesn't evaluate to a pair where the cdr is a thunk.
In your first expression, the initial value of X is (cons 2 (lambda () (cc #f))). So everything is fine. However when you invoke the thunk, the expression (cc #f) will return #f to the or, and thus (or #f (cons 3 5)) will evaluate to a pair with a 5 in the cdr. We now have the situation ((cdr (cons 3 5))) which will attempt to apply 5.
In short: (cc #f) will return a value to the context in which (call/cc _) appears. Here returning #f to that context implies that the or-expression will return the pair (cons 3 5) and thus the ((cdr X)) will fail.

How does PLTScheme Catch errors?

I am amazed by the "error" function in PLTScheme.
If I have a division by zero, it doesnt do any other recursion and just comes out of the call stack and give me an error.
Is there an implicit continuation before all the functions? Does the error throw away the call stack? Does anybody have any idea about this?
In PLT Scheme, the procedure error raises the exception exn:fail, which contains an error string. There is no "implicit catch" for all defines. Look at the following sample:
;; test.ss
(define (a d)
(printf "~a~n" (/ 10 d)))
(a 0) ;; The interpreter will exit here.
(printf "OK~n")
Execute the above script from the command line and you will see the interpreter existing after printing something like
/: division by zero
=== context ===
/home/user/test.ss:1:0: a
If an exception is not handled within the user program, it is propagated up to the core interpreter where a default handler deals with it, i.e print the exception and exit. In other words, the interpreter just says, "an exception was raised and I don't know how to deal with it, so I am quiting". This is not much different from how the JVM or some other virtual machine handle exceptions.
To learn more about PLT Scheme's exception handling mechanism, please read about with-handlers and dynamic-wind in the MzScheme Language Manual. Using these, you can even emulate Java's try-catch-finally block.
(define (d a b)
(try
(printf "~a~n" (/ a b))
(catch (lambda (ex)
(printf "Error: ~a" ex)))
(finally
(if (> b -2)
(d a (sub1 b))))))
Here is the syntax extension that made the above possible:
;; try-catch-finally on top of with-handlers and dynamic-wind.
(define-syntax try
(syntax-rules (catch finally)
((_ try-body ... (catch catch-proc))
(with-handlers (((lambda (ex) #t)
(lambda (ex)
(catch-proc ex))))
(begin
try-body ...)))
((_ try-body ... (catch catch-proc) (finally fin-body ...))
(dynamic-wind
(lambda () ())
(lambda ()
(with-handlers (((lambda (ex) #t)
(lambda (ex)
(catch-proc ex))))
(begin
try-body ...)))
(lambda () fin-body ...)))
((_ try-body ... (finally fin-body ...))
(dynamic-wind
(lambda () ())
(lambda () try-body ...)
(lambda () fin-body ...)))))

Resources