I've written Scheme REPL that works in all implementations I've tested, but have problem when when someone press enter and don't type anything.
(define void (if #f #f))
(cond-expand
(lips)
(kawa)
(gambit)
(guile (define (flush-output-port) void))
(gauche (define (flush-output-port) (flush (current-output-port)))))
(let ((repl (lambda ()
(let ((env (interaction-environment)))
(let iter ()
(display "scheme> ")
(flush-output-port)
(let ((input (read)))
(if (eof-object? input)
(newline)
(let ((result (eval input env)))
(if (not (eq? result void))
(begin
(display result)
(newline)))
(iter)))))))))
(repl))
How to fix my REPL so it works as expected when someone type enter, it should also work when user tried to exit the REPL by using CTRL+D. Right now it don't print prompt when you enter empty input.
NOTE: I was told that my void may don't work in every implementation, but even SRFI use this (I've learned about this in Sketchy Scheme book).
I was able to fix my REPL:
(let ((repl (lambda ()
(let ((env (interaction-environment)))
(let iter ()
(display "scheme> ")
(flush-output-port)
(if (char=? (peek-char) #\newline)
(begin
(read-char)
(iter)))
(let ((input (read)))
(if (eof-object? input)
(newline)
(let ((result (eval input env)))
(if (not (eq? result void))
(begin
(display result)
(newline)))
(if (and (char-ready?) (char=? (peek-char) #\newline))
(read-char))
(iter)))))))))
(repl))
Related
I have the function getBoundedVars which uses the function boundsInLambda. In the end of it all the box bBox should contain all bounded variables in the expression exp.
I'm trying to debug this function and in order to do so I want to print the parameters of boundsInLambda every time the function is being activated but for some reason the values won't show up on the screen.
If I put the display operation in getBoundedVars it will print it but those are just the values in the first iteration.
If I run the following :
(getBoundedVars (lambda-simple (x) (lambda-simple (y) (const x))) bx)
when bx is an empty box,
'1 will be printed but the print commands in boundsInLambda will not
here's the code:
(define getBoundedVars
(lambda (exp bBox)
(if (atom? exp)
0 ;; don't put in box
(if (lambda? (car exp))
(begin
(display 1)
(newline)
(let ((pBox (make-pBox exp))
(lBox (box '()))
(bodyExp (make-body exp))
)
(boundsInLambda bodyExp lBox pBox bBox)))
(begin
(getBoundedVars (car exp) bBox)
(getBoundedVars (cdr exp) bBox))))))
(define boundsInLambda
(lambda (bodyExp lastBox paramBox boundsBox)
(newline)
(display `(bodyExp: ,bodyExp))
(newline)
(display `(lastBox: ,lastBox))
(newline)
(display `(paramBox: ,paramBox))
(newline)
(display `(boundsBox: ,boundsBox))
(newline)
(if (and (not (null? bodyExp))
(list bodyExp)
(equal? (car bodyExp) 'seq)
)
(map boundsInLambda (cadr bodyExp))
(let* ( (lists* (filter (lambda (el) (and (not (null? el)) (list? el) (not (equal? (car el) 'const)))) bodyExp))
(lists (map (lambda (el) (if (equal? (car el) 'set) (cddr el) el)) lists*))
(bounds (filter (lambda (el) (and (member el (unbox lastBox)) (not (member el (unbox paramBox))))) bodyExp))
(listsLeft? (> (length lists) 0))
(anyBounds? (> (length bounds) 0))
)
(if anyBounds?
(begin
(set-box! boundsBox (append (unbox boundsBox) bounds))))
(if listsLeft?
(map
(lambda (lst)
(if (lambda? (car lst))
(let* ((newBodyExp (make-body lst))
(newParamBox (make-pBox exp))
(newLastBox (box (append (unbox lastBox) (unbox paramBox))))
)
(boundsInLambda newBodyExp newLastBox newParamBox boundsBox))
(boundsInLambda lst lastBox paramBox boundsBox)))
lists)
0))
)))
(define make-pBox
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-simple)
(box (cadr lamExp))
(if (equal? (car lamExp) 'lambda-opt)
(box (cadr lamExp))
(box '())))))
(define make-body
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-opt)
(cdddr lamExp)
(cddr lamExp))))
any help would be very much appreciated.
I'm working on metacircular evaluator of 4.1.4 Running the Evaluator as a Program, building which with Racket:
#lang racket
(require (combine-in rnrs/base-6
rnrs/mutable-pairs-6))
(define (evaluate exp)
(cond
; ...
((definition? exp) (display exp)
(display " is a definition\n"))
; ...
(else (display exp)
(display " is something else\n"))))
(define (definition? exp)
(tagged-list? exp 'define))
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
(define (driver-loop)
(let ((input (read)))
(let ((output (evaluate input)))
output))
(driver-loop))
(driver-loop)
After getting a box that reads input in DrRacket successfully, I type in (define a 0) and it turn out:
(define a 0) is something else
It could be recognised if I remove
(require (combine-in rnrs/base-6
rnrs/mutable-pairs-6))
But without which I wouldn't be able to call set-car! or set-cdr!. Is there an alternative for set- function?
Or could I choose what to import from rnrs/base-6 and rnrs/mutable-pairs-6 ?
It should run fine. I made a quick test with the code you gave.
(define (evaluate exp)
(cond
; ...
((definition? exp) (display exp)
(display " is a definition\n"))
; ...
(else (display exp)
(display " is something else\n"))))
(define (definition? exp)
(tagged-list? exp 'define))
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
(define (driver-loop)
(let ((input (read)))
(let ((output (evaluate input)))
output))
(driver-loop))
(driver-loop)
Running this in the racket language will give me :
--> is user input
-->(define a 0)
(define a 0) is a definition
-->(list 1 2 3)
(list 1 2 3) is something else
As you can see the right branch of the conditional was entered.
Are you sure the error comes from the else branch? Because your error message contains a :, display in the else branch don't.
EDIT : What exactly did you entered in the input prompt?
Confusion could be that a call to Racket's eval function needs a list as argument, (eval '(define a 0)). However if you enter this in the input prompt it won't work. You'll have to write (define a 0), like a normal definition.
Here is the bug:
(require (combine-in rnrs/base-6
rnrs/mutable-pairs-6))
Package rnrs/base-6 and rnrs/mutable-pairs-6 bring in something unpredicted that change cons(as well as car, cdr) leading (define a 0) not been caught by definition?
Solution:
(require (only-in (combine-in rnrs/base-6
rnrs/mutable-pairs-6)
set-car!
set-cdr!))
Always put only-in in require to avoid any unwanted binding.
This seems to work, it's a macro that expands to successive integers depending on how many times it has been expanded.
;; Library (test macro-state)
(library
(test macro-state)
(export get-count incr-count)
(import (rnrs))
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1)))
)
;; Program
(import (rnrs) (for (test macro-state) expand))
(define-syntax m
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count)))))))
(write (list (m) (m) (m)))
(newline)
;; prints (1 2 3)
But it's clumsy to me because the macro state *count* and the macro m itself are in different modules. Is there a better way to do this in r6rs, preferably one that doesn't split the implementation over two modules?
EDIT
I should make it clear that although this example is just a single macro, in reality I'm looking for a method that works when multiple macros need to share state.
You can make the state local to the macro transformer:
(define-syntax m
(let ()
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1)))
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count))))))))
Edited to add: In Racket, you can also do this:
(begin-for-syntax
(define *count* 0)
(define (get-count) *count*)
(define (incr-count) (set! *count* (+ *count* 1))))
(define-syntax m
(lambda (x)
(syntax-case x ()
((m) (begin (incr-count) (datum->syntax #'m (get-count)))))))
But I don't think R6RS has anything that corresponds to begin-for-syntax.
I have the following scheme function:
(define get-ivars
(λ (ivars num)
(cond ((null? ivars) '())
(else
(append (list (car ivars) `(nth args ,num)) (list (get-ivars (cdr ivars) (+ num 1))))))))
That returns the following in a specific instance:
(x (nth args 1) (y (nth args 2) ()))
The problem is, I need it to return:
((x (nth args1)) (y (nth args 2)) ())
-the two closing parenthesis at the end should be after the (nth statements.
How would I go about getting this to work properly?
get-ivars caller:
(define gen-classes
(λ (classes)
(cond ((null? classes) '())
(else
(let* ((class (car classes)))
(eval
`(define ,(cadr class)
(λ (args)
(let (
,(get-ivars (cdr (cadddr class)) 1)
)
(eval
(let* ,(cdar (cddddr class))
(λ (method . args)
,(get-methods (cdadr (cddddr class)))
))))))))))))
That second (list ...) in your else clause is what's screwing you up. It's nesting each successive call deeper and deeper. The recursion will naturally create the list; you don't need to wrap it again.
Try:
(define get-ivars
(λ (ivars num)
(if (null? ivars) '()
(cons (list (car ivars) `(nth args ,num))
(get-ivars (cdr ivars) (+ num 1))))))
Regarding the get-ivars caller code, the parentheses surrounding the unquoted call to get-ivars are what's giving you the trouble you mention in the comments. With them, this code:
`(define ClassName
(lambda (args)
(let (,(get-ivars '(iVar1 iVar2 iVar3) 1))
;; your method-getting code
)))
Gives you this:
(define ClassName
(lambda (args)
(let (((iVar1 (nth args 1))
(iVar2 (nth args 2))
(iVar3 (nth args 3))))
;; method-getting code
)))
Which, as you can see, gives you an extra set of parentheses around the assignments in the let.
So you want to do this:
`(define ClassName
(lambda (args)
(let ,(get-ivars '(iVar1 iVar2 iVar3) 1)
;; your method-getting code
)))
get-ivars is returning a list of lists, which is exactly what you want for the assignments in the let, so you don't need to wrap or (as I had it earlier) splice it. Just use the unquote on its own, and the result is:
(define ClassName
(lambda (args)
(let ((iVar1 (nth args 1))
(iVar2 (nth args 2))
(iVar3 (nth args 3)))
;; method-getting code
)))
Which should do the trick.
Incidentally, I found it helpful to leave off the eval when I was playing around with this; one can then visually inspect the result to make sure its syntax is okay.
I haven't tried this, but I think this would work:
(define (get-ivars ivars num)
(if (null? ivars)
'()
(list (list (car ivars) `(nth args ,num))
(get-ivars (cdr ivars) (1+ num)))))
I've been working on a project for school that takes functions from a class file and turns them into object/classes. The assignment is all about object oriented programming in scheme.
My problem however is that my code doesn't format right.
The output it gives me whenever I give it a file to pass in wraps the methods of the class in a list, making it so that the class never really gets declared. I can't for the life of me figure out how to get the parenthesis wrapping the method list to remove.
I would really appreciate any help.
Below is the output, the class file and the code,.
(define pointInstance
(let ((myx 1) (myy 2))
(lambda msg
(cond
(((eq? (car msg) getx) myx)
((eq? (car msg) gety) myy)
((eq? (car msg) setx) (set! myx x))
((eq? (car msg) show) (begin (display "[") (display myx) (display ",") (display myy) (display "]"))))))))
If you look at just after the cond you'll see how all those eq statements are contained in a list. I can't get this to work right unless they're not wrapped by that top level list.
;;;; PART1 --- A super-easy set of classes. Just models points and lines. Tests all of >the
;; basics of class behavior without touching on anything particularly complex.
(class pointInstance (parent:) (constructor_args:)
(ivars: (myx 1) (myy 2))
(methods:
(getx () myx)
(gety () myy)
(setx (x) (set! myx x))
(show () (begin (display "[") (display myx) (display ",") (display myy) (display "]")))
))
(require (lib "trace.ss"))
;; Continue reading until you hit the end of the file, all the while
;; building a list with the contents
(define load-file
(lambda (port)
(let ((rec (read port)))
(if (eof-object? rec)
'()
(cons rec (load-file port))))))
;; Open a port based on a file name using open-input-file
(define (load fname)
(let ((fport (open-input-file fname)))
(load-file fport)))
;(define lis (load "C:\\Users\\Logan\\Desktop\\simpletest.txt"))
;(define lis (load "C:\\Users\\Logan\\Desktop\\complextest.txt"))
(define lis (load "C:\\Users\\Logan\\Desktop\\pointinstance.txt"))
;(display (cdaddr (cdddar lis)))
(define makeMethodList
(lambda (listToMake retList)
;(display listToMake)
(cond
[(null? listToMake)
retList
;(display "The list passed in to parse was null")
]
[else
(makeMethodList (cdr listToMake) (append retList (list (getMethodLine listToMake))))
]
)
))
;(trace makeMethodList)
;this works provided you just pass in the function line
(define getMethodLine
(lambda (functionList)
`((eq? (car msg) ,(caar functionList)) ,(caddar functionList))))
(define load-classes
(lambda paramList
(cond
[(null? paramList) (display "Your parameters are null, man.")]
[(null? (car paramList))(display "Done creating class definitions.")]
[(not (null? (car paramList)))
(begin
(let* ((className (cadaar paramList))
(classInstanceVars (cdaddr (cddaar paramList)))
(classMethodList (cdr (cadddr (cddaar paramList))))
(desiredMethodList (makeMethodList classMethodList '()))
)
;(display "Classname: ")
;(display className)
;(newline)(newline)
;(display "Class Instance Vars: ")
;(display classInstanceVars)
;(newline)(newline)
;(display "Class Method List: ")
;(display classMethodList)
;(newline)
;(display "Desired Method List: ")
;(display desiredMethodList))
;(newline)(newline)
;----------------------------------------------------
;do not delete the below code!`
`(define ,className
(let ,classInstanceVars
(lambda msg
;return the function list here
(cond ,(makeMethodList classMethodList '())))
))
;---------------------------------------------------
))]
)
))
(load-classes lis)
;(load-classes lis)
;(load-classes-helper lis)
;(load-classes "simpletest.txt")
;(load-classes "complextest.txt")
;method list
;(display (cdr (cadddr (cddaar <class>))))
You have too many opening parenthesis in the 1st clause of the cond.
IE:
(((eq? (car msg) getx) myx)
^
Updated:
Are you looking for this?
(cond ,#(makeMethodList classMethodList '())
^^
Or you can do:
(cond . ,(makeMethodList classMethodList '())