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.
Related
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"
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))
Is there a way to do this:
(let ((x 5)(y 7))
(get-outer-form) ;; 'get-outer-form would capture the entire LET expression
(* x y))
35 ;; value returned from LET
*current-form-value* ;; variable to hold the form
(let ((x 5))(y 7))(* x y)) ;; value of evaluating *current-form-value*
If it can be done, pseudo-code will suffice. I'll naively assume that this would have to be done with read, however, if there is too much overhead generated from doing this, I will have to find another solution. Thanks.
No its not possible by default. Doing so would need some advanced code and is not likely to work easily:
custom evaluator
code walker which injects the necessary code
I've been fiddling a little around and came up with this. It's not exactly what you want but it's close. It it were possible to rename let and make your own it would be exactly what you want.
(defmacro letc (p &body b)
(when (equal (car b) '(get-outer-form))
(setq b `((setf *current-form-value* '(let ,p ,#(cdr b))),#(cdr b))))
`(let ,p ,#b))
(letc ((x 5)(y 7))
(get-outer-form) ;; 'get-outer-form would capture the entire LET expression
(* x y))
;; ==> 35
*current-form-value*
;; ==> (let ((x 5) (y 7)) (* x y))
Or simpler. Using letc implies you want it captured.
(defmacro letc (p &body b)
`(let ,p (setf *current-form-value* '(letc ,p ,#b)),#b)))
(letc ((x 5)(y 7))
(* x y))
;; ==> 35
*current-form-value*
;; ==> (letc ((x 5) (y 7)) (* x y))
Both of them have problems with nesting:
(letc ((x 5)(y 7))
(letc ((a (+ x y)))
(* 2 a)))
;; ==> 24
*current-form-value*
;; ==> (let ((a (+ x y))) (* 2 a))
I think Rainer is basically correct, but I couldn't help trying for a subset of your goal with either *macroexpand-hook* or a reader approach. I don't bother removing (get-outer-form) from the current form in either case, but that should be straightforward list manipulation.
First a reader approach. Wrap the open parenthesis reader with a function that searches for (get-outer-form) within the result of calling the default open parenthesis reader.
;(in-package |cl-user|)
(defparameter *standard-readtable* (copy-readtable ()))
*STANDARD-READTABLE*
;(in-package |cl-user|)
(defvar *current-form-value* ())
*CURRENT-FORM-VALUE*
;(in-package |cl-user|)
(defun get-outer-form ()
())
GET-OUTER-FORM
;(in-package |cl-user|)
(defun get-outer-form-paren-reader (stream char &optional count)
(declare (ignore count))
(let* ((seen ())
(paren-reader
(get-macro-character #\( *standard-readtable*))
(form (funcall paren-reader stream char)))
(subst-if ()
(lambda (x)
;; never substitute, search only.
(prog1 ()
(when (equalp x '(get-outer-form))
(setq seen t))))
form)
(when seen
(setq *current-form-value* form))
form))
GET-OUTER-FORM-PAREN-READER
;(in-package |cl-user|)
(set-macro-character #\( #'get-outer-form-paren-reader)
T
Second, a *macroexpand-hook* approach. Look for (get-outer-form) in forms before they are macroexpanded.
;(in-package |cl-user|)
(defun get-outer-form ()
(error "get-outer-form only works from within a macro"))
GET-OUTER-FORM
;(in-package |cl-user|)
(defvar *current-form-value* ())
*CURRENT-FORM-VALUE*
;(in-package |cl-user|)
(defun mhook (expander form env)
(let* ((seen ())
(fixed (subst-if ()
(lambda (x)
(when (equalp x '(get-outer-form))
(setq seen t)))
form)))
(when seen (setq *current-form-value* form))
(funcall expander fixed env)))
MHOOK
;(in-package |cl-user|)
(setq *macroexpand-hook* #'mhook)
#<Compiled-function MHOOK #x30200FC5BB1F>
since yesterday I've been trying to program a special case statement for scheme that would do the following:
(define (sort x)
(cond ((and (list? x) x) => (lambda (l)
(sort-list l)))
((and (pair? x) x) => (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else "here")))
instead of using all the and's and cond's statement, I would have:
(define (sort x)
(scase ((list? x) => (lambda (l)
(sort-list l)))
((pair? x) => (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else "here")))
What I could do so far, was this:
(define (sort x)
(scase (list? x) (lambda (l)
(sort-list l)))
(scase (pair? x) (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p))))
with this code:
(define-syntax scase
(syntax-rules ()
((if condition body ...)
(if condition
(begin
body ...)))))
What I wanted to do now, is just allow the scase statement to have multiple arguments like this:
(scase ((list? (cons 2 1)) 'here)
((list? '(2 1)) 'working))
but I can't seem to figure out how I can do that. Maybe you guys could give me a little help?
Thanks in advance ;)
If this is an exercise in learning how to use syntax-rules, then disregard this answer.
I see a way to simplify your code that you are starting with.
(define (sort x)
(cond ((list? x)
(sort-list x))
((pair? x)
(if (> (car x) (cdr x))
(cons (cdr x) (car x))
x)))
(else "here")))
Since all the (and (list? x) x) => (lambda l ... does is see if x is a list, and then bind l to x, (since #f is not a list, and '() is not false, at least in Racket), you can just skip all that and just use x. You do not need to use => in case, and in this case it doesn't help. => is useful if you want to do an test that returns something useful if successful, or #f otherwise.
Now, if you want to use a macro, then you're going to need to clarify what you want it to do a bit better. I think that case already does what you want. Your existing macro is just if, so I'm not sure how to extend it.
I found the solution for my question, here it goes:
(define-syntax cases
(syntax-rules ()
((_ (e0 e1 e2 ...)) (if e0 (begin e1 e2 ...)))
((_ (e0 e1 e2 ...) c1 c2 ...)
(if e0 (begin e1 e2 ...) (cases c1 c2 ...)))))
Thank you all anyway :)
Here's a solution :
#lang racket
(require mzlib/defmacro)
(define-syntax scase
(syntax-rules (else)
((_ (else body1)) body1)
((_ (condition1 body1) (condition2 body2) ...)
(if condition1
body1
(scase (condition2 body2) ...)))))
(define (sort1 x)
((scase ((list? x) (lambda (l)
(sort l <)))
((pair? x) (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else (lambda (e) "here")))
x))
It works in DrRacket. I made three changes to your solution. First, i renamed your sort procedure to sort1 since sort is inbuilt in scheme ( I have used it inside sort1). Second, I have changed the sort1 itself so that the input given will be passed to the procedure returned by scase and you will directly get the sorted result. Third, I have modified the scase syntax extension, so that it will accept the else condition.
>(sort1 (list 3 1 2))
'(1 2 3)
> (sort1 (cons 2 1))
'(1 . 2)
> (sort1 'here)
"here"
I suggest you read "The Scheme Programming Language" by Kent Dybvig. There is an entire chapter on syntactic extensions.
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.