Introduction
One of the things I like about arc is that it has a little of syntax, which helps shorten the length of the programs. In particular, ~ indicates the negated version of a function.
For example:
(equal? 1 1) ; ==> #t (~equal? 1 1) ; ==> #f (equal? 1 2) ; ==> #f (~equal? 1 2) ; ==> #t
Creating a readtable for ~
Let's start by creating the readtable, which is the part that has the more specific code in this example. Let's put all these files in a directory called neg.
File: neg/main.rkt (version 1)
#lang racket/base
(provide (rename-out (neg-read read) (neg-read-syntax read-syntax)))
{define (neg-read in)
(parameterize ([current-readtable (make-neg-readtable)])
(read in))}
{define (neg-read-syntax src in)
(parameterize ([current-readtable (make-neg-readtable)])
(read-syntax src in))}
{define (make-neg-readtable)
(make-readtable (current-readtable)
#\~ 'non-terminating-macro neg-parse)}
{define neg-parse
(case-lambda
[(ch port) ; for read
(let ([next (read/recursive port #f)])
`(negate ,next))]
[(ch port src line col pos) ; for read-syntax
(let ([next (read-syntax/recursive src port #f)])
(datum->syntax
#f
`(negate ,next)
(let-values ([(l c p) (port-next-location port)])
(list src line col pos (and pos (- p pos))))))])}
We can test this using #reader. The downside of using #reader is that it only reads one expression, so we have to enclose everything in a begin. Also negate is not defined in racket/base, so we have to remember to import it from racket/function.
File: neg/test1.rkt
#lang racket/base
(require (only-in racket/function negate))
#reader "main.rkt"
[begin
(equal? 1 1) ; ==> #t
(~equal? 1 1) ; ==> #f
(equal? 1 2) ; ==> #f
(~equal? 1 2) ; ==> #t
({lambda (x) (equal? x 0)} 0) ; ==> #t
(~{lambda (x) (equal? x 0)} 0) ; ==> #f
({lambda (x) (equal? x 0)} 1) ; ==> #f
(~{lambda (x) (equal? x 0)} 1) ; ==> #t
]
The name of ~equal?
The problem is that the function created by ~equal? doesn’t have a nice name.
File: neg/test2.rkt
#lang racket/base (require racket/function) #reader "main.rkt" [begin (displayln equal?) ; ==> #(displayln ~equal?) ; ==> #<...ket function.rkt:36:11=""> :( equal? ; ==> # ~equal? ; ==> #<...ket function.rkt:36:11=""> :( ]</...ket> </...ket>
It could be fixed using procedure-rename, but instead of that we will create a function using lambda directly and choose the name using the 'inferred-name property. This version has its advantages and disadvantages because it fixes the name problem, but does not work with keyword arguments and it is not optimized for functions with 1 or 2 arguments. It is possible to make a version that fixes all the details, but is against the goal that ~ produce only a simple transformation.
File: neg/main.rkt (versión 2)
#lang racket/base
(provide neg-read neg-read-syntax make-neg-readtable
(rename-out [neg-read read]
[neg-read-syntax read-syntax]))
{define (neg-read in)
(parameterize ([current-readtable (make-neg-readtable)])
(read in))}
{define (neg-read-syntax src in)
(parameterize ([current-readtable (make-neg-readtable)])
(read-syntax src in))}
{define (make-neg-readtable)
(make-readtable (current-readtable)
#\~ 'non-terminating-macro neg-parse)}
{define neg-parse
(case-lambda
[(ch port)
(let ([next (read/recursive port #f)])
`(#%expression {lambda args (not (apply ,next args))}))]
[(ch port src line col pos)
(let ([next (read-syntax/recursive src port #f)])
(let ([stx (datum->syntax
#f
`(#%expression {lambda args (not (apply ,next args))})
(let-values ([(l c p) (port-next-location port)])
(list src line col pos (and pos (- p pos)))))])
(if (identifier? next)
(syntax-property stx
'inferred-name
(string->symbol (string-append (list->string (list ch)) (symbol->string (syntax-e next)))))
stx)))])}
Why ~equal? is not equal? to ~equal? ?
Another detail is that each time that ~equal? runs, it creates a new function, so they are all different. I would like that all the functions are really one, because the expression (equal? ~equal? ~equal?) looks like a #t, but so far all the solutions I came up are too long and destroy Racket optimizer.
File: neg/test3.rkt
#lang racket/base (require (only-in racket/function negate)) #reader "main.rkt" [begin (equal? equal? equal?) ; ==> #t (equal? ~equal? ~equal?) ; ==> #f :( (let ([tmp equal?]) (equal? tmp tmp)) ; ==> #t (let ([tmp ~equal?]) (equal? tmp tmp)) ; ==> #t ]
Extending a language with neg/neg-exp
To use this extension a simple way, we will create a language neg/neg-exp that adds ~ to any language. To define this language, the first step is to create the correct directory structure and register it as a collection. For this step it is important that the directory where these files are located is named (for example) neg. To register the collection, we must go to the directory containing the directory neg and run the command raco link neg. This directory must contain the file neg/main.rkt. In this directory you must create the necessary subdirectories to finally create the file neg/neg-exp/lang/reader.rkt.
File: neg/neg-exp/lang/reader.rkt
#lang racket/base
(require syntax/module-reader
(only-in neg make-neg-readtable))
(provide (rename-out [neg-read read]
[neg-read-syntax read-syntax]
[neg-get-info get-info]))
(require (only-in racket/function negate))
(provide negate)
{define (wrap-reader p)
(lambda args
(parameterize ([current-readtable (make-neg-readtable)])
(apply p args)))}
{define-values (neg-read neg-read-syntax neg-get-info)
(make-meta-reader
'neg-exp
"language path"
{lambda (str)
(let ([s (string->symbol
(string-append (bytes->string/latin-1 str)
"/lang/reader"))])
(and (module-path? s) s))}
wrap-reader
wrap-reader
{lambda (proc)
{lambda (key defval)
(case key
#;[(color-lexer)
(dynamic-require 'syntax-color/scheme-lexer 'scheme-lexer)]
[else (if proc (proc key defval) defval)])}})}
Now we can use this with any language, for example racket or racket/base. The good news is you do not need enclose the entire program in one begin. Moreover, with neg registered as a collection, this extension can be called from any file, no matter the relative position of the directories in which they are located.
File: neg/test4.rkt
#lang neg/neg-exp racket/base
(require (only-in racket/function negate))
(equal? 1 1) ; ==> #t
(~equal? 1 1) ; ==> #f
(equal? 1 2) ; ==> #f
(~equal? 1 2) ; ==> #t
({lambda (x) (equal? x 0)} 0) ; ==> #t
(~{lambda (x) (equal? x 0)} 0) ; ==> #f
({lambda (x) (equal? x 0)} 1) ; ==> #f
(~{lambda (x) (equal? x 0)} 1) ; ==> #t
Languages neg/neg and racket/racket/base
The two languages that we most likely want to use extended with ~ are racket and racket/base, so it is worth creating the combinations as independent languages. Let's see how to do this for neg/racket/base. For that we must create the correct subdirectory structure and two files.First we create the file that defines the language. It is the same that racket/base, but if we add negate just in case it is needed and we will use the functions read and read-syntax from neg, no the original of racket/base.
File: neg/racket/base.rkt
#lang racket/base
(require "../main.rkt")
(require (only-in racket/function negate))
(provide (all-from-out racket/base)
read read-syntax negate)
File: neg/racket/base/lang/reader.rkt
#lang s-exp syntax/module-reader neg/racket/base #:read read #:read-syntax read-syntax #:language-info '#(racket/language-info get-info #f) (require neg)
File: neg/test5.rkt
#lang neg/racket/base
(equal? 1 1) ; ==> #t
(~equal? 1 1) ; ==> #f
(equal? 1 2) ; ==> #f
(~equal? 1 2) ; ==> #t
({lambda (x) (equal? x 0)} 0) ; ==> #t
(~{lambda (x) (equal? x 0)} 0) ; ==> #f
({lambda (x) (equal? x 0)} 1) ; ==> #f
(~{lambda (x) (equal? x 0)} 1) ; ==> #t
The same process can be used to create neg/racket, making the obvious changes.
