I'm trying to write a macro to generate Church encodings I have this so far
#lang racket
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
(let ((_ctrs (map car '((ctr) ...)))
(_args '((args ...) ...)))
(map
(lambda (i)
(let ((_ctr (list-ref _ctrs i))
(_args (list-ref _args i)))
`(define (,_ctr ,#_args) (lambda (,#_ctrs) (,_ctr ,#_args)))))
(range 0 (length _ctrs))))
]
))
(pretty-print (data option (some x) (none))
Which outputs
(data option (some x) (none))
=> ((define (some x) (lambda (some none) (some x)))
(define (none) (lambda (some none) (none))))
The output is good, but the defines are not being executed.
Now I want to execute these defines so that the functions are defined at top level
I tried this
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
`(let ((_ctrs (map car '((ctr) ...)))
(_args '((args ...) ...)))
,#(map
(lambda (i)
(let ((_ctr (list-ref _ctrs i))
(_args (list-ref _args i)))
(define (,_ctr ,#_args) (lambda (,#_ctrs) (,_ctr ,#_args)))))
(range 0 (length _ctrs))))
]
))
But I get this error
(data option (some x) (none))
Error: struct:exn:fail:syntax
begin (possibly implicit): the last form is not an expression
at: (define ((unquote _ctr) (unquote-splicing _args)) (lambda ((unquote-splicing _ctrs)) ((unquote _ctr) (unquote-splicing _args))))
in: (begin (define ((unquote _ctr) (unquote-splicing _args)) (lambda ((unquote-splicing _ctrs)) ((unquote _ctr) (unquote-splicing _args)))))
I tried (expand #'(data option (some x) (none))) to debug but got the same error. I'm new to Racket, any advice on the macro debugging flow is welcome!!
---- Update
I have this macro now, it seems closer to what I need
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
#'((define (ctr) (lambda (ctr ...) (ctr args ...))) ...)
]
))
But still if I remove the #' I get
define: not allowed in an expression context
in: (define (some) (lambda (some none) (some x)))
Okay I got it, I need a (begin here how I did it
(define-syntax data
(syntax-rules ()
[(data _ (ctr args ...) ...)
(begin
(define (ctr args ...) (lambda (ctr ...) (ctr args ...)))
...
)
]
))
(data option (some x) (none))
((some 1)
(lambda (x) (format "is some ~a" x))
(lambda () "is none")) ;; "is some 1"
Related
I am currently porting Alex Shinn's canonical implementation of match for Scheme, which is used by almost all Scheme implementations, to another Lisp.
I've run into a total wall with match-letrec. In the simplified version of his implementation, it's defined as follows:
(define-syntax match-let
(syntax-rules ()
((_ ((pat expr)) . body)
(match expr (pat . body)))
((_ ((pat expr) ...) . body)
(match (list expr ...) ((pat ...) . body)))
((_ loop . rest)
(match-named-let loop () . rest))
))
(define-syntax match-letrec
(syntax-rules ()
((_ vars . body) (match-letrec-helper () vars . body))))
(define-syntax match-letrec-helper
(syntax-rules ()
((_ ((pat expr var) ...) () . body)
(letrec ((var expr) ...)
(match-let ((pat var) ...)
. body)))
((_ (v ...) ((pat expr) . rest) . body)
(match-letrec-helper (v ... (pat expr tmp)) rest . body))
))
Here's an example of how it looks when in use (Guile 1.8):
(match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b))
=> (2 1 1 2)
I'm having great difficulty understanding how this actually works. When I expand this by hand as far as match, I get the following code (with automatic symbols indicated by #{g...}):
(letrec ((#{g1} (list 1 (lambda () (list a x))))
(#{g2} (list 2 (lambda () (list x a)))))
(match (list #{g1} #{g2}) (((x y) (a b)) (append (y) (b))))
The automatic symbols are generated by the tmp substitution in the second rule of match-letrec-helper. This expansion means that the lambda expressions are evaluated before x and a are bound, and therefore cannot capture them.
Can someone please explain how this syntax is supposed to be correctly expanded? What have I missed?
Your example
(match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b))
=> (2 1 1 2)
is missing a close bracket.
After fixing that here's what happens:
> (match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b)))
. match: syntax error in pattern in: ((x y) (a b))
Even match-let is not working
> (match-let (((x y) (list 1 2)))
x)
. match: syntax error in pattern in: (x y)
here's how to fix it:
(define-syntax match-let
(syntax-rules (list)
((_ ((pat expr)) . body)
(match expr (pat . body)))
((_ ((pat expr) ...) . body)
(match (list expr ...) ((pat ...) . body)))
((_ loop . rest)
(match-named-let loop () . rest))
))
now you can do this:
> (match-let (((list x y) (list 1 2)))
(list x y))
'(1 2)
letrec is still not working
> (match-letrec (((list x y) (list 1 (lambda () (list a x))))
((list a b) (list 2 (lambda () (list x a)))))
(append (y) (b)))
. match: syntax error in pattern in: ((list x y) (list a b))
but this should get you a step closer, feel free to ask a new question with working code example once you understand these changes.
Say I have a macro like this:
(define-syntax (choose stx)
(define data (syntax->datum stx))
(define args (cadr data))
(define body (cddr data))
(define output
`(apply (case (car ,args)
,(map (lambda (choice)
`((,(car choice)) ,(cadr choice)))
body)
(else (displayln "error")))
(cdr ,args)))
(println output)
#'(void))
If I use this on something like this (there could be more options):
(choose args
("run" runsomething)
("del" delsomethingelse))
It transforms it to
(apply
(case (car args)
((("run") runsomething)
(("del") delsomethingelse))
(else (displayln "error")))
(cdr args))
Which is not valid code, because the map gave it extra parentheses. Instead I want it to give me this:
(apply
(case (car args)
(("run") runsomething)
(("del") delsomethingelse)
(else (displayln "error")))
(cdr args))
How could I do something like this?
Use unquote-splicing (aka ,#) to get rid of the list surrounding map.
Example:
(define xs '(a b c))
`(1 2 ,xs 3 4) ; => '(1 2 (a b c) 3 4)
`(1 2 ,#xs 3 4) ; => '(1 2 a b c 3 4)
However I notice that you use syntax->datum on the input stx
of the syntax transformer. That removes lexical information, which
could end up causing problems. It recommend using either syntax-case
or syntax-parse, which use pattern matching to pick out the elements
of the input syntax and templates to generate the output.
(define-syntax (choose stx)
(syntax-case stx ()
[(_choose args
(datum fun-expr)
...)
#'(apply (case (car args)
[(datum) fun-expr]
...)
(cdr args))]))
(define (run-it . xs) (list 'ran-it xs))
(define (del-it . xs) (list 'delt-it xs))
(choose (list "run" 1 2 3)
("run" run-it)
("del" del-it))
Output: '(ran-it (1 2 3))
I'm trying to write a define-let macro in racket, which "saves" the header of a (let ((var value) ...) ...) , namely just the (var value) ... part, and allows re-using it later on.
The code below works as expected:
#lang racket
;; define-let allows saving the header part of a let, and re-use it later
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var value] ...)
#`(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
#`(let ([#,(datum->syntax stx2 'var) value] ...)
. body)]))]))
;; Save the header (let ([x "works]) ...) in the macro foo
(define-let foo [x "works"])
;; Use the header, should have the same semantics as:
;; (let ([x "BAD"])
;; (let ([x "works])
;; (displayln x))
(let ([x "BAD"])
(foo (displayln x))) ;; Displays "works".
The problem is that the macro breaks hygiene: as shown in the example below, the variable y, declared in a define-let which is produced by a macro, should be a new, uninterned symbol, due to hygiene, but it manages to leak out of the macro, and it is erroneously accessible in (displayln y).
;; In the following macro, hygiene should make y unavailable
(define-syntax (hygiene-test stx)
(syntax-case stx ()
[(_ name val)
#'(define-let name [y val])]))
;; Therefore, the y in the above macro shouldn't bind the y in (displayln y).
(hygiene-test bar "wrong")
(let ((y "okay"))
(bar (displayln y))) ;; But it displays "wrong".
How can I write the define-let macro so that it behaves like in the first example, but also preserves hygiene when the identifier is generated by a macro, giving "okay" in the second example?
Following the cue "syntax-parameter" from Chris, here is an one solution:
#lang racket
(require racket/stxparam
(for-syntax syntax/strip-context))
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var expr] ...)
(with-syntax ([(value ...) (generate-temporaries #'(expr ...))])
#`(begin
(define-syntax-parameter var (syntax-rules ()))
...
(define value expr)
...
(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
(with-syntax ([body (replace-context #'stx1 #'body)])
#'(syntax-parameterize ([var (syntax-id-rules () [_ value])] ...)
. body))]))))]))
(define-let foo [x "works"])
(let ([x "BAD"])
(foo (displayln x))) ; => works
(let ([x "BAD"])
(foo
(let ([x "still works"])
(displayln x)))) ; => still works
UPDATE
This solution passes the additional test in the comments.
The new solution transfers the context of the body to
the variables to be bound.
#lang racket
(require (for-syntax syntax/strip-context))
(define-syntax (define-let stx1)
(syntax-case stx1 ()
[(_ name [var expr] ...)
#`(begin
(define-syntax (name stx2)
(syntax-case stx2 ()
[(_ . body)
(with-syntax ([(var ...) (map (λ (v) (replace-context #'body v))
(syntax->list #'(var ...)))])
#'(let ([var expr] ...)
. body))])))]))
(define-let foo [x "works"])
(let ([x "BAD"])
(foo (displayln x))) ; => works
(let ([x "BAD"])
(foo
(let ([x "still works"])
(displayln x)))) ; => still works
(let ([z "cool"])
(foo (displayln z))) ; => cool
I am writing a simple lisp interpreter as I read Lisp in Small Pieces, but I am stuck on this error for over 2 hours now. I am defining a local genv variable but still I get this error. There must be some macro expansion thing I can't understand, I have checked the expansion using a quote, and it seems to be OK. Please if someone can shed some light it would be great. (The code works with r5rs language and guile scheme)
;; Macro to print it's given arguments line by line and end with a ------
(define-syntax println
(syntax-rules ()
((_ expr expr* ...) (begin (display expr)
(newline)
(println expr* ...)))
((_ expr) (begin (display expr) (newline)))
((_) (display "--------\n"))))
(define (evaluate expr env)
(begin (println "Evaluating" expr)
(if (not (pair? expr))
(cond ((symbol? expr) (lookup env expr))
((or (number? expr) (string? expr) (char? expr) (boolean? expr) (vector? expr)) expr)
(else (error "Cannot evaluate" expr)))
;; not atom
(case (car expr)
((quote) (cadr expr))
;; (define name expr)
((define) (update (cadr expr) (caddr expr) env))
((if) (if (evaluate (cadr expr) env)
(evaluate (caddr expr) env)
(evaluate (cadddr expr) env)))
((begin) (eprogn (cdr expr) env))
((set!) (update (cadr expr) (evaluate (caddr expr) env) env))
((lambda) (make-function (cadr expr) (cddr expr) env))
(else (invoke (evaluate (car expr) env)
(evlis (cdr expr) env)))))))
;; Evaluates all the expressions (exprs) in the given environment (env)
(define (eprogn exprs env)
(if (pair? exprs)
;; False when exprs contains just one item
(if (pair? (cdr exprs))
(begin (evaluate (car exprs) env)
(eprogn (cdr exprs) env))
(evaluate (car exprs) env))
'()))
(define (evlis exprs env)
(if (pair? exprs)
(cons (evaluate (car exprs) env)
(evlis (cdr exprs) env))
'()))
;; Makes a new applicable function, that closes the environment (env)
(define (make-function vars body env)
(lambda (vals)
(eprogn body (extend-environment env vars vals))))
(define (invoke fn args)
(if (procedure? fn)
(fn args)
(error "Not a function" fn)))
;; Environment suite
;; Helper macros for working with an environment vector
;; Returns the parent environment of (env)
(define-syntax parent-env-of
(syntax-rules ()
((parent-env-of env) (vector-ref env 0))))
;; Returns the bind-map of (env)
(define-syntax bind-map-of
(syntax-rules ()
((bind-map-of env) (vector-ref env 1))))
;; Sets the parent environment of (env)
(define-syntax set-parent-env!
(syntax-rules ()
((set-parent-env! env parent-env) (vector-set! env 0 parent-env))))
;; Sets the bind-map of (env)
(define-syntax set-bind-map!
(syntax-rules ()
((set-bind-map! env bind-map) (vector-set! env 1 bind-map))))
;; Makes a new environment with the parent env set to (parent-env)
(define (make-new-environment parent-env)
(let ((new-env (vector #f #f)))
(begin
(set-parent-env! new-env parent-env)
(set-bind-map! new-env '())
new-env)))
;; Searches for the value of (sym) in (env), raises
;; error if it can't find
(define (lookup env sym)
(if (null? env)
(error "Unbound name" sym)
(let ((val (assoc sym (bind-map-of env))))
(if (equal? val #f) (lookup (parent-env-of env) sym) (cdr val)))))
;; Create the binding update the (sym)'s value to (value) in the given (env)
(define (update sym value env)
(begin (println "Called update with env: " env "sym: " sym "value: " value)
(define new-bind-map (assoc-set! (bind-map-of env) sym value))
(set-bind-map! env new-bind-map)))
;; Extends an (env) by creating a new environment and setting the
;; bindings specified by the list of symbols (vars) and the
;; list of values (vals)
(define (extend-environment vars vals env)
(define new-env (make-new-environment env))
(update-all vars vals env))
;; Helper function
(define (update-all vars vals env)
(cond ((pair? vars) (if (not (pair? vals))
(error "More symbols than values to bind with")
(begin (update (car vars) (car vals) env)
(extend (cdr vars) (cdr vals) env))))
((null? vars) (if (not (null? vals))
(error "More values than symbols to bind with")
env))))
;; Helper macros for initializing the global env bind map
Problematic code:
;; ------------PROBLEM IN THESE MACROS------------------
(define-syntax _def-initial
(syntax-rules ()
((_def-initial name)
(update 'name 'void genv))
((_def-initial name value)
(update 'name value genv))))
(define-syntax _def-primitive
(syntax-rules ()
((_def-primitive name value arity)
(_def-initial name (lambda (args)
(if (equal? arity (length args))
(apply value args)
(error "Incorrect arity" (list 'name value))))))))
(define-syntax _fill-global-env
(syntax-rules ()
((_fill-global-env)
(begin
(println "Filling the environment")
(_def-primitive + (lambda (x y) (+ x y)) 2)
(_def-primitive - (lambda (x y) (- x y)) 2)
(_def-primitive * (lambda (x y) (* x y)) 2)
(_def-primitive / (lambda (x y) (/ x y)) 2))
)))
;; Racket and Guile SAY genv IS UNBOUND
(define get-global-environment
;; name must be `genv' coz of the above macros
(let ( (genv #f) )
(lambda ()
(if (equal? genv #f) ;; If uninitialized
(begin (set! genv (make-new-environment '()))
(println "Before filling: "genv)
(_fill-global-env)
(println "After filling: " genv)
genv)
genv))))
;; ------------------- END OF PROBLEMATIC CODE(IT SEEMS) ---------------
Continue:
;; - Start the interpreter
(define (main args)
;; Define the global environment
(define genv (get-global-environment))
(println "Global environment: " genv)
(let loop ((expr (read (current-input-port))))
(if (eof-object? expr)
(println "Done")
(begin (println (evaluate expr genv))
(loop (read (current-input-port)))))))
(main "")
Here's the error I receive from Racket (in problematic code's get-global-environment's body, not in main's body):
. . genv: undefined;
cannot reference undefined identifier
Scheme macros are hygienic. The genv you defined in get-global-environment is not the same as the genv in your _def-initial (which uses whatever genv was there when _def-initial was defined, which in this case would be the top-level one, which as you pointed out does not exist).
In order to make your macro work, you must adapt _fill-global-env, _def-primitive, and _def-initial to all take a genv parameter, so that _def-initial uses that genv instead of the top-level one.
I'm wondering how to implement mutable versions of cadr, caddr, and the likes in Racket without defining each one separately? ie. not
(define (mcadr exp)
(mcar (mcdr exp)))
It seems that for mutable lists or pairs, Racket only supports mcar and mcdr but not the "expanded" versions. Do I need to know and be good at macros to be able to do this?
Here's a macro solution:
#lang racket/base
(require racket/mpair (for-syntax racket/base))
(define-syntax (define-combinations stx)
(syntax-case stx ()
[(_ n) (integer? (syntax-e #'n))
(let ([n (syntax-e #'n)])
(define options (list (cons "a" #'mcar) (cons "d" #'mcdr)))
(define (add-options r)
(apply append
(map (λ (opt)
(map (λ (l) (cons (string-append (car opt) (car l))
(list (cdr opt) (cdr l))))
r))
options)))
(define combinations
(cdddr
(let loop ([n n] [r '(("" . x))])
(if (zero? n) r (append r (loop (sub1 n) (add-options r)))))))
(define (make-name combo)
(let ([s (string->symbol (string-append "mc" (car combo) "r"))])
(datum->syntax stx s stx)))
(with-syntax ([(body ...) (map cdr combinations)]
[(name ...) (map make-name combinations)])
#'(begin (define (name x) body) ...)))]))
(define-combinations 4)
(mcaddr (mlist 1 2 3 4 5))
You could do:
(define mcaar (compose mcar mcar))
(define mcadr (compose mcar mcdr))
;; ...
(define mcddddr (compose mcdr mcdr mcdr mcdr))
But there is no real getting around the repetition. Even in the Racket source (look in racket/src/list.c), the repetition is there, albeit prettified a little with C macros.