Two questions about Racket macro - macros

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))))))))

Related

Lisp recursive square use one variables

This is Trying code
(defun f (a n)
(if (zerop n)
1
(* a (f a (- n 1)))))
(f 3) should return 27, (f 4) should return 256
I tried using two variables, but it be against the rules.
Is it possible to use only one variable using recursive?
Thanks for any ideas
I don't know CL, but I do know Clojure and other languages that use recursion.
In cases where a recursive function has 1 parameter acting as an accumulator, but is only set on the first call, the typical way around this is to wrap f in another function. There are 2 (basically the same) ways of doing this:
(defun g (a n)
(if (zerop n)
1
(* a (g a (- n 1)))))
(defun f (n)
; I'm assuming you want the initial value of "a" to be 1
(g 1 n))
Or, more succinctly:
(defun f (n)
(let (g (fn (n)
(if (zerop n)
1
(* a (g a (- n 1))))))))
; Instead of f being recursive, f calls g, which is recursive
(g 1 n))
Excuse any syntax errors.
Using an additional variable to count down would be the sane choice, but you don't need to change the contract of just one numeric argument input just for this. You can make a helper to do that:
(defun exptnn (n)
"Get the (expt n n)"
(check-type n integer)
(labels ((helper (acc count)
(if (zerop count)
acc
(helper (* acc n) (1- count)))))
(if (< n 0)
(/ 1 (helper 1 (- n)))
(helper 1 n))))
Now to solve with without any helpers just with one argument is possible since there is a solution doing that already, but I must say that is like programming in Brainf*ck without the joy!
CL-USER 15 > (defun f (n)
(labels ((g (m)
(if (zerop m)
1
(* n (g (1- m))))))
(g n)))
F
CL-USER 16 > (f 0)
1
CL-USER 17 > (f 1)
1
CL-USER 18 > (f 2)
4
CL-USER 19 > (f 3)
27
CL-USER 20 > (f 4)
256
CL-USER 21 > (loop for i below 10 collect (f i))
(1 1 4 27 256 3125 46656 823543 16777216 387420489)
This is a solution where no functions with more than one parameter are used (except for =, +, *, logand, ash; note also that logand and ash always take a constant as second parameter so they can be implemented as unary functions too).
The idea is to "hide" the two parameters needed for the obvious recursive approach in a single integer using odd/even bits.
(defun pair (n)
(if (= n 0)
0
(+ (* 3 (logand n 1))
(ash (pair (ash n -1)) 2))))
(defun pair-first (p)
(if (= p 0)
0
(+ (logand p 1)
(ash (pair-first (ash p -2)) 1))))
(defun pair-second (p)
(pair-first (ash p -1)))
(defun subsec (p)
(if (= 2 (logand p 2))
(- p 2)
(+ (logand p 1) 2 (ash (subsec (ash p -2)) 2))))
(defun pairpow (p)
(if (= (pair-second p) 1)
(pair-first p)
(* (pair-first p)
(pairpow (subsec p)))))
(defun f (n)
(pairpow (pair n)))
No reasonable real use, of course; but a funny exercise indeed.
Yes, this is possible:
(defun f (n)
(cond
((numberp n)
(f (cons n n)))
((zerop (car n))
1)
(t
(* (cdr n)
(f (cons (1- (car n))
(cdr n)))))))
The trick is that you can store any data structure (including a pair of numbers) in a single variable.
Alternatively, you can use helpers from the standard library:
(defun f (n)
(apply #'*
(loop repeat n collect n)))
But that doesn't use recursion. Or simply:
(defun f (n)
(expt n n))

Unbound identifier racket operators

