Re: question about DrScheme

[Matthias Felleisen <matthias@cs.rice.edu>]

You have the "add extra parens" problem. People who know other languages
often think that parentheses are optional. They are not. Every pair of
parentheses means something in Scheme (most common: apply the value of the
first expression to the values of the others). 

I have removed those pairs of parens that get in your way (see "; mf "
comments). Now you get

  > (parse '(4 + 3 * 2))
  (+ (4) (* (3) (2)))

I am not sure whether this is what you want. It looks odd.

See www.htdp.org for further information on designing Scheme programs. 

-- Matthias



  (define word?
    (let ((number? number?)
	  (symbol? symbol?)
	  (string? string?))
      (lambda (x)
	(or (symbol? x) (number? x) (string? x)))))

  (define whoops
    (let ((string? string?)
	  (string-append string-append)
	  (error error)
	  (cons cons)
	  (map map)
	  (apply apply))
      (define (error-printform x)
	(if (string? x)
	    (string-append "\"" x "\"")
	    x))
      (lambda (string . args)
	(apply error (cons string (map error-printform args))))))

  (define word->string
    (let ((number? number?)
	  (string? string?)
	  (number->string number->string)
	  (symbol->string symbol->string))
      (lambda (wd)
	(cond ((string? wd) wd)
	      ((number? wd) (number->string wd))
	      (else (symbol->string wd))))))

  (define empty?
    (let ((null? null?)
	  (string? string?)
	  (string=? string=?))
      (lambda (x)
	(or (null? x)
	    (and (string? x) (string=? x ""))))))

  (define member?
    (let ((> >) (- -) (< <)
	  (null? null?)
	  (symbol? symbol?)
	  (eq? eq?)
	  (car car)
	  (not not)
	  (symbol->string symbol->string)
	  (string=? string=?)
	  (cdr cdr)
	  (equal? equal?)
	  (word->string word->string)
	  (string-length string-length)
	  (whoops whoops)
	  (string-ref string-ref)
	  (char=? char=?)
	  (list? list?)
	  (number? number?)
	  (empty? empty?)
	  (word? word?)
	  (string? string?))
      (define (symbol-in-list? symbol string lst)
	(cond ((null? lst) #f)
	      ((and (symbol? (car lst))
		    (eq? symbol (car lst))))
	      ((string? (car lst))
	       (cond ((not string)
		      (symbol-in-list? symbol (symbol->string symbol) lst))
		     ((string=? string (car lst)) #t)
		     (else (symbol-in-list? symbol string (cdr lst)))))
	      (else (symbol-in-list? symbol string (cdr lst)))))
      (define (word-in-list? wd lst)
	(cond ((null? lst) #f)
	      ((equal? wd (car lst)) #t)
	      (else (word-in-list? wd (cdr lst)))))
      (define (word-in-word? small big)
	(let ((one-letter-str (word->string small)))
	  (if (> (string-length one-letter-str) 1)
	      (whoops "Invalid arguments to MEMBER?: " small big)
	      (let ((big-str (word->string big)))
		(char-in-string? (string-ref one-letter-str 0)
				 big-str
				 (- (string-length big-str) 1))))))
      (define (char-in-string? char string i)
	(cond ((< i 0) #f)
	      ((char=? char (string-ref string i)) #t)
	      (else (char-in-string? char string (- i 1)))))
      (lambda (x stuff)
	(cond ((empty? stuff) #f)
	      ((word? stuff) (word-in-word? x stuff))
	      ((not (list? stuff))
	       (whoops "Invalid second argument to MEMBER?: " stuff))
	      ((symbol? x) (symbol-in-list? x #f stuff))
	      ((or (number? x) (string? x))
	       (word-in-list? x stuff))
	      (else (whoops "Invalid first argument to MEMBER?: " x))))))

  (define (parse expr)
    (parse-helper expr '() '()))

  (define (parse-helper expr operators operands)
    (cond ((null? expr)
	   (if (null? operators)
	       (car operands) ;; mf 
	       (handle-op '() operators operands)))
	  ((number? (car expr))
	   (parse-helper (cdr expr)
			 operators
			 (cons (cons (car expr) '()) operands))) ; mf
	  ((list? (car expr))
	   (parse-helper (cdr expr)
			 operators
			 (cons (parse (car expr)) operands)))
	  (else (if (or (null? operators)
			(> (precedence (car expr))
			   (precedence (car operators))))
		    (parse-helper (cdr expr)
				  (cons (car expr) operators)
				   operands)
		    (handle-op expr operators operands)))))

  (define (handle-op expr operators operands)
    (parse-helper expr
		  (cdr operators)
		  (cons (cons (car operators)
			      (list (cadr operands) (car operands)))
			(cddr operands)))
    ) ; mf
  (define (precedence oper)
    (if (member? oper '(+ -)) 1 2))