assignment2.scm

DrScheme 运算符的规则

;;check the input, number, symbol or string

(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)
	  (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))))))

;;function:word->string  
;;check the input, if the input is a word change to string

  (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))))))
  
;;    function:empty
;;    -define when the input is empty or not
  
  (define empty?
    (let ((null? null?)
	  (string? string?)
	  (string=? string=?))
      (lambda (x)
	(or (null? x)
	    (and (string? x) (string=? x ""))))))
  
;;  function: member
;;    - reads a line from user, discards space characters by calling 
;;       eatspace, and inserts the remaining characters into a list
;;
;;    - takes no input parameters
;;    - returns a list of characters
;;    
;;    - function calls eatspace and makes recursive calls to self
;;

  (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 (fix expr)
    (fix-helper expr '() '()))
  

  ;;    function: fix-helper
;;    - parse the expr
;;
;;    - takes the input parameters
;;    - give the parse for the expr
;;    
;;    - function calls eatspace and makes recursive calls to self
;;

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

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