Macro of [S:N] for in-range in Racket - scheme

How can I create a macro so that S:N or [S:N] returns a range of numbers starting with S and ending with N (step 1). Basically, it should be able to use it in place of 'in-range'. I tried to create something similar to Curly brackets {} to replace 'begin' in Racket but could not.
Edit: I tried following as suggested by #soegaard :
my-top.rkt:
#lang racket
(define-syntax-rule (my-top S:N)
(range S N) )
(provide (rename-out [my-top #%top]))
test.rkt:
#lang racket
(require "my-top.rkt")
(1:42)
But it does not run. The error is:
#%top: use does not match pattern: (#%top S:N) in: (#%top . 1:42)
[1:42] and 1:42 also do not work.

Here are the steps to make S:N expand to (range S N) where S and N are numbers.
Note that S:N is an identifier. Therefore an unbound S:N is an unbound identifier. An reference to an unbound identifiers n expand to (#%top . n).
Therefore 1:42 expands into (#%top 1:42).
Make a macro my-top such that (my-top S:N) expands to (range S N).
Save your macro in file my-top.rkt and export it using (provide (rename-out [my-top #%top])).
Use your new construct like this:
.
#lang racket
(require "my-top.rkt")
1:42
Step 1:
#lang racket
(require syntax/parse (for-syntax racket/match syntax/parse))
(begin-for-syntax
; contains-colon? : string -> boolean
; does the string str contain a colon?
(define (contains-colon? str)
(regexp-match ".*:.*" str))
; split-colon-string-into-numbers : string -> (list number number)
; for a string of the form N:S return a list consisting of the
; numbers corresponsing to the substrings N and S
(define (split-colon-string-into-numbers str)
(match (regexp-match "(.*):(.*)" str)
[(list _ S-str N-str)
(list (string->number S-str) (string->number N-str))]
[_else
(error 'split-colon-string-into-numbers
"expected string of the number <number>:<number>")])))
; SYNTAX (my-top . id)
; (my-top . id) behaves the same as (#%top . id)
; except when id has the form N:S in which case
; (my-top . id) behaves as (range N S)
(define-syntax (my-top stx)
(syntax-parse stx
[(_my-top . identifier:id)
(define str (symbol->string (syntax-e #'identifier)))
(cond
[(contains-colon? str)
(with-syntax ([(S N) (split-colon-string-into-numbers str)])
(syntax/loc stx
(range S N)))]
[else
#'(#%top . identifier)])]))
;;; Tests
(my-top . 1:5) ; evaluates to (1 2 3 4)
(define foo 42)
(my-top . foo) ; evaluates to 42

#soegaard's answer provided a #%top-based solution which expands S:N when S and N are literal integers and S:N isn't defined as an identifier. However, it's also possible to do this with a reader macro.
I've made two versions: a simple version that only works with literal integers, and another version that works with arbitrary expressions, including variables.
The literal-integer version
This simple version overrides [ to begin range expressions like [S:N], where S and N are literal integers. After the [, it reads numeric characters until it finds a :, then it reads more numeric characters until it finds a ]. It converts the strings of numeric characters into integers, and puts those integers into a list representing a call to the range function.
It would be used like this:
#lang colon-range
;; simple range by itself
[1:42]
;; using a range within a more complicated expression
(for/list ((i [2:42])
#:when
(for/and ((j [2:41]) #:when (< j i))
(not (= 0 (remainder i j)))))
i)
Note that I'm using ((i ....)) instead of the more common ([i ....]) because I can't use [ and ] normally any more.
To implement the #lang colon-range language, you should put the reader implementation in colon-range/lang/reader.rkt, where colon-range is installed as a single-collection package.
;; s-exp syntax/module-reader is a language for defining new languages.
#lang s-exp syntax/module-reader
racket
#:wrapper1 (lambda (th)
(parameterize ([current-readtable
(make-colon-range-readtable (current-readtable))])
(th)))
;; This extends the orig-readtable with an entry for `[` to convert
;; `[1:42]` to `(range 1 42)`. In this simplistic implementation, they
;; have to be literal numbers, so it can't refer to a variable.
(define (make-colon-range-readtable orig-readtable)
(make-readtable orig-readtable
#\[ 'terminating-macro colon-range-proc))
;; This is the function that the new readtable will use when in encounters a `[`
(define (colon-range-proc char in src ln col pos)
(define S (read-int-until #\: in src))
(define N (read-int-until #\] in src))
(list 'range S N))
;; This reads until it finds the given char (consuming it),
;; and returns an exact integer
(define (read-int-until char in src)
(define str (list->string (read-numeric-chars-until char in src)))
(define i (string->number str))
(unless (exact-integer? i)
(error 'read "expected an exact integer, given `~a`" str))
i)
;; This reads until it finds the given char (consuming it), and returns a list
;; of characters. Each char it reads before that needs to be a numeric char,
;; otherwise it throws an error.
(define (read-numeric-chars-until char in src)
(define c (read-char in))
(cond [(eof-object? c)
(error 'read "end-of-file: expected either a number or a `~a`, given `~a`"
char c)]
[(char=? char c)
(list)]
[(char-numeric? c)
(cons c (read-numeric-chars-until char in src))]
[else
(error 'read "expected either a number or a `~a`, given `~a`"
char c)]))
The arbitrary-expression version
This version overrides both [ and :. It defines : as a separator so that a:b reads the same as a : b, and it defines [ as a reader macro that reads a normal list and processes it afterwards. So it will first take [a : b] as a list of three elements, and then translate it to (range a b).
It can be used like this:
#lang colon-range
;; simple range by itself
[1:42]
;; using a range within a more complicated expression
(for/list ([i [2:42]]
#:when
(for/and ([j [2:i]]) ; can refer to a variable
(not (= 0 (remainder i j)))))
i)
(define two 2)
(for/list ([i [two:42]] ; can refer to a variable for the start
#:when
(for/and ([j [two:(+ 1 (exact-floor (sqrt i)))]]) ; can use arbitrary expressions
(not (= 0 (remainder i j)))))
i)
The implementation looks like this (again in colon-range/lang/reader.rkt). The comments explain some of what it's doing.
;; s-exp syntax/module-reader is a language for defining new languages.
#lang s-exp syntax/module-reader
racket
#:wrapper1 (lambda (th)
(parameterize ([current-readtable
(make-colon-range-readtable (current-readtable))])
(th)))
;; This extends the orig-readtable with entries for `[` and `:` to convert
;; `[S:N]` to `(range S N)`.
(define (make-colon-range-readtable orig-readtable)
(make-readtable orig-readtable
#\[ 'terminating-macro colon-range-proc
#\: 'terminating-macro separator-proc))
;; This is the function that the new readtable will use when in encounters a `[`
(define (colon-range-proc char in src ln col pos)
;; This reads the list of things ending with the character that closes `char`
;; The #f means it uses the racket reader for the first step, so that `[`
;; uses the normal behavior, grouping expressions into a reader-level list
(define lst (read-syntax/recursive src in char #f))
;; This matches on that list to determine whether it has the shape `[S : N]`
(syntax-case lst (:)
[[S : N]
;; if it is, translate it to `(range S N)`
(list 'range #'S #'N)]
[_
;; otherwise leave it alone
lst]))
;; This doesn't read any further and simply returns an identifier containing char,
;; so that it can act like a separator
(define (separator-proc char in src ln col pos)
(char->identifier char (list src ln col pos 1)))
(define (char->identifier char srcloc)
(datum->syntax #f (string->symbol (string char)) srcloc))

Related

How do I get a function's name as a symbol?

I am trying to define a function func->symbol that takes a function and returns its name as a symbol. For example:
(define (pythagoras a b)
(sqrt (+ (* a a) (* b b))))
;; #1
(func->symbol pythagoras) ; Returns: 'pythagoras
;; #2
(func->symbol (if #t pythagoras sqrt)) ; Returns: 'pythagoras
;; #3
(let ((f (if #t pythagoras sqrt)))
(func->symbol f)) ; Returns: 'pythagoras
;; #4
(let ((f (if #t pythagoras sqrt)))
(let ((g f))
(func->symbol g))) ; Returns: 'pythagoras
This is a follow-up question on How do I get a definition's name as a symbol? which only deals with case #1. For case #1, a simple macro def->symbol is sufficient:
(define-syntax def->symbol
(syntax-rules ()
((_ def) 'def)))
However, this macro definition does not pass cases #2, #3, #4. Is it possible to define func->symbol, or is Scheme not expressive enough for this?
In Racket, in many cases, you can get a function's name using object-name. But it is probably a bad idea to rely on this result for anything other than debugging.
Perhaps it's worth an answer which shows why this is not possible in any language with first-class functions.
I'll define what I mean by a language having first-class functions (there are varying definitions).
Functions can be passed as arguments to other functions, and returned as values from them.
Functions can be stored in variables and other data structures.
There are anonymous functions, or function literals.
Scheme clearly has first-class functions in this sense. Now consider this code:
(define a #f)
(define b #f)
(let ((f (lambda (x)
(+ x 1))))
(set! a f)
(set! b f))
Let's imagine there is a function-name function, which, given a function, returns its name. What should (function-name a) return?
Well, the answer is that there's simply no useful value it can return (in Racket, (object-name a) returns f, but that's clearly exposing implementation details which might be useful for debugging but would be very misleading as a return value for a function-name procedure.
This is why such a procedure can't exist in general in a language with first-class functions: the function which maps from names to values is many-to-one and thus has no inverse.
Here is an example of the sort of disgusting hack you could do to make this 'work' and also why it's horrible. The following is Racket-specific code:
(define-syntax define/naming
;; Define something in such a way that, if it's a procedure,
;; it gets the right name. This is a horrid hack.
(syntax-rules ()
[(_ (p arg ...) form ...)
(define (p arg ...) form ...)]
[(_ name val)
(define name (let ([p val])
(if (procedure? p)
(procedure-rename p 'name)
p)))]))
And now, given
(define/naming a
(let ([c 0])
(thunk
(begin0
c
(set! c (+ c 1))))))
(define/naming b a)
Then:
> (object-name a)
'a
> (object-name b)
'b
> (eqv? a b)
#f
> (a)
0
> (b)
1
> (a)
2
So a and b have the 'right' names, but because of that they are necessarily not the same object, which I think is semantically wrong: if I see (define a b) then I want (eqv? a b) to be true, I think. But a and b do capture the same lexical state, so that works, at least.

Compare two lists and return false if they are not equal scheme

i would like to ask you for help to complete code below with condition which is testing if lists ws and vs are not equal. If they are not equal so return text false(#f) else process code below. I stared with fulfilling variables len1 and len2 which are counting length of both lists. When i run it i am getting this error: lambda: no expression after a sequence of internal definitions in: lambda What i am doing wrong?
(define (weighted-sum . ws)
(define (sub . vs)
(let ((len1 (length ws)) (len2 (length vs)))
(if (not (equal? (len1 len2) '#f))
(foldl
(lambda (i j res) (+ res (* i j)))
0
ws vs)))
sub)
Thanks for help.
length is almost always an anti-pattern in Scheme.
length is a O(n) operation, which is called twice, then you call another O(n) operation, foldl, resulting in a O(3n) process for weighted-sum - far from the ideal minimum O(n). foldl is a nice candidate for many linear computations, but because of the length-matching requirement, you've created a bit of a square-peg-in-a-round-hole situation.
Using a named-let and match*, we write weighted-sum as a O(n) computation -
#lang racket
(define ((weighted-sum . ws) . vs) ;; curried form syntactic sugar
(let loop ((acc 0)
(ws ws)
(vs vs))
(match* (ws vs)
;; both lists have at least one value
[((list w ws ...) (list v vs ...))
(loop (+ acc (* w v))
ws
vs)]
;; both lists are empty
[((list) (list))
acc]
;; any other case
[(_ _)
#f])))
Of course match* is a pretty fancy macro, so I'll show you how to rewrite weighted-sum using a simple cond expression. Get your logical reasoning hat ready: the order of the condition clauses is very important here -
(define ((weighted-sum . ws) . vs)
(let loop ((acc 0)
(ws ws)
(vs vs))
(cond
;; both lists are empty
[(and (null? ws)
(null? vs))
acc]
;; at least one list is empty
[(or (null? ws)
(null? vs))
#f]
;; inductive: both lists have at least one value
[else
(loop (+ acc (* (car ws)
(car vs)))
(cdr ws)
(cdr vs))])))
Both programs have the same output -
((weighted-sum 1 2 3) 1 2 3)
;; 14
((weighted-sum 1 2 3) 1 2)
;; #f
((weighted-sum 1 2) 1 2 3)
;; #f
((weighted-sum))
;; 0
Erase )) after #f . Add )) after len1 len2), and it'll work. (not quite, but close(*))
#f is self-evaluating, you don't need to quote it. Indent the (foldl ...) form which became a part of the if expression now.
Lastly, (if (not A) #f B) is the same as (if A B #f) is the same as (and A B).
You are correct in checking that the lengths of both lists, the carried (sic) and the expected, are equal. I don't see why the lists themselves should be equal, though. They shouldn't, as far I can tell.
(weighted-sum list-of-weights) creates a procedure expecting a list of numbers to calculate its weighted sum using the previously supplied weights.
(*) The corrected code, after a few more fixes, is:
(define (weighted-sum . ws)
(define (sub . vs)
(let ((len1 (length ws)) (len2 (length vs)))
(and (equal? len1 len2)
(foldl
(lambda (i j res) (+ res (* i j)))
0
ws vs))))
sub)
It is highly advisable to install e.g. Racket and use its editor to see and correct the parentheses mismatches etc.

Execute the following call/cc expression

I use racket and I got the result 4 for following simple code:
(let/cc done
((let/cc esc
(done (+ 1 (let/cc k
(esc k)))))
3))
and I was going to execute this code step-by-step.
First, I changed the first let/cc into the form of call/cc like below:
(call/cc (λ (done)
((let/cc esc
(done (+ 1 (let/cc k
(esc k)))))
3)))
Of course, this produces 4 also.
Second, since I found the mechanism of call/cc in the internet which says call/cc do following 4 steps:
Captures the current continuation.
Constructs a function C that takes one argument, and applies the current continuation with that argument value.
Passes this function as an argument to expr --- i.e., it invokes (expr C).
Returns the result of evaluating (expr C), unless expr calls C, in which case the value that is passed to C is returned.
Thus, I followed above steps for the first call/cc like:
Current continuation is an identity.
C refers (λ (x) x).
Since expr is (λ (done) ((let/cc esc (done (+ 1 (let/cc k (esc k))))) 3)), (expr C) is:
((λ (done)
((let/cc esc
(done (+ 1 (let/cc k
(esc k)))))
3))
(λ (x) x))
To return the result value of above code, I execute above in racket.
But, above code (modified by me) is not executed and produces an error:
> application: not a procedure;
>
> expected a procedure that can be applied to arguments
>
> given: 4
>
> arguments...:
>
> 3
Please what I did wrong. I'm confusing the concept of continuation. Thanks.
When the interpreter sees a call/cc even the interpreters that doesn't do CPS does it with that subtree. Your code would look something like this:
((λ (done)
((λ (esc)
((λ (k) (esc k))
(λ (r) (k+ done 1 r))))
(λ (v) (v 3))))
values)
; k+ implementation (+, but CPS)
(define (k+ k . args)
(k (apply + args)))
Continuations are not just closures (functions). They also perform a jump to their defining location in code. You have to perform the CPS transformation in full to try evaluating the resulting expression in Scheme interpreter. That expression will only contain lambdas and no continuations (in the sense of call/cc (1)).
The expression that you tried mixes them both - it defines done as simple lambda-defined function, but it is still used in the nested context as a continuation.
(1) (another source of confusion is calling the function arguments in the continuation-passing style "continuations". they are not "true" continuations; they are simple functions "to be called" in this or that eventuality, so colloquially they are also referred to as "continuations" although "contingencies" or even "handlers" could be better.)
See also another example of call/cc code translation.
Following that approach, translating your Scheme code into Common Lisp, we get:
;; (let/cc done
;; ((let/cc esc
;; (done (+ 1 (let/cc k
;; (esc k)))))
;; 3))
(prog (retval done arg1 func esc arg2 k arg3 arg4)
(setq done (lambda (x) (setq retval x) (go DONE))) ; 3
(setq arg1 3) ; 5
(setq esc (lambda (x) (setq func x) (go ESC))) ; 8
(setq arg3 1) ; 10
(setq k (lambda (x) (setq arg4 x) (go K))) ; 12
(setq arg4 (funcall esc k)) ; 13
K ; 11 continuation K
(setq arg2 (+ arg3 arg4)) ; 9
(setq func (funcall done arg2)) ; 7
ESC ; 6 continuation ESC
(setq retval (funcall func arg1)) ; 4
DONE ; 2 continuation DONE
(return retval)) ; 1
which indeed returns 4 (the lines of code are numbered in order as they are written, during the translation).

How do you return the description of a procedure in Scheme?

Suppose I have something like this:
(define pair (cons 1 (lambda (x) (* x x))
If I want to return the front object of the pair I do this:
(car pair)
And it returns 1. However when the object is a procedure I don't get the exact description of it.
In other words:
(cdr pair)
returns #<procedure> and not (lambda (x) (*x x)).
How do I fix this?
Although there's no way to do this generally, you can rig up something to do it for procedures that you define.
Racket structs can define a prop:procedure that allows the struct to be applied (called) as a procedure. The same struct can hold a copy of your original syntax for the function definition. That's what the sourced struct is doing, below.
The write-sourced stuff is simply to make the output cleaner (show only the original sexpr, not the other struct fields).
The define-proc macro makes it simpler to initialize the struct -- you don't need to type the code twice and hope it matches. It does this for you.
#lang racket
(require (for-syntax racket/syntax))
;; Optional: Just for nicer output
(define (write-sourced x port mode)
(define f (case mode
[(#t) write]
[(#f) display]
[else pretty-print])) ;nicer than `print` for big sexprs
(f (sourced-sexpr x) port))
(struct sourced (proc sexpr)
#:property prop:procedure (struct-field-index proc)
;; Optional: Just to make cleaner output
#:methods gen:custom-write
[(define write-proc write-sourced)])
;; A macro to make it easier to use the `sourced` struct
(define-syntax (define-proc stx)
(syntax-case stx ()
[(_ (id arg ...) expr ...)
#'(define id (sourced (lambda (arg ...) expr ...)
'(lambda (arg ...) expr ...)))]))
;; Example
(define-proc (foo x)
(add1 x))
(foo 1) ; => 2
foo ; => '(lambda (x) (add1 x))
The procedure cons evaluates its arguments: 1 is self-evaluating to 1; (lambda ...) evaluates to an anonymous procedure. If you want to 'prevent' evaluation, you need to quote the argument, as such:
> (define pair (cons 1 '(lambda (x) (* x x))
> (cdr pair)
(lambda (x) (* x x))

Anonymous lambdas directly referring to themselves

Does Scheme or do any dialects of scheme have a kind of "self" operator so that anonymous lambdas can recur on themselves without doing something like a Y-combinator or being named in a letrec etc.
Something like:
(lambda (n)
(cond
((= n 0) 1)
(else (* n (self (- n 1)))))))
No. The trouble with the "current lambda" approach is that Scheme has many hidden lambdas. For example:
All the let forms (including let*, letrec, and named let)
do (which expands to a named let)
delay, lazy, receive, etc.
To require the programmer to know what the innermost lambda is would break encapsulation, in that you'd have to know where all the hidden lambdas are, and macro writers can no longer use lambdas as a way to create a new scope.
All-round lose, if you ask me.
There is a tradition of writing “anaphoric” macros that define special names in the lexical scope of their bodies. Using syntax-case, you can write such a macro on top of letrec and lambda. Note that the definition below is as hygienic as possible considering the specification (in particular, invisible uses of alambda will not shadow self).
;; Define a version of lambda that binds the
;; anaphoric variable “self” to the function
;; being defined.
;;
;; Note the use of datum->syntax to specify the
;; scope of the anaphoric identifier.
(define-syntax alambda
(lambda (stx)
(syntax-case stx ()
[(alambda lambda-list . body)
(with-syntax ([name (datum->syntax #'alambda 'self)])
#'(letrec ([name (lambda lambda-list . body)])
name))])))
;; We can define let in terms of alambda as usual.
(define-syntax let/alambda
(syntax-rules ()
[(_ ((var val) ...) . body)
((alambda (var ...) . body) val ...)]))
;; The let/alambda macro does not shadow the outer
;; alambda's anaphoric variable, which is lexical
;; with regard to the alambda form.
((alambda (n)
(if (zero? n)
1
(let/alambda ([n-1 (- n 1)])
(* (self n-1) n))))
10)
;=> 3628800
Most people avoid anaphoric operators since they make the structure of the code less recognizable. In addition, refactoring can introduce problems rather easily. (Consider what happens when you wrap the let/alambda form in the factorial function above in another alambda form. It's easy to overlook uses of self, especially if you're not reminded of it being relevant by having to type it explicitly.) It is therefore generally preferable to use explicit names. A “labeled” version of lambda that allows this can be defined using a simple syntax-rules macro:
;; Define a version of lambda that allows the
;; user to specifiy a name for the function
;; being defined.
(define-syntax llambda
(syntax-rules ()
[(_ name lambda-list . body)
(letrec ([name (lambda lambda-list . body)])
name)]))
;; The factorial function can be expressed
;; using llambda.
((llambda fac (n)
(if (zero? n)
1
(* (fac (- n 1)) n)))
10)
;=> 3628800
I have found a way using continuations to have anonymous lambdas call themselves and then using Racket macros to disguise the syntax so the anonymous lambda appears to have a "self" operator. I don't know if this solution is possible in other versions of Scheme since it depends on the Call-with-composable-continuation function of racket and the Macro to hide the syntax uses syntax parameters.
The basic idea is this, illustrated with the factorial function.
( (lambda (n)
(call-with-values
(lambda () (call-with-composable-continuation
(lambda (k) (values k n))))
(lambda (k n)
(cond
[(= 0 n) 1]
[else (* n (k k (- n 1)))])))) 5)
The continuation k is the call to the anonymous factorial function, which takes two arguments, the first being the continuation itself. So that when in the body we execute (k k N) that is equivalent to the anonymous function calling itself (in the same way that a recursive named lambda would do).
We then disguise the underlying form with a macro. Rackets syntax-parameters allow the transformation of (self ARGS ...) to (k k ARGS ... )
so we can have:
((lambda-with-self (n)
(cond
[(= 0 n) 0]
[(= 1 n) 1]
[else (* n (self (- n 1)))])) 5)
The complete Racket program to do this is:
#lang racket
(require racket/stxparam) ;required for syntax-parameters
( define-syntax-parameter self (λ (stx) (raise-syntax-error #f "not in `lambda-with-self'" stx)))
(define-syntax-rule
(lambda-with-self (ARG ... ) BODY ...)
(lambda (ARG ...)
(call-with-values
(lambda ()(call/comp (lambda (k) (values k ARG ...))))
(lambda (k ARG ...)
(syntax-parameterize ([self (syntax-rules ( )[(self ARG ...) (k k ARG ...)])])
BODY ...)))))
;Example using factorial function
((lambda-with-self (n)
(cond
[(= 0 n) 0]
[(= 1 n) 1]
[else (* n (self (- n 1)))])) 5)
This also answers my previous question about the differences between the different kinds of continuations.
Different kinds of continuations in Racket
This only works because unlike call-with-current-continuation, call-with-composable-continuation doesn't abort back to a continuation prompt but invokes the continuation at the place it was invoked.

Resources