I'm having trouble with Racket's syntax-parse. In particular, I am getting the following error message:
unknown: rule: expected one of these identifiers: `model', `line', or `rule'
at: rule
in: (rule (predicate (symbol "T") "[" (symbol-list (symbol "X")) "]") "<-" (predicate (symbol "Q") "[" (symbol-list (symbol "X")) "]"))
Why isn't the rule syntax object matching the identifier? I'm invoking the function as follows:
(define (parse-carl s)
(syntax-parse s
[((~literal model) ~rest x)
(with-syntax ([x (map parse-carl (syntax-e #'x))]) #'x)]
[((~literal line) x) (with-syntax ([x (parse-carl #'x)]) #'x)]
[((~literal rule) p1 "<-" p2) 'ok]))
Here is the input (passed through syntax->datum):
(model (line (rule (predicate (symbol T) [ (symbol-list (symbol X)) ]) <- (predicate (symbol Q) [ (symbol-list (symbol X)) ])))
(line (rule (predicate (symbol Y) [ (symbol-list (symbol X)) ]) <- (predicate (symbol Q) [ (symbol-list (symbol X)) ])))
(line (rule (predicate (symbol Y) [ (symbol-list (symbol X)) ]) <- (predicate (symbol T) [ (symbol-list (symbol X)) ])))
(line (query (rule (predicate (symbol Y) [ (symbol-list (symbol X)) ]) <- (predicate (symbol T) [ (symbol-list (symbol X)) ])) ?))
)
Thanks in advance.
Is rule actually defined? ~literal recognizes a binding, so if there's no binding, it won't work. You would need ~datum instead in that case.
Related
I'm trying to write this Datalog program in Z3:
p :- r.
q :- \r.
As per this tutorial, I wrote:
(declare-rel p ())
(declare-rel q ())
(declare-rel r ())
(rule (=> r p))
(rule (=> (not r) q))
(set-option :fixedpoint.engine datalog)
(rule r)
(query p :print-answer true)
Now, I'd like to replace (rule r) by (rule (not r)), to deduce q, but I get:
(error "query failed: Illegal head. The head predicate needs to be
uninterpreted and registered (as recursive) (not r)")
r is assumed to be false by default, so you don't need to say (rule (not r)).
(query q :print-answer true) will yield true.
I am trying to make a script work from both DrRacket and the repl, having this as my starting point: Racket calculator
Here is my current code:
#lang racket
(provide (all-defined-out))
(require parser-tools/lex
(prefix-in re: parser-tools/lex-sre)
parser-tools/yacc)
(define-tokens value-tokens (INT ANY))
(define-empty-tokens empty-tokens
(PLUS MINUS MULTIPLY DIVIDE NEWLINE EOF))
(define basic-lexer
(lexer
((re:+ numeric) (token-INT lexeme))
(#\+ (token-PLUS))
(#\- (token-MINUS))
(#\* (token-MULTIPLY))
(#\/ (token-DIVIDE))
((re:or #\tab #\space) (basic-lexer input-port))
(#\newline (token-NEWLINE))
((eof) (token-EOF))
(any-char (token-ANY lexeme))))
(define (display-plus expr)
(display "Result: ")
(let ((left (string->number (first expr)))
(right (string->number (last expr))))
(display (+ left right)))
(newline))
(define (display-minus expr)
(display "Result: ")
(let ((left (string->number (first expr)))
(right (string->number (last expr))))
(display (- left right)))
(newline))
(define (display-multiply expr)
(display "Result: ")
(let ((left (string->number (first expr)))
(right (string->number (last expr))))
(display (* left right)))
(newline))
(define (display-divide expr)
(display "Result: ")
(let ((left (string->number (first expr)))
(right (string->number (last expr))))
(display (/ left right)))
(newline))
(define basic-parser
(parser
(start start)
(end NEWLINE EOF)
(tokens value-tokens empty-tokens)
(error (lambda (ok? name value)
(printf "Couldn't parse: ~a\n" name)))
(grammar
(start ((expr) $1)
((expr start) $2))
(expr ((INT PLUS INT) (display-plus (list $1 $3)))
((INT MINUS INT) (display-minus (list $1 $3)))
((INT MULTIPLY INT) (display-multiply (list $1 $3)))
((INT DIVIDE INT) (display-divide (list $1 $3)))
((ANY) (displayln $1))))))
(define input1 (open-input-string "123 + 456"))
(define input2 (open-input-string "123 *456"))
(basic-parser (lambda() (basic-lexer input1)))
(basic-parser (lambda() (basic-lexer input2)))
;(define (my-repl)
; (display ">>> ")
; (let* ((input (read-line))
; (input-port (open-input-string
; (list->string
; (drop-right
; (string->list input) 1)))))
; (cond
; ((not (equal? "\r" input)
; (print (basic-parser
; (lambda () (basic-lexer input-port))))))))
; (my-repl))
(define (calc str)
(let* ([port (open-input-string str)]
[result (basic-parser (lambda() (basic-lexer port)))])
(displayln result)))
(define (repl)
(display ">>> ")
(let ((input (read-line)))
(print input)
(cond
((eof-object? input) (displayln "eof"))
((eq? input #\newline) (displayln "new line"))
(else (calc (read-line))))
(newline))
(repl))
A test from DrRacket is shown here:
Welcome to DrRacket, version 7.1 [3m].
Language: racket, with debugging; memory limit: 512 MB.
Result: 579
Result: 56088
> (repl)
>>> 1+1
"1+1"2+2
Result: 4
#<void>
>>> 3+3
"3+3"4+4
Result: 8
#<void>
And from the repl:
Welcome to Racket v7.1.
> (require "untitled7.rkt")
Result: 579
Result: 56088
> (repl)
>>> "\r"
#<void>
>>> 1+1
"1+1\r"2+2
Result: 4
#<void>
>>> 3+3
"3+3\r"4+4
Result: 8
#<void>
>>> #<eof>eof
>>> ; user break [,bt for context]
It only displays every second calculation. It appears that read-line returns a new line before waiting for user input, which I tried to check with (eof-object? input) and (eq? input #\newline) but now I get only every second result.
There are two problems:
First, you're reading a line, (let ((input (read-line))), but you're not sending that input to the calculator, you'r sending another one – (calc (read-line)).
You should pass input to calc for evaluation instead.
Second, you have a lot of #<void>s in your output.
This is because calc assumes that your parser produces a value that it can print:
(displayln result)
but the parser does not produce any value, it only prints one.
Either remove the output of result, or rewrite the parser to return the value to its caller.
Replace (calc (read-line)) with (calc input).
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 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. :)