#lang racket

(require htdp/testing)
(require (lib "trace.ss"))

; note: This version shows how to add returned values, i.e. "meaning"
; In the case of the present language, the meaning of a string is
; the same as if the contents of the string were entered as a quoted
; S-expression. In other words, this is a primitive model of the
; Racket parser.
;
; This version features better whitespace removal. The function
; darken removes all whitespace from the beginning of a list,
; returning a new list.
;
; file:  parser4.rkt
; author: Robert Keller
; purpose: Illustrate parsing for a simple grammar for S-expressions
; terminal alphabet: { (, )} + letters + whitespace (see below)
; non-terminal alphabet: {S, L, A, W, letters}
; start symbol S
; rules:
;         S -> W ( L ) W                 ; S expression
;         S -> W A W
;         L -> S L                       ; List content
;         L -> empty
;         A -> letter letters            ; Atom
;         letters -> letter letters      ; 0 or more letters
;         letters -> empty
;         W -> whitespace W              ; Optional whitespace
;         W -> empty
;
; Whitespace is removed by the function darken, rather than a parse function.
; A letter is one of _abcdefghijklmnoprstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ
; empty means the empty string

; The top-level function, parse, is given an input string.
; The string is converted to a list of characters for parsing.
; The result is reported as one of three kinds of string:
;
;    fully succesful, meaning that the input was completely parsed
;
;    succesful, with residue meaning that a prefix of the input was parsed
;        but there was a non-empty residue
;
;    unsuccesful, meaning that there was no prefix of the string that could
;        be parsed
;

; top-level parse function, returns a string as described above

(define (parse input-string)
  (let* (
        (outcome (parse-S (string->list input-string)))
        (residue (get-residue outcome))
        )
    (cond
      [(and (succeeded? outcome) (null? residue)) 
            (string-append "fully successful, value: " (->string (get-value outcome)))]
      [(succeeded? outcome) (string-append "successful, value: " 
                                           (->string (get-value outcome))
                                           " with residue: " (list->string residue))]
      [else "unsuccessful"])))




; Data abstraction for Outcomes of the parse
; An outcome consists of two parts: 
;    a result indicating success or failure
;    a residue, which is the list of characters left over

; Construct an outcome

(define (make-outcome result residue value)
  (list result residue value))


; Construct a successful Outcome

