I'm wondering if there is a way to do recursive expansion of macros?
(define-syntax my-define
(syntax-rules ()
[(my-define (fn v ...) body) #'(define (fn v ...) body)]))
(define-syntax my-let
(syntax-rules ()
[(my-let ([v e] ...) body) #'(let ([v e] ...) body)]))
;(my-define (f1 a) a)
; this returns (define (f1 a) a)
;(my-let ([x 10]) x)
; this returns (let ([x 10]) x)
(my-define (f1 a) (my-let ([x 10]) x))
; but this returns (define (f1 a) (my-let [x 10] x)))
The nested case is somehow not expanded. Am I doing something wrong?
Seems to work fine, when you remove the #' (which you probably put it in to debug):
#lang racket
(define-syntax my-define
(syntax-rules ()
[(my-define (fn v ...) body)
(define (fn v ...) body)]))
(define-syntax my-let
(syntax-rules ()
[(my-let ([v e] ...) body)
(let ([v e] ...) body)]))
(my-define (fact n)
(my-let ([k (- n 1)])
(if (zero? n) 1 (* n (fact k)))))
(fact 5)
Related
Is it possible to write an R5RS macro that would "flatten" arbitrarily deep syntax tree?
Example:
(flatten-syntax (a (b (c d)) e)) => (a b c d e)
My endgoal is to have another macro that would work like this:
(declare-tree (a (b (c d)) e))
=>
(begin (define a #f) (define b #f) (define c #f) (define d #f) (define e #f))
but it should be easy to define if flatten-syntax is available.
The most challenging part for me here is the syntax-rules-only restriction, but if you have syntax-case solution, please also post it.
My progress on this problem stalled at this point:
(define-syntax flatten-syntax-helper
(syntax-rules ()
((_ buf (x . xs))
(flatten-syntax-helper
(flatten-syntax-helper buf x) xs))
((_ buf ())
buf)
((_ buf x)
(x . buf))))
(define-syntax-rule (my-flatten-syntax T)
(flatten-syntax-helper () T))
In guile, ,expand (my-flatten-syntax (a (b (c d)) e)) results in syntax error "failed to match any pattern in form my-flatten-syntax".
Here's my quick attempt:
#lang racket
(define-syntax reverse-macro
(syntax-rules ()
[(_ () (result ...)) '(result ...)]
[(_ (x xs ...) (result ...)) (reverse-macro (xs ...) (x result ...))]))
(define-syntax flatten-syntax-aux
(syntax-rules ()
[(_ ((xs ...) ys ...) (result ...))
(flatten-syntax-aux (xs ... ys ...) (result ...))]
[(_ (x xs ...) (result ...))
(flatten-syntax-aux (xs ...) (x result ...))]
[(_ () (result ...))
(reverse-macro (result ...) ())]))
(define-syntax-rule (flatten-syntax xs)
(flatten-syntax-aux xs ()))
(flatten-syntax (a (b (c d)) e)) ;=> '(a b c d e)
Indeed, you can create declare-tree by adjusting flatten-syntax a little bit, but it might be surprising to you that defining declare-tree directly is in fact much easier:
#lang racket
(define-syntax declare-tree
(syntax-rules ()
[(_ ((xs ...) ys ...))
(begin (declare-tree (xs ...))
(declare-tree (ys ...)))]
[(_ (x xs ...))
(begin (define x #f)
(declare-tree (xs ...)))]
[(_ ())
(begin)]))
(declare-tree (a (b (c d)) e))
(list a b c d e) ;=> '(#f #f #f #f #f)
This is because declare-tree actually doesn't need to flatten the structure. It can generate nested begin, like:
(begin
(begin (define a #f)
(define b #f))
(begin (define c #f)
(define d #f)))
I'm trying to modify the function below to compose two functions in Scheme.
(define (compose F1 F2)
(eval F1 (interaction-environment))
)
rather than
(define (compose f g)
(λ (x) (f (g x))))
But I'm not sure about how to use eval.
From your suggestion, I guess you want to use Scheme's macros / preprocessing capabilities. eval isn't meant for code transformation. Composition ∘ can be defined in Scheme as
(define (∘ f g)
(lambda (x) (f (g x))) )
or
(define-syntax ∘
(syntax-rules ()
((∘ f g)
(lambda (x) (f (g x))) )))
where the arity of expressions f and g is 1.
(define (plus-10 n) (+ n 10))
(define (minus-3 n) (- n 3))
(display
(map (∘ plus-10 minus-3)
(list 1 2 3 4) ))
The map expression at compile-time becomes
(map (lambda (x) (plus-10 (minus-3 x)))
(list 1 2 3 4) )
equal?s
(list 8 9 10 11)
About hygienic macro
I don't fully understand how hygienic macro work. Here is two example.
first one is:
#lang racket
(define-syntax (g stx)
(syntax-case stx ()
([_ arg]
#'(display arg))))
(let ([display 1])
(g 3))
this works fine but this one:
#lang racket
(define-syntax (g stx)
(syntax-case stx ()
([_ arg]
#'(display arg))))
(define display 1)
(g 3)
will raise an exception. How to explain the difference between the two case?
How to define a macro like this
I want to define a macro to allow anonymous recursive function in racket.
This one won't work because recur is not defined in the module:
#lang racket
(define Z
(λ(recur)
((λ(x) (recur (λ(y) (x x) y)))
(λ(x) (recur (λ(y) (x x) y))))))
(define-syntax-rule (R proc)
(Z (λ(recur) proc)))
((R (λ(n)
(if [= n 1]
1
(* n (recur (- n 1)))))) 3)
How to achieve this?
To answer your first question, the thing your forgetting here is that when you do a module level define like that, that definition is bound for the whole module. So, you could, theoretically write your second code block like this:
#lang racket
(let ([display 1])
(define-syntax (g stx)
(syntax-case stx ()
([_ arg]
#'(display arg))))
(g 3))
And now it makes sense why you get an error, because the display in your macro is bound to 1, which is not a function.
Long story short, think of hygiene just as lexical scope. Whatever display is bound to when you define your macro is what it will be. (This is opposed to macros in other languages, where whatever display is bound to when you call (or really expand) the macro, is what it will be.
Now, to answer your second question, I apologize, but am unclear what you are trying to ask here. If you could clean it up a bit then I can fill in this part of the answer.
So you want to break hygene? You need to get recur to have the lexical context of the original form such that recur will be seen as the same identifier. You can do this with datum->syntax and the result might look something like this:
(define-syntax (recur-λ stx)
(syntax-case stx ()
[(_ args body ...)
(with-syntax ([recur-stx (datum->syntax stx 'recur)])
#'(Z (λ (recur-stx)
(λ args body ...))))]))
Now as long as your args or the nesting in body introduces recur it will work:
; multiple argument recursion
(define Z
(λ (f)
((λ (g) (g g))
(λ (g)
(f (λ args (apply (g g) args)))))))
; ackerman
((recur-λ (m n)
(cond
((= m 0) (+ n 1))
((= n 0) (recur (- m 1) 1))
(else (recur (- m 1) (recur m (- n 1))))))
3
6)
; ==> 509
It won't work if you make recur an argument:
((recur-λ (recur) (recur 1)) 1)
; ==> error: recur not a procedure
And of course if you make a nested binding:
((recur-λ (a)
(define recur a)
(recur 1))
1)
; ==> error: recur not a procedure
And of course you can step through the macroexpander and it will show you that it does something like this:
(expand-once
#'(recur-λ (m n)
(cond
((= m 0) (+ n 1))
((= n 0) (recur (- m 1) 1))
(else (recur (- m 1) (recur m (- n 1)))))))
; ==>
; #'(Z
; (λ (recur)
; (λ (m n)
; (cond
; ((= m 0) (+ n 1))
; ((= n 0) (recur (- m 1) 1))
; (else (recur (- m 1) (recur m (- n 1))))))))
I'm trying to implement a Division function with clisp Lambda Calc. style
I read from this site that lambda expression of a division is:
Y (λgqab. LT a b (PAIR q a) (g (SUCC q) (SUB a b) b)) 0
These are TRUE and FALSE
(defvar TRUE #'(lambda(x)#'(lambda(y)x)))
(defvar FALSE #'(lambda(x)#'(lambda(y)y)))
These are conversion functions between Int and Church numbers
(defun church2int(numchurch)
(funcall (funcall numchurch #'(lambda (x) (+ x 1))) 0)
)
(defun int2church(n)
(cond
((= n 0) #'(lambda(f) #'(lambda(x)x)))
(t #'(lambda(f) #'(lambda(x) (funcall f
(funcall(funcall(int2church (- n 1))f)x))))))
)
This is my IF-THEN-ELSE Implementation
(defvar IF-THEN-ELSE
#'(lambda(c)
#'(lambda(x)
#'(lambda(y)
#'(lambda(acc1)
#'(lambda (acc2)
(funcall (funcall (funcall (funcall c x) y) acc1) acc2))))))
)
And this is my div implementation
(defvar division
#'(lambda (g)
#'(lambda (q)
#'(lambda (a)
#'(lambda (b)
(funcall (funcall (funcall (funcall (funcall IF-THEN-ELSE LT) a) b)
(funcall (funcall PAIR q)a))
(funcall (funcall g (funcall succ q)) (funcall (funcall sub a)b))
)))))
)
PAIR, SUCC and SUB functions work fine. I set my church numbers up like this
(set six (int2church 6))
(set two (int2church 2))
Then I do:
(setq D (funcall (funcall division six) two))
And I've got:
#<FUNCTION :LAMBDA (A)
#'(LAMBDA (B)
(FUNCALL (FUNCALL (FUNCALL (FUNCALL (FUNCALL IF-THEN-ELSE LT) A) B) (FUNCALL (FUNCALL PAR Q) A))
(FUNCALL (FUNCALL G (FUNCALL SUCC Q)) (FUNCALL (FUNCALL SUB A) B))))>
For what I understand, this function return a Church Pair. If I try to get the first element
with a function FRST (FRST works ok) like this:
(funcall frst D)
I've got
#<FUNCTION :LAMBDA (B)
(FUNCALL (FUNCALL (FUNCALL (FUNCALL (FUNCALL IF-THEN-ELSE LT) A) B) (FUNCALL (FUNCALL PAR Q) A))
(FUNCALL (FUNCALL G (FUNCALL SUCC Q)) (FUNCALL (FUNCALL SUB A) B)))>
If I try to get the int value with Church2int (Church2int works OK) like this:
(church2int (funcall frst D))
I've got
*** - +:
#<FUNCTION :LAMBDA (N)
#'(LAMBDA (F)
#'(LAMBDA (X)
(FUNCALL (FUNCALL (FUNCALL N #'(LAMBDA (G) #'(LAMBDA (H) (FUNCALL H (FUNCALL G F))))) #'(LAMBDA (U) X)) (LAMBDA (U) U))))>
is not a number
Where I expect to get 3
I think the problem is in DIVISION function, after the IF-THEN-ELSE, I tried to change it a little bit (I thought it was a nested parenthesis problem) but I got lots of errors.
Any help would be appreciated
Thanks
There are several problems with your definition.
DIVISION does not use the Y combinator, but the original definition does.
This is important, because the DIVISION function expects a copy of itself in the g
parameter.
However, even if you added the Y invocation, your code would still not work
but go into an infinite loop instead. That's because Common Lisp, like most of today's languages, is a call-by-value language. All arguments are evaluated before a function is called. This means that you cannot define conditional functions as elegantly as the traditional lambda calculus semantics would allow.
Here's one way of doing church number division in Common Lisp. I've taken the liberty of introducing some syntax to make this a bit more readable.
;;;; -*- coding: utf-8 -*-
;;;; --- preamble, define lambda calculus language
(cl:in-package #:cl-user)
(defpackage #:lambda-calc
;; note: not using common-lisp package
(:use)
(:export #:λ #:call #:define))
;; (lambda-calc:λ (x y) body)
;; ==> (cl:lambda (x) (cl:lambda (y) body))
(defmacro lambda-calc:λ ((arg &rest more-args) body-expr)
(labels ((rec (args)
(if (null args)
body-expr
`(lambda (,(car args))
(declare (ignorable ,(car args)))
,(rec (cdr args))))))
(rec (cons arg more-args))))
;; (lambda-calc:call f a b)
;; ==> (cl:funcall (cl:funcall f a) b)
(defmacro lambda-calc:call (func &rest args)
(labels ((rec (args)
(if (null args)
func
`(funcall ,(rec (cdr args)) ,(car args)))))
(rec (reverse args))))
;; Defines top-level lexical variables
(defmacro lambda-calc:define (name value)
(let ((vname (gensym (princ-to-string name))))
`(progn
(defparameter ,vname nil)
(define-symbol-macro ,name ,vname)
(setf ,name
(flet ((,vname () ,value))
(,vname))))))
;; Syntax: {f a b}
;; ==> (lambda-calc:call f a b)
;; ==> (cl:funcall (cl:funcall f a) b)
(eval-when (:compile-toplevel :load-toplevel :execute)
(set-macro-character #\{
(lambda (stream char)
(declare (ignore char))
`(lambda-calc:call
,#(read-delimited-list #\} stream t))))
(set-macro-character #\} (get-macro-character #\))))
;;;; --- end of preamble, fun starts here
(in-package #:lambda-calc)
;; booleans
(define TRUE
(λ (x y) x))
(define FALSE
(λ (x y) y))
(define NOT
(λ (bool) {bool FALSE TRUE}))
;; numbers
(define ZERO
(λ (f x) x))
(define SUCC
(λ (n f x) {f {n f x}}))
(define PLUS
(λ (m n) {m SUCC n}))
(define PRED
(λ (n f x)
{n (λ (g h) {h {g f}})
(λ (u) x)
(λ (u) u)}))
(define SUB
(λ (m n) {n PRED m}))
(define ISZERO
(λ (n) {n (λ (x) FALSE) TRUE}))
(define <=
(λ (m n) {ISZERO {SUB m n}}))
(define <
(λ (m n) {NOT {<= n m}}))
(define ONE {SUCC ZERO})
(define TWO {SUCC ONE})
(define THREE {SUCC TWO})
(define FOUR {SUCC THREE})
(define FIVE {SUCC FOUR})
(define SIX {SUCC FIVE})
(define SEVEN {SUCC SIX})
(define EIGHT {SUCC SEVEN})
(define NINE {SUCC EIGHT})
(define TEN {SUCC NINE})
;; combinators
(define Y
(λ (f)
{(λ (rec arg) {f {rec rec} arg})
(λ (rec arg) {f {rec rec} arg})}))
(define IF
(λ (condition if-true if-false)
{{condition if-true if-false} condition}))
;; pairs
(define PAIR
(λ (x y select) {select x y}))
(define FIRST
(λ (pair) {pair TRUE}))
(define SECOND
(λ (pair) {pair FALSE}))
;; conversion from/to lisp integers
(cl:defun int-to-church (number)
(cl:if (cl:zerop number)
zero
{succ (int-to-church (cl:1- number))}))
(cl:defun church-to-int (church-number)
{church-number #'cl:1+ 0})
;; what we're all here for
(define DIVISION
{Y (λ (recurse q a b)
{IF {< a b}
(λ (c) {PAIR q a})
(λ (c) {recurse {SUCC q} {SUB a b} b})})
ZERO})
If you put this into a file, you can do:
[1]> (load "lambdacalc.lisp")
;; Loading file lambdacalc.lisp ...
;; Loaded file lambdacalc.lisp
T
[2]> (in-package :lambda-calc)
#<PACKAGE LAMBDA-CALC>
LAMBDA-CALC[3]> (church-to-int {FIRST {DIVISION TEN FIVE}})
2
LAMBDA-CALC[4]> (church-to-int {SECOND {DIVISION TEN FIVE}})
0
LAMBDA-CALC[5]> (church-to-int {FIRST {DIVISION TEN FOUR}})
2
LAMBDA-CALC[6]> (church-to-int {SECOND {DIVISION TEN FOUR}})
2
I wish to expand
(foo x (f n) (f n) (arbitrary) (f n) ...)
into
(begin (x 'f n) (x 'f n) (arbitrary) (x 'f n) ...)
my attempt is:
(define-syntax foo
(syntax-rules ()
((_ l a ...)
(let-syntax ((f (syntax-rules ()
((_ n) (l (quote f) n)))))
(begin a ...)))))
(define (x t1 t2) (cons t1 t2)) ;; for example only
(define (arbitrary) (cons 'a 'b)) ;; for example only
(foo x (f 1) (f 2) (arbitrary) (f 3))
Using a macro stepper I can see that the first stage of the macro expands to
(let-syntax ((f (syntax-rules () ((_ n) (x 'f n)))))
(begin (f 1) (f 2) (arbitrary) (f 3)))
Which, when evaluated in isolation works perfectly, but when executed as a whole I get an error about f being an undefined identifier. I assume this is an issue in scoping, is this type of macro expansion possible?
Yeah, you need to get f from somewhere -- your macro just makes it up, and therefore it is not visible to users of foo. When you do consider that you need to get it from somewhere, the question is where would you get it from? Here's a fixed version of your code that assumes that it is the first thing in the second subform of foo:
(define-syntax foo
(syntax-rules ()
[(_ l (f a) more ...)
(let-syntax ([f (syntax-rules ()
[(_ n) (l 'f n)])])
(list (f a) more ...))]))
(define (x t1 t2) (cons t1 t2))
(define (arbitrary) (cons 'a 'b))
(foo x (f 1) (f 2) (arbitrary) (f 3))
(I also made it expand into a list to see that all forms are transformed.)
However, if you want a global kind of f to be used inside foo, then you really have to do just that: define a global f. Here's a limited way to do that:
;; no body => using `f' is always an error
(define-syntax f (syntax-rules ()))
(define-syntax foo
(syntax-rules ()
[(_ l a ...) (list (foo-helper l a) ...)]))
(define-syntax foo-helper
(syntax-rules (f) ; match on f and transform it
[(_ l (f n)) (l 'f n)]
[(_ l a) a]))
(define (x t1 t2) (cons t1 t2))
(define (arbitrary) (cons 'a 'b))
(foo x (f 1) (f 2) (arbitrary) (f 3))
The main limitation in this is that it will only work if one of the a forms is using f -- but it won't work if it is nested in an expression. For example, this will throw a syntax error:
(foo x (f 1) (f 2) (arbitrary)
(let ([n 3]) (f n)))
You can imagine complicating foo-helper and make it scan its input recursively, but that's a slippery slope you don't want to get into. (You'll need to make special cases for places like inside a quote, in a binding, etc.)
The way to solve that in Racket (and recently in Guile too) is to use a syntax parameter. Think about this as binding f to the same useless macro using define-syntax-parameter, and then use syntax-parameterize to "adjust" its meaning inside a foo to a macro that does the transformation that you want. Here's how this looks like:
;; needed to get syntax parameters
(require racket/stxparam)
;; same useless definition, but as a syntax parameter
(define-syntax-parameter f (syntax-rules ()))
(define-syntax foo
(syntax-rules ()
[(_ l a ...)
;; adjust it inside these forms
(syntax-parameterize ([f (syntax-rules ()
[(_ n) (l 'f n)])])
(list a ...))]))
(define (x t1 t2) (cons t1 t2))
(define (arbitrary) (cons 'a 'b))
(foo x (f 1) (f 2) (arbitrary)
(let ([n 3]) (f n)))