Using dot notation in Racket class functions - macros

I have following class which works fine:
(define myob%
(class object%
(super-new)
(init-field val)
(define/public (getval) val)
(define/public (setval v) (set! val v)) ))
(define ob1 (make-object myob% 5))
(send ob1 getval)
(send ob1 setval 10)
(send ob1 getval)
Output:
5
10
Following regex also works well:
(define sl (regexp-match #px"^(.+)[.]([^.]+)$" "ob1.getval"))
sl
Output:
'("ob1.getval" "ob1" "getval")
I am trying to make a fn foo which should work like 'send' but take arguments in form of (foo ob1.getval) or (foo ob1.setval 10) . Following macro is not working:
(define-syntax foo
(syntax-rules ()
((_ sstr ...)
(define sl (regexp-match #px"^(.+)[.]([^.]+)$"
(symbol->string sstr)))
(send (string->symbol(list-ref sl 1))
(string->symbol(list-ref sl 2))
...))))
(foo ob1.getval)
The error is:
syntax-rules: bad syntax in: (syntax-rules () ((_ sstr ...) (define sl (regexp-match #px"^(.+)[.]([^.]+)$" (symbol->string sstr))) (send (list-ref sl 1) (list-ref sl 2) ...)))
Where is the error and how can this be corrected?

To use dot notation like this, you'll need to define a new #lang language, with its own reader. There are several tools to help with this, and I'll be using one of them, syntax/module-reader, to define #lang send-dot, which once defined can be used like this:
#lang send-dot
(define o
(new (class object% (super-new)
(define/public (f x) x))))
(o.f "hellooo")
In the latest snapshot version of Racket, you can use the read-cdot option. Make sure you're on the latest snapshot version, since in 6.6, it's completely broken.
One way to define a #lang is by declaring a reader submodule. Make a directory called send-dot, and add a file called main.rkt. This file should provide everything from racket.
#lang racket
(provide (all-from-out racket))
This doesn't define a #lang yet. But to try it out, you can go to DrRacket's File menu, click on Package Manager, and in the Package Source field, enter the path to the send-dot directory. Once you do that, you should be able to use #lang s-exp send-dot in another file just like you would #lang racket.
To define a reader for this language and make it a real #lang language, you can add a reader submodule that uses syntax/module-reader as its language.
#lang racket
(provide (all-from-out racket))
;; This submodule defines the reader for the language
(module reader syntax/module-reader
send-dot)
Now you should be able to use #lang send-dot just like #lang racket.
Now you need to do two more things. One, turn on the read-cdot option so that (o.method args ...) is translated to ((#%dot o method) args ...), and Two, define a #%dot macro so that ((#%dot o method) args ...) is equivalent to (send o method args ...).
For the first thing, you can use the #:wrapper1 option, using parameterize to turn read-cdot on.
#lang racket
(provide (all-from-out racket))
;; This submodule defines the reader for the language
(module reader syntax/module-reader
send-dot
#:wrapper1 (lambda (thunk)
;; turns on the read-cdot option,
;; which will turn o.method into (#%dot o method),
;; and (o.method args ...) into ((#%dot o method) args ...)
(parameterize ([read-cdot #true])
(thunk))))
For the second thing, you need to define a #%dot macro. o.method, or (#%dot o method), needs to be a function that calls the method, so you can use (lambda args (send/apply o method args)).
#lang racket
(provide #%dot (all-from-out racket))
;; transforms (#%dot o method) into a function that calls the method
;; so that ((#%dot o method) args ...) will be roughly equivalent to
;; (send o method args ...)
(define-syntax-rule (#%dot obj-expr method-id)
(let ([obj obj-expr])
(lambda args (send/apply obj method-id args))))
;; This submodule defines the reader for the language
(module reader syntax/module-reader
send-dot
#:wrapper1 (lambda (thunk)
;; turns on the read-cdot option,
;; which will turn o.method into (#%dot o method),
;; and (o.method args ...) into ((#%dot o method) args ...)
(parameterize ([read-cdot #true])
(thunk))))
Now you should be able to use #lang send-dot like this:
#lang send-dot
(define o
(new (class object% (super-new)
(define/public (f x) x))))
(o.f "hellooo")

Related

How to tell `make-module-evaluator` to use a custom reader like #lang does?

I'm trying to execute a custom made #lang on a given string (not in a file). Let's call it broccoli.
Setup
My lang is defined as so:
broccoli/main.rkt
(module reader racket/base
(require broccoli/private/reader)
(provide read read-syntax)) ; basically a reprovide
broccoli/private/reader.rkt
(provide
(rename-out
[my-read read]
[my-read-syntax read-syntax]))
(define (my-read in)
(syntax->datum
(my-read-syntax #f in)))
(define (my-read-syntax src in)
(with-syntax ([parse-tree (parse src (make-tokenizer in src))]) ; brag stuff
(strip-context
#'(module program broccoli/private/expander
parse-tree))))
broccoli/private/expander.rkt
(provide
(rename-out [module-begin #%module-begin]))
(define-syntax-rule (module-begin expr)
(#%module-begin
(provide meal)
(define meal (transform 'expr)))) ; some kind of computation
It works fairly well used the classic way :
#lang broccoli
Hello world!
will produce:
(module program broccoli/private/expander
(program
(sentence (word "Hello") (word "world"))))
which will then expand into:
(provide meal)
(define meal (list 42 38)) ; the result is for the sake of the example, don't mind it
But I'm trying to apply it to an arbitrary string I get from a network request, and send back the result.
And this time, it gets more complicated.
Here's what I tried:
Try #1
(define text "Hello world!")
(define evaluator (make-evaluator 'broccoli text)) ; Error: no #%module-begin found
(evaluator 'meal)
Try #2
(define text "Hello world!")
(define module (broccoli-read-syntax #f (open-input-string text)))
(define evaluator (make-module-evaluator #:language 'broccoli/private/expander module))
(evaluator 'meal) ; Error: meal undefined
Try #3
(define text "Hello world!")
(define evaluator (make-module-evaluator (string-append "#lang broccoli " text)))
(evaluator 'meal) ; Error: meal undefined
Try #4 (it works but it's not what I want)
(define text "Hello world!")
(define module (broccoli-read-syntax #f (open-input-string text)))
(define ns (make-base-namespace))
(eval module ns)
(namespace-require ''program ns)
(define result (eval 'meal ns))
This last result works correctly, but it doesn't use a sandbox, and uses eval directly.
I'm sure there's a better way, but I don't get what's going wrong.
I was sooo close!
I had to require the generated module inside the evaluator (which implies providing #%app, #%top, #%top-interaction, require and quote from the expander).
(define evaluator (make-module-evaluator (string-append "#lang broccoli\n" text)))
(evaluator '(require 'program)) ; missing step
(evaluator 'meal)
What I find weird in this solution is that it doesn't behave the same way the documentation says:
> (define base-module-eval
(make-module-evaluator '(module m racket/base
(define (f) later)
(define later 5))))
> (base-module-eval 'later)
5
I suggest using read-lang-module to turn the string into a syntax object representing a module. And then use make-module-evaluator.

Macro calling macro gives "undefined variable" in Gambit Scheme

In Gambit Scheme, I can't seem to invoke a macro in the definition of another macro if I compile the file. Here is a contrived example:
;;;; example.scm
(define-macro (w/gensyms gs body)
`(let ,(map (lambda (g) `(,g (gensym ',g)))
gs)
,body))
(define-macro (compose-macro f g)
(w/gensyms (x)
`(lambda (,x) (,f (,g ,x)))))
(define my-cadr
(lambda (x)
((compose-macro car cdr) x)))
;; $ gsc example.scm
;; *** ERROR IN #<procedure #2> -- Unbound variable: w/gensyms
However, if I load the file with the (include ...) special form in the interpreter, it works
$ gsi
> (include "example.scm")
> (pp my-cadr)
(lambda (x) ((lambda (#:x0) (car (cdr #:x0))) x))
Does anyone know what is going on here? Can I convince Gambit to let me use w/gensyms in the definition of another macro in a compiled file?
This is most likely related to phases.
Try this:
Put w/gensyms in a file a.scm and put compose-macro in a file b.scm that imports a.scm.
This is a phasing problem. You want the definition of w/gensyms to be available in the body of subsequent macros. This can be achieved with a for-syntax macro that forces the evaluation of the macro definition at syntax expansion time:
(define-macro (for-syntax . body)
(eval `(begin ,#body))
`(begin))
(for-syntax
(define-macro (w/gensyms gs body)
`(let ,(map (lambda (g) `(,g (gensym ',g)))
gs)
,body)))
If you want the macro to be available both from within other macro definitions and within non-macro definition code you can use this instead:
(define-macro (for-syntax . body)
(eval `(begin ,#body))
`(begin ,#body))
For this specific example, since you are using the macro at a single place, you could have done this:
(define-macro (compose-macro f g)
(define-macro (w/gensyms gs body)
`(let ,(map (lambda (g) `(,g (gensym ',g)))
gs)
,body))
(w/gensyms (x)
`(lambda (,x) (,f (,g ,x)))))
A related approach to address phasing issues is to put the definition of w/gensyms and other macros in the file "macros.scm" and do:
(define-macro (compose-macro f g)
(include "macros.scm")
(w/gensyms (x)
`(lambda (,x) (,f (,g ,x)))))

Creating a readtable with a disabled dispatch reader macro

I am creating a new language based on Racket and I don't want certain #x macros to work, such as the syntax-quote #'. How do I remove it so that #' does not do a syntax quote, but does whatever an unbound dispatch macro-char does?
I can do that with single-char macros by doing
(make-readtable (current-readtable)
#\' #\a #f) ; set ' to be the same as a normal character
but I don't know how to do this for dispatch macros.
Assuming you want #' to be treated as ':
Provide a reader-proc that simply calls the normal read-syntax:
#lang racket/base
(define (reader-proc ch in src line col pos)
(read-syntax src in))
(define our-readtable (make-readtable (current-readtable)
#\'
'dispatch-macro
reader-proc))
;; A `#:wrapper1` for `syntax/module-reader`, i.e. to use in your
;; lang/reader.rkt
(define (wrapper1 thk)
(parameterize ([current-readtable our-readtable])
(thk)))
(provide wrapper1)
;; tests
(module+ test
(require rackunit
racket/port)
(parameterize ([current-readtable our-readtable])
(check-equal? (with-input-from-string "#'foo" read)
'foo)
(check-equal? (with-input-from-string "#'(foo)" read)
'(foo))
(check-equal? (with-input-from-string "#'(foo #'(bar))" read)
'(foo (bar)))))
A slightly more complicated example of working with 'dispatch-macro is the lambda reader literal support I just recently added to #lang rackjure.
UPDATED
Assuming you want #' to cause a read error, "bad syntax: #'":
#lang racket/base
(require syntax/readerr)
(define (reader-proc ch in src line col pos)
(raise-read-error (format "bad syntax: #~a" ch)
src line col pos 2))
(define our-readtable (make-readtable (current-readtable)
#\'
'dispatch-macro
reader-proc))
;; A `#:wrapper1` for `syntax/module-reader`, i.e. to use in your
;; lang/reader.rkt
(define (wrapper1 thk)
(parameterize ([current-readtable our-readtable])
(thk)))
(provide wrapper1)
;; tests
(module+ test
(require rackunit
racket/port)
(parameterize ([current-readtable our-readtable])
(check-exn exn:fail? (λ () (with-input-from-string "#'foo" read)))))

How to transform this function into macro?

I have difficulties understanding the new macro system of Scheme. Somewhere along the path I began to write my "macro" as a function first, and then later apply it as a macro.
So my mission is to turn the following structure:
;; highlight-rules: rule id, color and the regexp matches
(define highlight-rules
`((important ,(with-esc "[1;33m") ("foo"
"bob"))
(unimportant ,(with-esc "[1;30m") ("case of unimport"))
(urgent ,(with-esc "[1;31m") ("urgents"))))
Into this kind of cond series with match strings compiled to regexpes:
;; just an example. `line` is an argument bound by the function application
(cond
((string-match (regexp ".*sudo:session.*") line)
(with-color *important* line))
(else line))
I have written a function that seems to do the trick:
;; (cdar highlight-rules) -> (colorstring list-of-rules)
(define (parse-highlight-rules rules)
;; aux function to do one 'class' of patterns
(define (class-of-rules colorstr rulelist)
(map (lambda (rule)
`((string-match ,(regexp rule)) (with-color ,colorstr line)))
rulelist))
(define (do-loop accumulator rules)
(let* ((highlight-group (cdar rules))
(colorstr (car highlight-group))
(grouprules (cadr highlight-group))
(acc* (append (class-of-rules colorstr grouprules) accumulator))
(rest (cdr rules)))
(if (null? rest)
acc*
(do-loop acc* rest))))
; wrap the list in cond.
`(apply cond ,(do-loop '() rules)))
With given highlight-rules the function returns correct-looking list (well apart from applying the apply -- in clojure one would use splicing):
CSI> (parse-highlight-rules highlight-rules)
(apply cond (((string-match #<regexp>) (with-color "\x1b[1;31m" line))
((string-match #<regexp>) (with-color "\x1b[1;30m" line))
((string-match #<regexp>) (with-color #0="\x1b[1;33m" line))
((string-match #<regexp>) (with-color #0# line))))
But how to proceed with this? I've been stuck with this for a while. Chicken Scheme is my dialect.
The easiest way of transforming your function into a macro is by using Chicken's explicit-renaming macro facility, which works similarly to Clojure's defmacro (except that an explicit-renaming macro takes some additional arguments that can be used to preserve hygiene).
Splicing works basically the same way as it does in Clojure. The syntax is ,#. Therefore, the following should work:
(define-for-syntax (parse-highlight-rules rules)
;; ... insert missing code here ...
`(cond ,#(do-loop '() rules)))
(define-syntax highlight
(er-macro-transformer
(lambda (form rename compare)
(parse-highlight-rules (cdr form)))))

How do I define functions using Racket macros?

I am trying to write a macro that defines a special class of data structure with associated functions.
I know this is possible; it is done multiple times in the core language itself.
As a specific example, how would I define the define-struct macro in Scheme itself. It needs to create make-struct, struct-<<field>>, etc functions.
I tried doing this using define, however, this only defines the function in the macro's lexical scope.
How can I actually define a function in a macro?
The key for an answer is datum->syntax. The basic idea is that you want to take some random data and turn it into a syntax -- in this case, turn a symbol into an identifier. An identifier is basically a symbol with some lexical information that (very roughly) indicates how it is bound. Using datum->syntax you can do exactly that: it expects an existing piece of syntax which is where it copies the binding from, and a datum (a symbol here) which is the value that is contained in the syntax wrapper.
Here's an example that demonstrates a define-struct-like tool using this:
#lang scheme
;; implements a defstruct-like macro that uses association lists
(define-syntax (defstruct-lite stx)
(syntax-case stx ()
[(defstruct-lite name field ...)
(let ([make-id
(lambda (template . ids)
(let ([str (apply format template (map syntax->datum ids))])
(datum->syntax stx (string->symbol str))))])
(with-syntax ([make-name (make-id "make-~a" #'name)]
[name? (make-id "~a?" #'name)]
[(arg ...) (generate-temporaries #'(field ...))]
[(name-field ...)
(map (lambda (f) (make-id "~a-~a" #'name f))
(syntax->list #'(field ...)))])
#'(begin
(define (make-name arg ...) (list 'name (cons 'field arg) ...))
(define (name? x) (and (pair? x) (eq? 'name (car x))))
(define (name-field x)
(and (name? x) (cdr (assq 'field (cdr x)))))
...)))]))
And here's an example of using it:
(defstruct-lite point x y)
(point-y (make-point 1 2))