#lang racket

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

; file:  parser2.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
;
; A letter is one of _abcdefghijklmnoprstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ
; empty means the empty string
; Whitespace is a space

; 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)) "fully successful"]
      [(succeeded? outcome) (string-append "successful, 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)
  (list result residue))


; Construct a successful Outcome

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


; Construct a failure Outcome

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


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


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


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

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


; Parse function fo rList 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))
          )]
      [else (succeed input)]
      )))


; Parse function for Atom
;         A -> letter letters

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


; 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

(define (parse-letters input)
  (cond
    [(empty? input) (succeed '())]
    [(letter? (first input)) (parse-letters (rest input))]
    [else (succeed input)]))


; Parse function for
;         W -> whitespace W              ; Optional whitespace
;         W -> empty
; We use the built-in function char-whitespace? to define whitespace characters

(define (parse-W input)
  (cond
    [(null? input) (succeed input)]
    [(char-whitespace? (first input)) (parse-W (rest input))]
    [else (succeed input)]))

; Unit tests

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

(generate-report)