(define (succeed residue value)
  (make-outcome 'success residue value))


; Construct a failure Outcome

(define (fail residue)
  (make-outcome 'failure residue 'no-value))


; Get the result part of an Outcome

(define (get-result Outcome)
  (first Outcome))


; Get the residue part of an Outcome

(define (get-residue Outcome)
  (second Outcome))


; Get the value part of an Outcome

(define (get-value Outcome)
  (third Outcome))


; Determine whether an Outcome is succesful

(define (succeeded? Outcome)
  (equal? 'success (get-result Outcome)))


; Determine whether an Outcome is a failure

(define (failed? Outcome)
  (equal? 'failure (get-result Outcome)))


; Predicates to avoid magic characters in the code

(define (left-paren?  char) (char=? #\( char))
(define (right-paren? char) (char=? #\) char))


; Define letters

(define letters (string->list "_abcdefghijklmnoprstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))

(define (letter? c)
  (member c letters))


; Darken returns, from a list of characters, 
; a new list no whitespace at the beginning, but
; the rest of the list intact.

(define (darken input)
  (cond [(null? input) null]
        [(char-whitespace? (first input)) (darken (rest input))]
        [else input]))
      

; Parse function for S expression
;         S -> W ( L ) W 
;         S -> W A W

(define (parse-S input)
  (let ((input (darken input))) ; redefine input locally
  (cond
    [(null? input) (fail input)]
    [(left-paren? (first input)) 
     (let* (
           (L1 (parse-L (rest input))) ;; can't fail
           (residue (darken (get-residue L1)))
           )
       (cond 
         [(null? residue) (fail input)]
         [(right-paren? (first residue))
          (succeed (darken (rest residue)) (get-value L1))]
         [else (fail input)])
       )]
    [(letter? (first input))
     (let((A1 (parse-A input)))
       (succeed (darken (get-residue A1)) (get-value A1)))]
    [else (fail input)])))

(check-expect (parse-S (string->list "abc def"))
              (succeed (string->list "def") 'abc))

(check-expect (parse-S (string->list "(abc def gh)"))
              (succeed (string->list "") '(abc def gh)))

; Parse function for List content
;         L -> S L
;         L -> empty

(define (parse-L input)
  (let (
        (S1 (parse-S input))
        )
    (cond
      [(succeeded? S1)
        (let (
             (L2 (parse-L (get-residue S1))) ;; can't fail
             )
          (succeed (get-residue L2) (cons (get-value S1) (get-value L2)))
          )]
      [else (succeed input '())]
      )))

(check-expect (parse-L (string->list "abc def gh "))
              (succeed (string->list "") '(abc def gh)))


; Parse function for Atom
;         A -> letter letters
; The value of this parse function is a symbol.

(define (parse-A input)
  (cond
    [(empty? input) (fail input)]
    [(letter? (first input)) (parse-letters (rest input) (list (first input)))]
    [else (fail input)]))

(check-expect (parse-A (string->list "abc def"))
              (succeed (string->list " def") 'abc))


; Parse function for 0 or more letters in sequence
; Assuming input is not empty when called from outside.
; (It may be empty when called within.)
;         letters -> letter letters
;         letters -> empty
; accumulator accumlulates letters as a list in reverse
; The value of this parse function is a symbol.

(define (parse-letters input accumulator)
  (cond
    [(empty? input) (succeed '() (list->symbol (reverse accumulator)))]
    [(letter? (first input)) (parse-letters (rest input) 
                                            (cons (first input) accumulator))]
    [else (succeed input (list->symbol (reverse accumulator)))]))

(check-expect (parse-letters (string->list "abc def") '())
              (succeed (string->list " def") 'abc))


;; list->symbol converts a list of characters to a symbol
(define (list->symbol char-list)
  (string->symbol (list->string char-list)))

;; ->string produces a string from a symbol, number, string, or list
;; consisting of any of those things, to any level.

(define (->string x)
  (cond
    [(list? x)   (string-append "(" (arb-list->string x) ")")]
    [(symbol? x) (symbol->string x)]
    [(number? x) (number->string x)]
    [(string? x) x]
    [else (error "unknown argument")]))

;; arb-list->string is a helper function for ->string,
;; and is mutually recursive with it.
;; Note the special handling of lists as elements, so as
;; not to inser unneeded spaces after such an element.

(define (arb-list->string x)
  (cond [(null? x) ""]
        [(null? (rest x)) (->string (first x))]
        [(list? (first x)) (string-append (->string (first x)) (arb-list->string (rest x)))]
        [else (string-append (->string (first x)) " " (arb-list->string (rest x)))]))

(check-expect (arb-list->string '("abc" "def" "ghi")) "abc def ghi")
(check-expect (arb-list->string '()) "")

; Unit tests
                                        
(check-expect (parse "()")                "fully successful, value: ()")
(check-expect (parse "(()())")            "fully successful, value: (()())")
(check-expect (parse "(()()())")          "fully successful, value: (()()())")
(check-expect (parse "((())())")          "fully successful, value: ((())())")
(check-expect (parse "((())(()))")        "fully successful, value: ((())(()))")
(check-expect (parse "((()())(()))")      "fully successful, value: ((()())(()))")
(check-expect (parse "(()()))")           "successful, value: (()()) with residue: )")
(check-expect (parse "()()")              "successful, value: () with residue: ()")
(check-expect (parse "(())()")            "successful, value: (()) with residue: ()")
(check-expect (parse "(")                 "unsuccessful")
(check-expect (parse  ")")                "unsuccessful")
(check-expect (parse  ")(")               "unsuccessful")
(check-expect (parse "abc")               "fully successful, value: abc")
(check-expect (parse "   abc")            "fully successful, value: abc")
(check-expect (parse "(abc)")             "fully successful, value: (abc)")
(check-expect (parse "(abc def)")         "fully successful, value: (abc def)")
(check-expect (parse "(  abc def g h i)") "fully successful, value: (abc def g h i)")
(check-expect (parse "((abc))")           "fully successful, value: ((abc))")
(check-expect (parse "(((abc)))")         "fully successful, value: (((abc)))")
(check-expect (parse "((abc)def)")        "fully successful, value: ((abc)def)")
(check-expect (parse "((abc)(def))")      "fully successful, value: ((abc)(def))")
(check-expect (parse "( (abc)(def))")     "fully successful, value: ((abc)(def))")
(check-expect (parse "( (abc) (def) )")   "fully successful, value: ((abc)(def))")
(check-expect (parse "( (abc)()(def) )")  "fully successful, value: ((abc)()(def))")
(check-expect (parse "() ")               "fully successful, value: ()")
(check-expect (parse "abc  ")             "fully successful, value: abc")
(check-expect (parse "((abc)def) ")       "fully successful, value: ((abc)def)")

(generate-report)