;;; Reads a string (easier to see whats happening)
;;; DIRECTIONS: NEW-READ takes a string and returns a structure
;;; example: (dpc-read "(fact (1- 3))") => '(fact (1- 3))
(set *DELIMITERS* [" " "(" ")" "[" "]"])
(set *NUMERALS* ["1" "2" "3" "4" "5" "6" "7" "8" "9" "0"])
(set *LETTERS* ["a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m"
"n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z"])
;;; tosses away the remainder string
(define NEW-READ
(lambda [string] (first (read-expression string))))
;;; Reads an expression from the front of the string
;;; Returns the the structure and the new string
(define READ-EXPRESSION
(lambda [string]
(let [[string (strip-leading-spaces string)]]
(select (nth-char 1 string)
[
(define READ-EXPRESSION
(lambda [string]
(let [[string (strip-leading-spaces string)]]
(cond [(= (substring 1 1 string) "[")
(read-rail string)]
[(= (substring 1 1 string) "(")
(read-pair string)]
[(= (substring 1 1 string) "$")
(read-boolean string)]
[(member (substring 1 1 string) *numerals*)
(read-numeral string)]
[(member (substring 1 1 string) *letters*)
(read-atom string)]
[$T (error "read-expression: unknown expression" string)]))))
;;; returns a sequence of a pair and the new stirng
;;; expects "( ...." as input
(define read-pair
(lambda [string]
(letseq [[return (read-expression ;;strip off open paren
(substring 2 (string-length string) string))]
[fn-structure (first return)]
[new-string (nth 2 return)]]
(read-pair-collect fn-structure '[] new-string))))
;;;makes paren balancing in the editor more bearable
(define *close-paren-string* ")")
;;;collects arguments for the pair until a close paren is hit
;;;returns a sequence of the pair and the new stirng
(define read-pair-collect
(lambda [fn-structure arg-rail string]
(let [[string (strip-leading-spaces string)]]
(cond [(= (substring 1 1 string) *close-paren-string*)
(list (pcons fn-structure arg-rail)
(substring 2 (string-length string) string))]
[$T
(letseq [[return (read-expression string)]
[arg-structure (first return)]
[new-string (nth 2 return)]]
(read-pair-collect fn-structure (append arg-rail
(cons arg-structure '[]))
new-string))]))))
;;;returns a sequence of a boolean and the new string
(define read-boolean
(lambda [string]
(letseq [[return (read-token string)]
[boolean-string (first return)]
[new-string (nth 2 return)]]
(list (internalize boolean-string) new-string))))
;;;returns a sequence of an atom and the new string
(define read-atom
(lambda [string]
(letseq [[return (read-token string)]
[atom-string (first return)]
[new-string (nth 2 return)]]
(list (internalize atom-string) new-string))))
;;;returns a sequence of a rail and the new stirng
;;;first character in string is open bracket
(define read-rail
(lambda [string]
;;;stip off first open bracket
(read-rail-helper '[] (substring 2 (string-length string) string))))
(define read-rail-helper
(lambda [rail string]
(let [[string (strip-leading-spaces string)]]
(cond [(= (substring 1 1 string) "]")
(list rail (substring 2 (string-length string) string))]
[$T
(letseq [[return (read-expression string)]
[struc (first return)]
[new-string (nth 2 return)]]
(read-rail-helper (append rail (cons struc '[])) new-string))]))))
;;;reads a number, returns a sequence: [numeral string]
(define read-numeral
(lambda [string]
(letseq [[return (read-token string)]
[numeral-string (first return)]
[new-string (nth 2 return)]]
(list (internalize numeral-string) new-string))))
;;;returns a sequence, first thing is the token, second is the new string
(define read-token
(lambda [string]
(read-token-helper "" (strip-leading-spaces string))))
(define strip-leading-spaces
(lambda [string]
(cond [(= string "") string]
[(= (substring 1 1 string) " ")
(strip-leading-spaces (substring 2 (string-length string) string))]
[$T string]
)))
(define read-token-helper
(lambda [token string]
(cond [(or (= string "") (member (substring 1 1 string) *delimiters*))
(list token string)]
[$T
(read-token-helper
(string-append
token
(substring 1 1 string))
(substring 2 (string-length string) string))])))
;;; Unneeded accessories and testers:
(define test
(lambda [x]
(select x
[*numerals* 'numeral]
[*letters* 'letter]
[*delimiters* 'delimiter]
[$T 'something-else])))