I have a file like this:
declare
a = aexpress
b = bexpress
begin
My scheme program sets the current input port to this file then calls
(declarations (read))
What im getting back, is #f.
or rather the console says "The object #f is not applicable."
I have been over my parenthesis use and cant find any reason it should be returning a boolean value, but I'm sure I'm missing something.
What I want, is ((a aexpress) (b bexpress))
(define declarations
(lambda (token)
(cond (((eq? token 'begin) '())
(else (let* ((name token)
(eqsign (read))
(value (read)))
(cons (list name value) (declarations (read)))))))))
Called by:
(define convert
(lambda (filename)
(begin
(set-current-input-port! (open-input-file filename))
(statement (read))
)
)
)
(define statement (lambda (token) (
cond (
( (eq? token 'declare) (declarations (read)) )
; ( (eq? token 'declare) (declare_statement) )
; ( (eq? token 'begin) (begin_statement) )
; ( (eq? token 'for) (for_statement) )
; ( (eq? token 'if) (if_statement) )
; ( (eq? token 'set) (set_statement) )
; (else (expression_token))
))))
I've fixed the code formatting for you, which reveals what the problem is: you have too many layers of brackets around the (eq? token 'begin). The fixed version would look like this:
(define declarations
(lambda (token)
(cond ((eq? token 'begin) '())
(else (let* ((name token)
(eqsign (read))
(value (read)))
(cons (list name value) (declarations (read))))))))
Related
I have a basic character rotation algorithm, and I need to store the user input into a global variable named key. How can I modify key with a user inputted value?
;Global variable to be modified
(define key 0)
;encryptor
(define encrypt
(lambda(str)
(+ key (read))
(list->string(map encryptor (string->list str)))
)
)
(define encryptor
(lambda (ch)
(if (char-alphabetic? ch)
(rotator ch)
ch
)
)
)
;char incrementor that utilizes the key.
(define rotator
(lambda (ch)
(integer->char(+ (char->integer ch) key)
)
)
)
You don't need a global variable, you need to restructure your functions.
Separate user interaction from processing (this is a good idea in general) by making the key a function parameter.
(define (encrypt key str)
(lambda(str)
(list->string(map (lambda (ch) (encryptor key ch)) (string->list str)))))
(define (encryptor key ch)
(if (char-alphabetic? ch)
(rotator key ch)
ch))
(define (rotator key ch)
(integer->char (+ (char->integer ch) key)))
;; Example use:
(let ((key (read))
(input (read)))
(encrypt key input))
To get an encryption function that encapsulates the key, make a function that produces a function where the key is "captured" (this is sometimes called a "closure"):
(define (encryptor key ch)
(lambda (ch)
(if (char-alphabetic? ch)
(rotator key ch)
ch)))
Example:
> (define crypt-1 (encryptor 1))
> crypt-1
#<procedure>
> (crypt-1 #\a)
#\b
> (crypt-1 #\b)
#\c
> (crypt-1 #\1)
#\1
Now you can simplify encrypt:
(define (encrypt key str)
(list->string (map (encryptor key) (string->list str))))
I am writing a function called ptyper that takes a nested list, nl. This function replaces all occurrences of a number with n and all occurrences of a symbol with s. This is what I have now:
(define (ptyper nl) (cond
((null? nl) '())
((list? nl)
(let ((ls (car nl)))
(list (ptyper ls))))
((number? (car nl))
(cons "n" (cdr nl)))
((symbol? (car nl))
(cons "s" (cdr nl)))
(else
(cons (car nl) (cdr nl)))))
I ran this test (ptyper '(2 (abc () "abc"))) but received an error that their was a contract violation. I'm not exactly sure what I'm doing wrong so if could use some help. Thanks!
Here is a possible solution with one function:
(define (ptyper nl)
(cond
((null? nl) '()) ; if the argument is an empty list, return the empty list
((list? nl) ; if the argument is a list, then
(let* ((c (car nl)) ; get its first element
(nc (cond ((number? c) "n") ; transform it for numbers
((symbol? c) "s") ; and symbols
((list? c) (ptyper c)) ; if a list recur over it
(else c)))) ; otherwise (e.g. a string) return as it is
(cons nc (ptyper (cdr nl))))) ; recursive call on the rest of the list
(else nl))) ; this should never happen for the specification,
; return the parameter or cause an error
Note that the error in your case is caused by the recursive call. When the function is called on an atom, for instance 2, first it checks for null and list?, and those checks returns false. Then it checks for (number (car nl)), but nl is equal to 2 and so car fails.
Here is a data definition for an S-expression, this models your data.
; An S-expr is one of:
; – Atom
; – SL
; An SL is one of:
; – '()
; – (cons S-expr SL)
; An Atom is one of:
; – Number
; – String
; – Symbol
We have predicates for every kind of data except Atom, so we make atom?:
;; Any -> Boolean
;; is the x an atom?
(define (atom? x)
(not (list? x)))
We follow the structure of the data to build "templates" for our functions:
(define (func sexp)
(cond
[(atom? sexp) (func-atom sexp)]
[else (func-sl sexp)]))
(define (func-sl sl)
(cond
[(empty? sl) ...]
[else (... (func (first sl)) ... (func-sl (rest sl)) ...)]))
(define (func-atom at)
(cond
[(number? at) ...]
[(string? at) ...]
[(symbol? at) ...]))
We fill in the gaps:
; Atom -> String
(define (subs-atom at)
(cond
[(number? at) "n"]
[(string? at) at]
[(symbol? at) "s"]))
; SL -> SL
(define (subs-sl sl)
(cond
[(empty? sl) sl]
[else (cons (subs-sexp (first sl))
(subs-sexp (rest sl)))]))
; S-exp -> S-exp
(define (subs-sexp sexp)
(cond
[(atom? sexp) (subs-atom sexp)]
[else (subs-sl sexp)]))
Using the interface for ptyper:
(define (ptyper nl)
(subs-sexp nl))
(ptyper '(2 (abc () "abc")))
; => '("n" ("s" () "abc"))
I am trying to make a 'pseudo OO system':
(defun bank-account ()
(let ((balance))
(labels ((init (x)
(setf balance x))
(increment (x)
(setf balance (+ balance x)))
(get-balance ()
balance))
(lambda (func)
(case func (init #'init)
(increment #'increment)
(get-balance #'get-balance))))))
(defparameter bank-account-object (bank-account))
(funcall (funcall bank-account-object 'init) 42)
(funcall (funcall bank-account-object 'increment) 10)
(funcall (funcall bank-account-object 'get-balance))
Q: are there better ways to accomplish the same without using CLOS, defstruct, or defmacro?
The problem that I see with this is that it is closed for extension, and I see no simple way to add extensibility.
Minor nitpick: that's not a bank-system but a bank-account. When you think about that further, it seems to me that the interesting part about this example domain has not been touched: double accounting, i. e. ensuring the null-sum invariant.
There are two sayings: a closure is a poor man's object, and an object is a poor man's closure. I have the feeling that you are more in the realm of the former here. However, it might be a good learning experience to think about this—as long as you don't put it into production somewhere…
;; The "class"
(defun create-bank-account ()
(let ((balance))
(labels ((init (x)
(setf balance x))
(increment (x)
(setf balance (+ balance x)))
(get-balance ()
balance))
(lambda (func)
(case func (init #'init)
(increment #'increment)
(get-balance #'get-balance))))))
;; The "methods"
(defun init-balance (object amount)
(funcall (funcall object 'init) amount))
(defun increment-balance (object amount)
(funcall (funcall object 'increment) amount))
(defun get-balance (object)
(funcall (funcall object 'get-balance)))
;; Example usage
(defparameter bank-account (create-bank-account))
(init-balance bank-account 42) ; => 42
(increment-balance bank-account 10) ; => 52
(get-balance bank-account) ; => 52
As mentioned in other answers, the resulting object might be hard to extend. That could be a feature, but one possible way to improve on it is to let it be redefined dynamically. You can even switch from classes to protoypes.
(ql:quickload :optima)
(defpackage :obj (:use :cl :optima))
(in-package :obj)
(defun make-object (&optional prototype)
(let ((properties (make-hash-table :test #'eq))
(self))
(flet ((resolve (key)
(or (gethash key properties)
(and prototype (funcall prototype :get key)))))
(setf self
(lambda (&rest args)
(optima:ematch args
((list :get :prototype) prototype)
((list :get key) (resolve key))
((list :set :prototype p)
(cerror "Continue" "Changing prototype object, are you sure?")
(setf prototype p))
((list :set key value)
(if value
(setf (gethash key properties) value)
(remhash key properties)))
((list :invoke method args)
(let ((resolved (resolve method)))
(if resolved
(apply resolved self args)
(funcall (or (resolve :no-such-method)
(error "No such method: ~a in ~a"
method
self))
self
method))))))))))
Some helper symbols:
;; call built-in command
(defmacro $ (obj method &rest args)
`(funcall ,obj ,method ,#args))
;; access property
(declaim (inline # (setf #)))
(defun # (o k) ($ o :get k))
(defun (setf #) (v o k) ($ o :set k v))
;; invoke method
(defun % (o m &rest a)
($ o :invoke m a))
A simple test
(let ((a (make-object)))
;; set name property
(setf (# a :name) "a")
;; inherit
(let ((b (make-object a)))
(print (list (# b :name)
;; shadow name property
(setf (# b :name) "b")
(# a :name)))
;; define a method
(setf (# a :foo) (lambda (self) (print "FOO")))
;; invoke it
(% a :foo)))
Bank account
(defun create-bank-account (&optional parent)
(let ((account (make-object parent)))
(prog1 account
(setf (# account :init)
(lambda (self x)
(setf (# self :balance) x)))
(setf (# account :increment)
(lambda (self increment)
(incf (# self :balance) increment))))))
(let ((account (create-bank-account)))
(% account :init 0)
(% account :increment 100)
(# account :balance))
100
I have the menu which is created in the options function and the functionality of that is to have the user input a number (1 or 2 or 3) in order to solve the problem with the chosen method (DFS, BFS, BESTFS). This method is supposed to return what the user selected in this line of code
(SearchProblem '(0 0 2 6 4) '(0 0 0 0 0) (Options)) in the end. The problem is that when I compile the problem it displays this error "Undefined function DFS called with arguments ().". How can I fix that?
Code
; ----------------------------------------------------------------------------
; ******** Search Code for DFS and other search methods
; ******** (expanding front and extending queue)
; ******** author: AI lab
; ********
; ******** Κώδικας για DFS και άλλες μεθόδους αναζήτησης
; ******** (επέκταση μετώπου και διαχείριση ουράς)
; ******** Συγγραφέας: Εργαστήριο ΤΝ
; ----------------------------------------------------------------------------
; **** starting search
; **** έναρξη αναζήτησης
(defun searchProblem (start-state goal method )
( cond
((StateValidation start-state)(print "Invalid data!") nil)
( T (findSolution (MakeFront start-state) (MakeQueue start-state) () goal method ) )
)
;(print '____BEGIN_SEARCHING_____ )
)
; **** Checking for valid states
(defun StateValidation (state)
(cond
( (or (> (first state) 3) (<(first state) 0)) t)
(T nil)
)
)
; ----------------------------------------------------------------------------
; **** Basic recursive function to create search tree (recursive tree expantion)
; **** Βασική αναδρομική συνάρτηση για δημιουργία δέντρου αναζήτησης (αναδρομική επέκταση δέντρου)
(defun FindSolution (front queue closed goal method )
(cond
((null front) 'no_solution)
((mymember (car front) closed) (FindSolution (cdr front) (cdr queue) closed goal method ))
((equal (car front) goal) (format T "This is the solution: ~a" (reverse (first queue))))
(T (FindSolution (ExpandFront front method) (ExtendQueue queue method) (cons (car front) closed) goal method ))
)
)
; ----------------------------------------------------------------------------
; **** FRONT
; **** Διαχείριση Μετώπου
; ----------------------------------------------------------------------------
; ** initialization of front
; ** Αρχικοποίηση Μετώπου
(defun MakeFront (node)
(list node)
)
; ----------------------------------------------------------------------------
; **** expanding front
; **** επέκταση μετώπου
(defun ExpandFront (front method)
(cond
( (eq method 'DFS) (append ( removeNils ( findchildren (car front))) (cdr front) ) )
( (eq method 'BFS) (append (cdr front) ( removeNils (findchildren (car front)))))
( (eq method 'BESTFS) (sort (append ( removeNils ( findchildren (car front))) (cdr front))#'check) )
( T "other methods to be added" )
)
)
; ----------------------------------------------------------------------------
; **** QUEUE
; **** Διαχείριση ουράς
; ----------------------------------------------------------------------------
; ** initialization of queue
; ** Αρχικοποίηση ουράς
(defun MakeQueue (node)
(list (list node))
)
; ----------------------------------------------------------------------------
; **** expanding queue
; **** επέκταση ουράς
;;; expanding queue
(defun ExtendQueue (queue method)
(cond
( (eq method 'DFS) (append ( growPath (car queue)) (rest queue) ) )
( (eq method 'BFS) (append (rest queue) (growPath (car queue)) ) )
( (eq method 'BESTFS) (sort (append ( growPath (car queue) ) (rest queue))#'check1) )
( T "other methods to be added" )
)
)
(defun check (s1 s2)
(< (+ (third s1) (fourth s1) (fifth s1)) (+ (third s2) (fourth s2) (fifth s2)) )
)
(defun check1 (s1 s2)
(< (+ (third (first s1)) (fourth (first s1)) (fifth (first s1))) (+ (third (first s2)) (fourth (first s2)) (fifth (first s2))))
)
(defvar opt 0) ;Variable definition for the menu
;----------Otptions menu------------------------------------------------------
(defun Options ()
( print "Searching methods." )
( print "For DFS method press 1." )
( print "For BFS method press 2." )
( print "For BESTFS method press 3." )
( print "Choose searching method" )
( let (opt (read)))
(cond
( ( = opt 1 ) (T (DFS) ) )
( ( = opt 2 ) (T (BFS) ) )
( ( = opt 3 ) (T (BESTFS) ) )
)
( T (nil) )
)
; ----------------------------------------------------------------------------
; **** growing path towards each different child of the selected parent node
; **** επεκταση μονοπατιου προς καθε διαφορετικό παιδί-κόμβο από τον επιλεγμένο γονέα-κόμβο
(defun growPath (path)
(removecycles (grow1 path (removeNils (findchildren (car path)))))
)
(defun grow1 (path children)
(cond
((null children) nil )
( T (cons (cons (car children) path) (grow1 path (cdr children))) )
)
)
; ----------------------------------------------------------------------------
; **** Supportive functions
; **** Υποστηρικτικές συναρτήσεις
(defun mymember(x Y)
(cond
((endp y) nil )
((equal x (first y)) T )
(T (mymember x (rest y)) )
)
)
(defun removeNils (X)
(cond
((endp x) nil )
((eq (first x) NIL) (removeNils (rest x)) )
(T (cons (first x) (removeNils (rest x))) )
)
)
(defun removecycles (paths)
(cond
((null paths) nil )
((member (caar paths) (cdar paths)) (removecycles (cdr paths)) )
(T (cons (car paths) (removecycles (cdr paths))) )
)
)
; ----------------------------------------------------------------------------
; **** Problem's World & Problem depending functions
; **** κόσμος του προβλήματος (αν απαιτείται) και συναρτήσεις σχετικές με το πρόβλημα
;;;; #### to be added ####
(defvar capacity 5)
(defun goToGround (state)
(cond
( (or (= (+ (third state) (fourth state) (fifth state)) 0) (= (second state) capacity))
(list 0 0 (third state)(fourth state)(fifth state))
)
(T nil)
)
)
(defun goToFirst (state)
(cond
(
(and (< (second state) capacity) (> (third state) 0))
(goToFirst (list 1 (+ (second state) 1) (- (third state) 1) (fourth state) (fifth state)))
)
(T (list (first state) (second state) (third state) (fourth state) (fifth state)))
)
)
(defun goToSecond (state)
(cond
(
(and (< (second state) capacity) (> (fourth state) 0))
(goToSecond (list 2 (+ (second state) 1) (third state) (- (fourth state) 1) (fifth state)))
)
(T (list (first state) (second state) (third state) (fourth state) (fifth state)))
)
)
(defun goToThird (state)
(cond
(
(and (< (second state) capacity) (> (fifth state) 0))
(goToThird (list 3 (+ (second state) 1) (third state) (fourth state) (- (fifth state) 1)))
)
(T (list (first state) (second state) (third state) (fourth state) (fifth state)))
)
)
; ----------------------------------------------------------------------------
; ** function to find the children nodes of a parent state node
; ** συνάρτηση εύρεσης απογόνων
(defun findchildren (state)
(list (goToGround state) (goToFirst state) (goToSecond state) (goToThird state))
)
; ----------------------------------------------------------------------------
; ** Executing the code
; ** κλήση εκτέλεσης κώδικα
;(trace SearchProblem)
(SearchProblem '(0 0 2 6 4) '(0 0 0 0 0) (Options) )
I heavily recommend you to properly indent common-lisp code following existing guidelines, else the parentheses are a mess.
Here, using slime and regex search and replace, I properly indented your code and simplified some stuff and also by this indenting - discovered some parenthesis mistakes.
And I corrected them.
By the level of the indentation, you can see, where paren mistakes occur.
To your question, I suggest:
(defun options ()
(print "Searching methods.")
(print "For DFS method press 1.")
(print "For BFS method press 2.")
(print "For BESTFS method press 3.")
(print "Choose searching method")
(let ((opt (read))) ;; here were some paren' mistakes!
(case opt ;; case is the `switch` in cl
(1 'DFS)
(2 'BFS)
(3 'BESTFS) ;; here was an erroneous parenthesis
(otherwise 'nil)))) ;; here one paren' added
The whole code correctly indented (using emacs SLIME mode for common-lisp) and with some changes for simplification:
;; --------------------------------------------------
;; ******** Search Code for DFS and other search methods
;; ******** (expanding front and extending queue)
;; ******** author: AI lab
;; ********
;; ******** Κώδικας για DFS και άλλες μεθόδους αναζήτησης
;; ******** (επέκταση μετώπου και διαχείριση ουράς)
;; ******** Συγγραφέας: Εργαστήριο ΤΝ
;; --------------------------------------------------
;; **** starting search
;; **** έναρξη αναζήτησης
(defun searchProblem (start-state goal method)
(if (StateValidation start-state)
(print "Invalid data!") ;; print returns nil
(findSolution (MakeFront start-state)
(MakeQueue start-state)
()
goal
method)))
;;**** Checking for valid states
(defun StateValidation
(or (> (first state) 3)
(< (first state) 0))) ;; if condition is true, returns T else nil
;;--------------------------------------------------
;;**** Basic recursive function to create search tree (recursive tree expantion)
;;**** Βασική αναδρομική συνάρτηση για δημιουργία δέντρου αναζήτησης (αναδρομική επέκταση δέντρου)
(defun FindSolution (front queue closed goal method)
(cond ((null front) 'no_solution)
((mymember (car front) closed)
(FindSolution (cdr front)
(cdr queue)
closed
goal
method))
((equal (car front) goal)
(format T "This is the solution: ~a" (reverse (first queue))))
(T (FindSolution (ExpandFront front method)
(ExtendQueue queue method)
(cons (car front) closed)
goal
method))))
;;--------------------------------------------------
;;**** FRONT
;;**** Διαχείριση Μετώπου
;;--------------------------------------------------
;;** initialization of front
;;** Αρχικοποίηση Μετώπου
(defun MakeFront (node)
(list node))
;;--------------------------------------------------
;;**** expanding front
;;**** επέκταση μετώπου
(defun ExpandFront (front method)
(case method
(DFS (append (removeNils (findchildren (car front)))
(cdr front)))
(BFS (append (cdr front)
(removeNils (findchildren (car front)))))
(BESTFS (sort (append (removeNils (findchildren (car front)))
(cdr front)) #'check))
(otherwise "other methods to be added")))
;;--------------------------------------------------
;;**** QUEUE
;;**** Διαχείριση ουράς
;;--------------------------------------------------
;;** initialization of queue
;;** Αρχικοποίηση ουράς
(defun MakeQueue (node)
(list (list node)))
;;--------------------------------------------------
;;**** expanding queue
;;**** επέκταση ουράς
;;; expanding queue
(defun ExtendQueue (queue method)
(case method
(DFS (append (growPath (car queue))
(rest queue)))
(BFS (append (rest queue)
(growPath (car queue))))
(BESTFS (sort (append (growPath (car queue))
(rest queue)) #'check1))
(otherwise "other methods to be added")))
#|
(defun check (s1 s2)
(< (+ (third s1)
(fourth s1)
(fifth s1))
(+ (third s2)
(fourth s2)
(fifth s2))))
|#
(defun sum-3rd-to-5th (s)
(+ (third s) (fourth s) (fifth s)))
(defun check (s1 s2)
(< (sum-3rd-to-5th s1)
(sum-3rd-to-5th s2)))
(defun check1 (s1 s2)
(check (first s1) (first s2))) ;; this is equivalent to before - uses `check` above
(defvar opt 0) ;Variable definition for the menu
;;----------Otptions menu------------------------------------------------------
(defun options ()
(print "Searching methods.")
(print "For DFS method press 1.")
(print "For BFS method press 2.")
(print "For BESTFS method press 3.")
(print "Choose searching method")
(let ((opt (read))) ;; parenthesis mistakes also here!
(case opt
(1 'DFS)
(2 'BFS)
(3 'BESTFS) ;; here was an erroneous paranthesis
(otherwise 'nil)))) ;; here one added
;;--------------------------------------------------
;;**** growing path towards each different child of the selected parent node
;;**** επεκταση μονοπατιου προς καθε διαφορετικό παιδί-κόμβο από τον επιλεγμένο γονέα-κόμβο
(defun growPath (path)
(removecycles (grow1 path (removeNils (findchildren (car path))))))
(defun grow1 (path children)
(cond ((null children) nil)
(T (cons (cons (car children) path)
(grow1 path (cdr children))))))
;;--------------------------------------------------
;;**** Supportive functions
;;**** Υποστηρικτικές συναρτήσεις
#|
(defun mymember(x y)
(cond ((null y) nil)
((equal x (first y)) T)
(T (mymember x (rest y)))))
(defun removeNils (x)
(cond ((null x) nil)
((eq (first x) NIL) (removeNils (rest x)))
(T (cons (first x)
(removeNils (rest x))))))
|#
(defun mymember (x y)
(member x y :test #'equal))
(defun removeNils (x)
(remove-if #'null x))
(defun removecycles (paths)
(cond ((null paths) nil)
((member (caar paths)
(cdar paths))
(removecycles (cdr paths)))
(T (cons (car paths)
(removecycles (cdr paths))))))
;;--------------------------------------------------
;;**** Problem's World & Problem depending functions
;;**** κόσμος του προβλήματος (αν απαιτείται) και συναρτήσεις σχετικές με το πρόβλημα
#| isn't state a list of 5 elements?
(list (first state)
(second state)
(third state)
(fourth state)
(fifth state)) ;; ===> state
|#
;;;; #### to be added ####
(defvar capacity 5)
(defun goToGround (state)
(if (or (zerop (sum-3rd-to-5th state))
(zerop (second state) capacity))
(list 0
0
(third state)
(fourth state)
(fifth state))
nil))
(defun goToFirst (state)
(if (and (< (second state) capacity)
(> (third state) 0))
(goToFirst (list 1
(1+ (second state))
(1- (third state))
(fourth state)
(fifth state)))
state))
(defun goToSecond (state)
(if (and (< (second state) capacity)
(> (fourth state) 0))
(goToSecond (list 2
(1+ (second state))
(third state)
(1- (fourth state))
(fifth state)))
state))
(defun goToThird (state)
(if (and (< (second state) capacity)
(> (fifth state) 0))
(goToThird (list 3
(1+ (second state))
(third state)
(fourth state)
(1- (fifth state))))
state))
;;--------------------------------------------------
;;** function to find the children nodes of a parent state node
;;** συνάρτηση εύρεσης απογόνων
(defun findchildren (state)
(list (goToGround state)
(goToFirst state)
(goToSecond state)
(goToThird state)))
;;--------------------------------------------------
;;** Executing the code
;;** κλήση εκτέλεσης κώδικα
;; (trace SearchProblem)
(SearchProblem '(0 0 2 6 4)
'(0 0 0 0 0)
(Options))
You're trying to call DFS, BFS, and BESTFS as functions. They're just symbols that should be returned, and they'll be passed on to other functions as parameters.
They shouldn't be wrapped in (T ...), either. And (T (nil)) needs to be a clause of the COND, not after it. And again, nil shouldn't be inside parentheses, that means to try to call it as a function. You don't really need this clause, though, since COND returns NIL by default if none of the conditions match.
The code that tests opt needs to be inside the let that binds it.
(defun Options ()
( print "Searching methods." )
( print "For DFS method press 1." )
( print "For BFS method press 2." )
( print "For BESTFS method press 3." )
( print "Choose searching method" )
( let (opt (read))
(cond
( ( = opt 1 ) 'DFS )
( ( = opt 2 ) 'BFS )
( ( = opt 3 ) 'BESTFS )
( T nil )))
)
)
New to scheme and currently working on a lexical analyzer. Below is my code and I am getting the error
map: contract violation
expected: list?
given: #
argument position: 2nd
other arguments...:
#
#lang racket
(define tokens '((dog noun)
(cat noun)
(chases verb)
(the article)))
(define (getToken word)
(cadr (assq word tokens)))
(define ttw (lambda (l)
(map getToken l)))
(define (parse-sentence list)
(article list))
(define (article list)
(if (eq? (car list) 'article)
(begin
(display "Article: ")
(display (car list))
(noun (cdr list))
)
(begin
(display "Not an Article!!!")
(display (car list)))
))
(define (noun list)
(if (eq? (car list) 'noun)
(begin
(display "Noun:")
(display (car list))
(noun (cdr list))
)
"Not a noun!!!")
)
(begin
(display "Enter a Sentance in (): ")
(let ((input (read)))
(ttw (parse-sentence input))))
My input is (the dog chases the cat)
Running the program, I see that DrRacket colors this expression red:
(map getToken l)
which is part of the function
(define ttw (lambda (l)
(map getToken l)))
and since the error is
map: contract violation
expected: list?
given: #<void>
argument position: 2nd
other arguments...:
we now know that ttw is called with void as input and not a list as expected.
Where is ttw called? Clicking the "Check Syntax" icon (the check mark with the magnifying glass) and then hovering the mouse over ttw shows all uses.
The only use is in:
(ttw (parse-sentence input))
This means that parse-sentence returned void. Let's see the definition of parse-sentence:
(define (parse-sentence list)
(article list))
Okay, so the error must be in article:
(define (article list)
(if (eq? (car list) 'article)
(begin
(display "Article: ")
(display (car list))
(noun (cdr list))
)
(begin
(display "Not an Article!!!")
(display (car list)))
))
And here we see this:
(if ...
...
(begin
(display "Not an Article!!!")
(display (car list))))
The construct begin returns the value of the last expression. Here (display ...) returns void.
Checking the output, we see right before the error message:
Not an Article!!!the
So the problem is that article returns something other than a list.
However since you have found an error, I suggest you look into the function error. Something like: (error 'article (~a "Not an article, got: " (car list)). If you use error DrRacket will directly show you that an error has been found in article.