This code runs fine:
(require syntax/parse/define (only-in racket [#%app racket:#%app]))
(define-syntax-parser #%app
[(_ Cond {~datum ?} Form1 ...)
#'(when Cond Form1 ...)]
[(_ Cond {~datum ??} Form1 ... {~datum :} Form2 ...)
#'(if Cond (begin Form1 ...) (begin Form2 ...))]
[(_ Xs ...)
#'(racket:#%app Xs ...)]
)
(#t ? (displayln 1))
(#t ?? (displayln 1) : (displayln 2))
However, I wish to change ?? to a single ?. Racket shows error, why doesn't Racket match the second syntax?
:: undefined;
cannot reference an identifier before its definition
Is Racket confused the if syntax with the right above when syntax? How to fix it to use the same ? for both when and if?
I found it out how, the when is defined first before the if in define-syntax-parser, and its syntax include ellipsis ... which matches everything following it, including the : in if-else.
Fixed it as below, put syntax for if first:
(require syntax/parse/define (only-in racket [#%app racket:#%app]))
(define-syntax-parser #%app
[(_ Cond {~datum ?} Form1 ... {~datum :} Form2 ...)
#'(if Cond (begin Form1 ...) (begin Form2 ...))]
[(_ Cond {~datum ?} Form1 ...)
#'(when Cond Form1 ...)]
[(_ Xs ...)
#'(racket:#%app Xs ...)]
)
(#t ? (displayln 1))
(#t ? (displayln 1) : (displayln 2))
Related
I can define the infix '+' as below in Racket:
(require syntax/parse/define (only-in racket (#%app racket:#%app)))
(define-syntax-parser #%app
[(_ Value1 {~datum +} Value2)
#'(+ Value1 Value2)]
[(_ Xs ...)
#'(racket:#%app Xs ...)]
)
(displayln (1 + 2))
I want to add multiple infix '+' using ~between but it doesn't work:
(require syntax/parse/define (only-in racket (#%app racket:#%app)))
(define-syntax-parser #%app
[(_ {~between {Value1 {~datum +}} 1 100} Value2)
#'(+ Value1 Value2)]
[(_ Xs ...)
#'(racket:#%app Xs ...)]
)
(displayln (1 + 2))
The syntax in Racket is here: https://docs.racket-lang.org/syntax/stxparse-patterns.html with ~between but no ~repeat.
How to use ~between property to repeat items in syntax?
I have a work-around but it doesn't look pure multiple infix +, need to wrap every left entry in brackets:
(require syntax/parse/define (only-in racket (#%app racket:#%app)))
(define-syntax-parser #%app
[(_ {Value1 {~datum +}} ... Value2)
#'(+ Value1 ... Value2)]
[(_ Xs ...)
#'(racket:#%app Xs ...)]
)
(displayln ({1 +} {2 +} 3))
What you want is a combination of ~seq and ...+.
(define-syntax-parser #%app
[(_ {~seq Value1 {~datum +}} ...+ Value2)
#'(+ Value1 ... Value2)]
[(_ Xs ...)
#'(racket:#%app Xs ...)])
The ~seq matches a sequence of things without requiring them to be grouped by brackets as your workaround did.
The ...+ is a repetition pattern to match one-or-more things, as opposed to zero-or-more. This makes sure that (f) isn't accidentally interpreted as (+ f).
One more note, when you're defining #%app directly, as opposed to defining under a different name and then renaming the export, you need to be extra careful about implicit recursive uses. For instance (+ + x) is an infinite loop. To fix that you could use racket:#%app in both outputs, like #'(racket:#%app + Value1 ... Value2).
(define-syntax-parser #%app
[(_ {~seq Value1 {~datum +}} ...+ Value2)
#'(racket:#%app + Value1 ... Value2)]
[(_ Xs ...)
#'(racket:#%app Xs ...)])
I am reading Section 2.2 in SICP where the book introduced the procedure for appending two lists. I am trying to implement the append using iteration.
This is my code:
(define (append list1 list2)
(define (append-iter item1 reversed-item1 result)
(if (null? item1)
(if (null? reversed-item1)
result
(append-iter item1
(cdr reversed-item1)
(cons (car reverse) result)))
(append-iter (cdr item1)
(cons (car item1) reversed-item1)
result)))
(append-iter list1 '() list2))
Though it works, but noting the number of the iterations is double the length of list1. Is there a solution whose number of the iterations equals to the length of list1. (without using any fold function)?
Basically how your procedure works is like this:
(define (append l1 l2)
(define (reverse-append rev app)
(if (null? rev)
app
(reverse-append (cdr rev)
(cons (car rev) app))))
(reverse-append (reverse l1) l2))
It's O(N) but it wastes some memory since (reverse l1) space is just used for iteration. If you really need to fix that you need to use mutation:
(define (append-iter . rest)
(let ((result (list 1)))
(let loop ((p result) (lst '()) (rest rest))
(cond
((not (null? lst))
(set-cdr! p (list (car lst)))
(loop (cdr p) (cdr lst) rest))
((null? rest) (cdr result))
((null? (cdr rest))
(set-cdr! p (car rest))
(cdr result))
(else (loop p (car rest) (cdr rest)))))))
I'm new to Racket but super excited about it. I've been working on writing a simple lexer for WWW-Authenticate headers. I'm feeling pretty good about the lexing, but now I'd like to change my output.
#lang racket
(require parser-tools/lex)
(require (prefix-in : parser-tools/lex-sre))
(define in (open-input-string "MsRtcOAuth href=\"https://foo.com/WebTicket/oauthtoken\",grant_type=\"urn:microsoft.rtc:windows,urn:microsoft.rtc:anonmeeting,password\", Bearer trusted_issuers=\"\", client_id=\"00000004-0000-0ff1-ce00-000000000000\""))
(define key-lexer
(lexer
;anything not an "="
[(:* (char-complement #\=))
;=>
(cons `(KEY, lexeme)
(equals-lexer input-port))]
;eof
[(eof) '()]))
(define equals-lexer
(lexer
[#\=
;=>
(value-lexer input-port)]
;eof
[(eof) '()]))
(define value-lexer
(lexer
;values are anything between two " "
[(concatenation #\" (:* (char-complement #\")) #\")
;=>
(cons `(VAL, lexeme)
(comma-lexer input-port))]
;eof
[(eof) '()]))
(define comma-lexer
(lexer
[(concatenation (:* whitespace) #\, (:* whitespace))
;=>
(key-lexer input-port)]
;eof
[(eof) '()]))
(key-lexer in)
Right now, the output looks like this:
'((KEY "MsRtcOAuth href")
(VAL "\"https://foo.com/WebTicket/oauthtoken\"")
(KEY "grant_type")
(VAL "\"urn:microsoft.rtc:windows,urn:microsoft.rtc:anonmeeting,password\"")
(KEY "Bearer trusted_issuers")
(VAL "\"\"")
(KEY "client_id")
(VAL "\"00000004-0000-0ff1-ce00-000000000000\""))
What's I'd prefer is a list of pairs, similar to this:
(("MsRtcOAuth href" . "\"https://foo.com/WebTicket/oauthtoken\"")
("grant_type" . "\"urn:microsoft.rtc:windows,urn:microsoft.rtc:anonmeeting,password\"") etc...
Any help or pointers greatly appreciated. Thanks!
Here is one way to transform what you've got into what you want:
(define (prettify key-val-pairs)
(match key-val-pairs
[(list (list 'KEY key) (list 'VAL val) more ...)
(cons (list key val)
(prettify more))]
[_ key-val-pairs]))
(prettify
'((KEY "MsRtcOAuth href")
(VAL "\"https://foo.com/WebTicket/oauthtoken\"")
(KEY "grant_type")
(VAL "\"urn:microsoft.rtc:windows,urn:microsoft.rtc:anonmeeting,password\"")
(KEY "Bearer trusted_issuers")
(VAL "\"\"")
(KEY "client_id")
(VAL "\"00000004-0000-0ff1-ce00-000000000000\"")))
Output:
'(("MsRtcOAuth href" "\"https://foo.com/WebTicket/oauthtoken\"")
("grant_type" "\"urn:microsoft.rtc:windows,urn:microsoft.rtc:anonmeeting,password\"")
("Bearer trusted_issuers" "\"\"")
("client_id" "\"00000004-0000-0ff1-ce00-000000000000\""))
I'm working on a text alignment program in scheme that is made to read in text from a file, convert it to a stream, morph the stream to remove extra spaces and newlines, and then align the text to the right. This is part of an assignment that I'm almost finished on, so I just need to conceptually understand how to do it.
The function that I'm having trouble understanding how to do is called 'right-justify'.
I have the main function called at the end of the program, it uses a file called 'hollow.txt', I can supply that if you guys want, but I think I just need help on how to start right-justify.
Thanks very much in advance.
#lang racket
(require racket/stream)
(define file->stream
(lambda (filename)
(let ((in-port (open-input-file filename)))
(letrec
((build-input-stream
(lambda ()
(let ((ch (read-char in-port)))
(if (eof-object? ch)
(begin
(close-input-port in-port)
(stream))
(stream-cons ch (build-input-stream)))))))
(build-input-stream)))))
;main function
(define formatter ;from homework page
(lambda (input-filename output-filename line-length)
(stream->file output-filename
; (right-justify
(insert-newlines line-length
(remove-extra-spaces ;str ;stream argument given.
(remove-newlines ;str ;stream argument given.
(file->stream input-filename)))))));)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;MORPHING STREAMS.
(define right-justify ;not fully sure how to solve this one.
(lambda (str)
(cond
[ (stream-empty?) str ]
[ (char=? #\newline (stream-rest str))((stream-cons #\space (stream-rest str))) ]
[
(define remove-newlines
(lambda (str)
(cond
[ (stream-empty? str) str ]
[ (char=? #\newline (stream-first str)) (stream-cons #\space (remove-newlines (stream-rest str))) ]
[ else (stream-cons (stream-first str) (remove-newlines (stream-rest str))) ]
)))
(define remove-extra-spaces ;Remove all spaces in the stream.
(lambda (str)
(cond
[ (stream-empty? str) str ]
[(char=? #\space (stream-first str)) (stream-cons #\space ( remove-extra-spaces (space-helper (stream-rest str))))]
[ else (stream-cons (stream-first str) (remove-extra-spaces (stream-rest str))) ]
)))
(define space-helper ;A helper for the remove-extra-spaces function.
(lambda (str)
(cond
[ (stream-empty? str) str]
[ (char=? #\space (stream-first str)) (space-helper(stream-rest str))]
[ else str ]
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; THESE FUNCTIONS MAY NEED WORK.
(define stream->file
(lambda (filename stream-in)
(let ((out-port (open-output-file filename #:exists 'replace )))
(letrec
((build-output-stream
(lambda (str) ;stream
(if (stream-empty? str)
(close-output-port out-port)
(begin
(write-char (stream-first str) out-port)
(build-output-stream (stream-rest str)))
))))
(build-output-stream stream-in)))))
(define insert-newlines
(lambda (line-length str)
(letrec
((insert
(lambda (str count)
(if (stream-empty? str)
str
(let ((n (count-chars-to-next-space str)))
(if (and (< count line-length)
(<= (+ n count) line-length))
(stream-cons
(stream-first str)
(insert (stream-rest str) (+ count 1)))
(stream-cons
#\newline
(insert (trim-spaces str) 0))))))))
(insert (trim-spaces str) 0))))
(define trim-spaces
(lambda (str)
(cond ((stream-empty? str) (stream))
((char=? (stream-first str) #\space)
(trim-spaces (stream-rest str)))
(else str))))
(define count-chars-to-next-space
(lambda (str)
(letrec
((count-ahead
(lambda (str count)
(cond ((stream-empty? str) count)
((char=? (stream-first str) #\space) count)
(else (count-ahead (stream-rest str) (+ count 1)))))))
(count-ahead str 0))))
(formatter "hollow.txt" "h.txt" 30) ;calling the function at the end so that it will run automatically.
I am trying to write a simple parser which creates a sxml-expression from a string, e. g.
"This is a [Test]" ===> (item "This is a" (subitem "Test"))
Anybody who is wondering about the square brackets within the given example may have a look at the so called Leiden conventions.
This is the code I have written so far:
(define my-sequence '("this" "[" "is" "a" "]" "test"))
(define (left-square-bracket? item)
(or (equal? item "[")
(eq? item #\x005b)))
(define (right-square-bracket? item)
(or (equal? item "]")
(eq? item #\x005d)))
(define (parse-sequence sequence)
(cond ((null? sequence) '())
((left-square-bracket? (car sequence))
(let ((subsequence (get-subsequence (cdr sequence))))
(list subsequence)))
(else
(cons (car sequence)
(parse-sequence (cdr sequence))))))
(define (get-subsequence sequence)
(if (right-square-bracket? (car sequence))
'()
(cons (car sequence)
(get-subsequence (cdr sequence)))))
Evaluating (parse-sequence my-sequence) yields ("this" ("is" "a")). A nested expression has been created, but the program finished without having evaluated the last item "test". The question is, how do I return from get-subsequence to parse-sequence?
Any help is appreciated, many thanks in advance! :)
To address your initial questions, how to return multiple values: use the "values" form. Here is an example implementation where the inner procedure returns both the remaining list to be processed and the result so far. It recurses on opening brackets.
(define (parse-sequence lst)
(define (parse-seq lst)
(let loop ((lst lst) (res null))
(cond
((null? lst) (values null res))
((string=? (car lst) "[")
(let-values ([(lst2 res2) (parse-seq (cdr lst))])
(loop lst2 (append res (list res2)))))
((string=? (car lst) "]")
(values (cdr lst) res))
(else
(loop (cdr lst) (append res (list (car lst))))))))
(let-values ([(lst res) (parse-seq lst)])
res))
then
(parse-sequence '("this" "is" "a" "test"))
(parse-sequence '("this" "[" "is" "a" "]" "test"))
(parse-sequence '("this" "[" "is" "[" "a" "]" "]" "test"))
will yield
'("this" "is" "a" "test")
'("this" ("is" "a") "test")
'("this" ("is" ("a")) "test")
I made some progress by using open-input-string in combination with read-char:
(define my-sequence (open-input-string "this [is a] test"))
(define (parse-sequence sequence)
`(item
,#(let loop ((next-char (read-char sequence)))
(cond ((eof-object? next-char) '())
((left-square-bracket? next-char)
(let ((subsequence (get-subsequence sequence)))
(cons subsequence
(loop (read-char sequence)))))
(else
(cons next-char
(loop (read-char sequence))))))))
(define (get-subsequence sequence)
`(subitem
,#(let loop ((next-char (read-char sequence)))
(if (right-square-bracket? next-char)
'()
(cons next-char
(loop (read-char sequence)))))))
(parse-sequence my-sequence)
===> (item #\t #\h #\i #\s #\space (subitem #\i #\s #\space #\a) #\space #\t #\e #\s #\t)
Now work goes on, step by step. :)
Any comments and suggestions are still appreciated. :)