This is my first time working with racket, and I am getting an error message (*: unbound identifier;) when trying to evaluate a list in Dr. Racket.
#lang racket
(define (randop)
(define x(random 3))
(cond
((= x 0) '+)
((= x 1) '-)
((= x 2) '*)
)
)
(define (randexp ht)
(define x(random 10))
(define y(random 10))
(define z(randop))
(eval (list z y x))
)
(randexp 1)
When executing racket in the console, (eval lst) works fine, though when I execute this code, it comes up with an unbound identifier. Any help is appreciated.
You don't need eval here. Instead of returning the symbols return the procedures instead:
#lang racket
(define (randop)
(define x (random 3))
(cond ((= x 0) +) ; + not quoted means if will return what + evaluates to
((= x 1) -) ; which is the procedures they represent
((= x 2) *)))
(define (randexp)
(define x (random 10))
(define y (random 10))
(define z (randop))
(z y x))) ; call z (the procedure returned by randop) with arguments x and y.
(randexp)
There's a problem with the way you're calling eval, in Racket you have to do this in a file:
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(define (randop)
(define x (random 3))
(cond
((= x 0) '+)
((= x 1) '-)
((= x 2) '*)))
(define (randexp ht)
(define x (random 10))
(define y (random 10))
(define z (randop))
(eval (list z y x) ns))
(randexp 1)
Also, you're not actually using the ht parameter, consider deleting it.

CLISP Lambda Calculus Div Implementation

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

Scheme macro expansion: Nesting let-syntax inside define-syntax

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)))

Lisp style question: memoization (caution: contains the solution for project euler #14)

I am just trying to learn some Lisp, so I am going through project euler problems. I found problem no. 14 interesting (so if you are planning to solve this problems stop reading now, because I pasted my solution at the bottom). With my algorithm it was so slow, but after using memoization (I copied the function from Paul Graham's "on Lisp" book) it was much more faster (around 4 to 8 seconds).
My question is about this bunch of warnings that I got:
Am I doing something wrong? Can I improve my style?
> ;; Loading file
> /euler-lisp/euler-14.lisp
> ... WARNING in COLLATZ-SERIE :
> COLLATZ-SERIE-M is neither declared
> nor bound, it will be treated as if it
> were declared SPECIAL. WARNING in
> COLLATZ-SERIE : COLLATZ-SERIE-M is
> neither declared nor bound, it will be
> treated as if it were declared
> SPECIAL. WARNING in COMPILED-FORM-314
> : COLLATZ-SERIE-M is neither declared
> nor bound, it will be treated as if it
> were declared SPECIAL. (525 837799)
> Real time: 18.821894 sec. Run time:
> 18.029127 sec. Space: 219883968 Bytes GC: 35, GC time: 4.080254 sec. Las
> siguientes variables especiales no han
> sido definidas: COLLATZ-SERIE-M 0
> errores, 0 advertencias ;; Loaded file
This is the code:
(defun collatz (n)
(if (evenp n) (/ n 2) (+ (* 3 n) 1)))
(defun memoize (fn)
(let ((cache (make-hash-table :test #'equal)))
#'(lambda (&rest args)
(multiple-value-bind (val win) (gethash args cache)
(if win
val
(setf (gethash args cache)
(apply fn args)))))))
(defun collatz-serie (n)
(cond ((= n 1) (list 1))
((evenp n) (cons n (funcall collatz-serie-m (/ n 2))))
(t (cons n (funcall collatz-serie-m (+ (* 3 n) 1))))))
(defun collatz-serie-len (n)
(length (collatz-serie n)))
(setq collatz-serie-m (memoize #'collatz-serie))
(defun gen-series-pairs (n)
(loop for i from 1 to n collect
(list (collatz-serie-len i) i)))
(defun euler-14 (&key (n 1000000))
(car (sort (gen-series-pairs n) #'(lambda (x y) (> (car x) (car y))))))
(time (print (euler-14)))
Thanks a lot, and forgive the probable errors, I am just beginning with Lisp.
Br
UPDATE:
i want to share the final code that i wrote. using custom external hash table for memoization and improving the final loop.
(defvar *cache* (make-hash-table :test #'equal))
(defun collatz (n)
(if (evenp n) (/ n 2) (+ (* 3 n) 1)))
(defun collatz-serie (n)
(cond ((= n 1) (list 1))
((evenp n) (cons n (collatz-serie (/ n 2))))
(t (cons n (collatz-serie (+ (* 3 n) 1))))))
(defun collatz-serie-new (n)
(labels ((helper (n len)
(multiple-value-bind (val stored?) (gethash n *cache*)
(if stored?
val
(setf (gethash n *cache*) (cond ((= n 1) len)
((evenp n) (+ len (helper (/ n 2) len)))
(t (+ len (helper (+ (* 3 n) 1) len)))))))))
(helper n 1)))
;; learning how to loop
(defun euler-14 (&key (n 1000000))
(loop with max = 0 and pos = 0
for i from n downto 1
when (> (collatz-serie-new i) max)
do (setf max (collatz-serie-new i)) and do (setf pos i)
finally (return (list max pos))))
It is bad style to setq an unknown name. It is assumed that you mean to create a new global special variable, then set it, but this should be made explicit by introducing these bindings first. You do this at the top level by using defvar (or defparameter or defconstant) instead, and in lexical blocks by using let, do, multiple-value-bind or similar constructs.