;;; 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])))