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.
Related
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))
In "The Scheme Programming Language 4th Edition" section 3.3 Continuations the following example is given:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
I can confirm it works in chezscheme as written:
> (product '(1 2 3 4 5))
120
What is 'f' in the above let? Why is the given ls being assigned to itself? It doesn't seem to match what I understand about (let ...) as described in 4.4 local binding:
syntax: (let ((var expr) ...) body1 body2 ...)
If 'f' is being defined here I would expect it inside parenthesis/square brackets:
(let ([f some-value]) ...)
This is 'named let', and it's a syntactic convenience.
(let f ([x y] ...)
...
(f ...)
...)
is more-or-less equivalent to
(letrec ([f (λ (x ...)
...
(f ...)
...)])
(f y ...))
or, in suitable contexts, to a local define followed by a call:
(define (outer ...)
(let inner ([x y] ...)
...
(inner ...)
...))
is more-or-less equivalent to
(define (outer ...)
(define (inner x ...)
...
(inner ...)
...)
(inner y ...))
The nice thing about named let is that it puts the definition and the initial call of the local function in the same place.
Cavemen like me who use CL sometimes use macros like binding, below, to implement this (note this is not production code: all its error messages are obscure jokes):
(defmacro binding (name/bindings &body bindings/decls/forms)
;; let / named let
(typecase name/bindings
(list
`(let ,name/bindings ,#bindings/decls/forms))
(symbol
(unless (not (null bindings/decls/forms))
(error "a syntax"))
(destructuring-bind (bindings . decls/forms) bindings/decls/forms
(unless (listp bindings)
(error "another syntax"))
(unless (listp decls/forms)
(error "yet another syntax"))
(multiple-value-bind (args inits)
(loop for binding in bindings
do (unless (and (listp binding)
(= (length binding) 2)
(symbolp (first binding)))
(error "a more subtle syntax"))
collect (first binding) into args
collect (second binding) into inits
finally (return (values args inits)))
`(labels ((,name/bindings ,args
,#decls/forms))
(,name/bindings ,#inits)))))
(t
(error "yet a different syntax"))))
f is bound to a procedure that has the body of let as a body and ls as a parameter.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.16
Think of this procedure:
(define (sum lst)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc))))
(helper lst 0))
(sum '(1 2 3)) ; ==> 6
We can use named let instead of defining a local procedure and then use it like this:
(define (sum lst-arg)
(let helper ((lst lst-arg) (acc 0))
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc)))))
Those are the exact same code with the exception of some duplicate naming situations. lst-arg can have the same name lst and it is never the same as lst inside the let.
Named let is easy to grasp. call/ccusually takes some maturing. I didn't get call/cc before I started creating my own implementations.
I'm learning interpreter for quite a long time, after reading SICP chap 4.1~4.2, I tried to copy these code in my DrRacket in planet neil/sicp mode. I've carefully read these code but still cannot made the code running correctly.
during my copy, I made some changes:
eval function has been renamed to ewal;(because I want to avoid underlying scheme evaluating my code)
apply function has been renamed to epply (except that apply-in-underlying-scheme function);
rearranged the code structure for my better understanding
use #f and #t for my underlying implementation.
I have also disabled the driver-loop since I found the driver-loop never output a value for input.
the code failed to eval a compound procedure correctly, but can handle self-evaluating, define, and other special-form. I double checked the evaluate process, finding that if I change one point (I've marked with (*) in my code), so that the line
((compound-procedure? procedure) (eval-sequence (procedure-body procedure)
modified to
((compound-procedure? procedure) (ewal (procedure-body procedure)
the interpreter can finally eval compound procedure again. I don't know why but I think mine is correct. but SICP can't be wrong. My second question is how to make the driver-loop correctly output eval value.
the interpreter is also included in a gist because it's too long.
#lang planet neil/sicp
;; plot:
;; 1. env operation
;; 2. eval function
;; 3. test and eval for each special form and combination eval
;; 4. REPL
;; 5: test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; environment
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define the-empty-environment '())
(define (first-frame env) (car env))
(define (enclosing-environment env)(cdr env))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; env operation
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(if (< (length vars) (length vals))
(error "Too many args supplied" vars vals)
(error "Too few args supplied" vars vals))))
(define (lookup-variable-value var env)
(define(env-loop env)
(define (scan vars vals)
(cond ((null? vars) (env-loop (enclosing-environment env)))
((eq? var (car vars)) (car vals))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars) (env-loop (enclosing-environment env)))
((eq? var (car vars)) (set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable -- SET!" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (define-variable! var val env)
(let ((frame (first-frame env)))
(define (scan vars vals)
(cond ((null? vars) (add-binding-to-frame! var val frame))
((eq? var (car vars)) (set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(scan (frame-variables frame)
(frame-values frame))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; frame operation
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-frame variables values)
(cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; eval
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (ewal exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((assignment? exp) (eval-assignment exp env))
((definition? exp) (eval-definition exp env))
((if? exp) (eval-if exp env))
((lambda? exp) (make-procedure (lambda-parameters exp)
(lambda-body exp)
env))
((begin? exp) (eval-sequence (begin-actions exp) env))
((cond? exp) (ewal (cond->if exp) env))
((application? exp) (epply (ewal (operator exp) env)
(list-of-values (operands exp) env)))
(else (error "Unknown type -- EWAL" exp))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; self-eval test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (self-evaluating? exp)
(cond ((number? exp) #t)
((string? exp) #t)
(else #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; variable test an eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (variable? exp) (symbol? exp))
;; (lookup-variable-value exp env) see below
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; quote test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (quoted? exp)
(tagged-list? exp 'quote))
(define (text-of-quotation exp) (cadr exp))
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
#f))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; assignment test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp) (cadr exp))
(define (assignment-value exp) (caddr exp))
(define (eval-assignment exp env)
(set-variable-value! (assignment-variable exp)
(ewal (assignment-value exp) env)
env)
'ok)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; definition test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda (cdadr exp) ;;formal parameters
(cddr exp)))) ;;body
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (eval-definition exp env)
(define-variable! (definition-variable exp)
(ewal (definition-value exp) env)
env)
'ok)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lambda test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (caddr exp))
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; if test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cadddr exp)))
(cadddr exp)
'false))
(define (eval-if exp env)
(if (true? (ewal (if-predicate exp) env))
(ewal (if-consequent exp) env)
(ewal (if-alternative exp) env)))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; begin test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (begin? exp) (tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (eval-sequence exps env)
(cond ((last-exp? exps) (ewal (first-exp exps) env))
(else (ewal (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; application test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (ewal (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
(define (epply procedure arguments)
(cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments))
((compound-procedure? procedure) (ewal (procedure-body procedure) ;; (*)
(extend-environment (procedure-parameters procedure)
arguments
(procedure-environment procedure))))
(else (error "Unkown procedure type -- EPPLY" procedure))))
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
(define (primitive-implementation proc) (cadr proc))
(define (compound-procedure? p) (tagged-list? p 'procedure))
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))
(define (apply-primitive-procedure proc args)
(apply-in-underlying-scheme (primitive-implementation proc) args))
(define apply-in-underlying-scheme apply)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cond test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
(define (expand-clauses clauses)
(if (null? clauses)
'false
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF" clauses))
(make-if (cond-predicate first)
(sequence->exp(cond-actions first))
(expand-clauses rest))))))
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
(define (sequence->exp seq)
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))
(define (make-begin seq) (cons 'begin seq))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; env setup
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (setup-environment)
(let ((initial-env
(extend-environment (primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)))
(define-variable! '#t #t initial-env)
(define-variable! '#f #f initial-env)
initial-env))
(define primitive-procedures
(list(list 'car car)
(list 'cdr cdr)
(list 'null? null?)
(list 'cons cons)
(list '+ +)
(list '- -)
(list '* *)
(list '/ /)
(list '= =)))
(define (true? x)
(not (eq? x false)))
(define (false? x)
(eq? x false))
(define (primitive-procedure-names)
(map car primitive-procedures))
(define (primitive-procedure-objects)
(map (lambda (proc) (list 'primitive (cadr proc)))
primitive-procedures))
(define the-global-environment (setup-environment))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define input-prompt "M-Eval input:")
(define output-prompt "M-Eval value:")
(define (driver-loop)
(prompt-for-input input-prompt)
(let ((input (read)))
(let ((output (ewal input the-global-environment)))
(announce-output output-prompt)
(user-print output)))
(driver-loop))
(define (prompt-for-input string)
(newline)
(newline)
(display string)
(newline))
(define (announce-output string)
(newline)
(display string)
(newline))
(define (user-print object)
(if (compound-procedure? object)
(display (list 'compound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env>))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define env0 the-global-environment)
(ewal '(define (p1 x) (+ x 1)) env0 )
(ewal '(p1 4) env0)
(ewal '(define (append x y)
(if (null? x)
y
(cons (car x)
(append (cdr x) y)))) env0)
(ewal '(define (factorial n)
(if (= 1 n)
1
(* n (factorial (- n 1))))) env0)
(ewal '(factorial 5) env0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; init main loop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(driver-loop)
;; this is commented since I found it run incorrectly
update :
#Will Ness said:
about the eval-sequence, your procedure-body function is incorrect. it
should be cddr, not caddr, to match the eval-sequence's expectations.
I think my procedure-body def is right. consider I am interpreting this exp:
((lambda (n)
(if (= 1 n)
1
0))
5)
this is an application, and the operator can be evaluated by eval
(ewal (operator '((lambda (n)
(if (= 1 n)
1
0))
5)) env0)
so the value of operator is a list(closure) like this:
(procedure (n) (if (= 1 n) 1 0) #new-env)
if my procedure-body is caddr of the closure, the body will be (if (= 1 n) 1 0).
but if I change procedure-body into (cddr p), procedure-body will become like : ((if (= 1 n) 1 0) #new-env)
this means the #new-env will be a part of my procedure body. anyway this is not incorrect because procedure body should not include the closure's environment.
but indeed, this interpreter cannot handle a function whose body is composed by a list of expressions. In this case, I don't know how to extract the body(exp list) from the closure.
about the eval-sequence, your procedure-body function is incorrect. it should be cddr, not caddr, to match the eval-sequence's expectations.
about the driver-loop, it uses user-print to show the output, but user-print is incomplete. it only shows values which are compound procedures, not anything else.
in my interpreter, the case lambda cannot eval a function whose body is composed by a list of expressions, bacause lambda-bodyis defined as (caddr exp). I should modify it :
(define (lambda-body exp) (cddr exp))
and in my epply function, the condition compound-procedure should eval-sequence of procedure body, because now procedure body is a list of expressions, not a expression.
------------------------------------update-------------------------------------
I can make it work pretty well with this.
(define (handle-cond exp env)
(if (null? exp) (newline)
(if (eq? (caar exp) 'else) (my-eval (cadar exp) env)
(if (my-eval (caar exp) env) (my-eval (cadar exp) env) (my-eval (cons 'cond (cdr exp)) env)))))
Only difference between this and the system's cond is that when no condition is true,
it'll print a #void, I don't quite understand why, but other than this, it works fine.
Thank you all for answering.
You would have to turn the cond statement, into a series of nested ifs. So suppose that each cond clause is something like this:
(cond
(<expr1> <expr2>)
(<expr3> <expr4>)
(else <expr5>))
; This would become:
(if <expr1>
<expr2>
(if <expr3>
<expr4>
<expr5>))
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 '())