;; Advanced Student Data Definitions

;; Copyright (c) 2008 David Van Horn
;; Licensed under the Academic Free License version 3.0

;; (at dvanhorn (dot ccs neu edu))

;; This module gives data definitions for the syntax
;; of Advanced Student programs.

;; If the student language had a way of providing bindings,
;; the next three lines would not be needed and this program
;; would be written in the advanced student language.
#lang scheme
(require lang/htdp-advanced)
(provide (all-defined-out))

;; Data Definitions for Advanced Student language

(define (<program>? x)
  (and (list? x) 
       (andmap <def-or-expr>? x)))

(define (<def-or-expr>? x)
  (or (<definition>? x)
      (<expr>? x)
      (<test-case>? x)
      (<library-require>? x)))

(define-struct <definition-procedure> (name ids expr))
(define-struct <definition-value>     (id expr))
(define-struct <definition-struct>    (id field-ids))

(define (<definition>? x)
  (or (<definition-procedure>? x)
      (<definition-value>? x)
      (<definition-struct>? x)))

(define-struct <begin> (exprs))
(define-struct <begin0> (exprs))
(define-struct <set!> (id expr))
(define-struct <delay> (expr))
(define-struct <lambda> (ids body))
(define-struct <local> (defs body))
(define-struct <letrec> (ids exprs body))
(define-struct <shared> (ids exprs body))
(define-struct <let> (ids exprs body))
(define-struct <let*> (ids exprs body))
(define-struct <recur> (name ids exprs body))
(define-struct <application> (operator operands))
(define-struct <cond> (questions answers))
(define-struct <cond/else> (questions answers default))
(define-struct <case> (expr choices answers))
(define-struct <case/else> (expr choices answers default))
(define-struct <if> (test then else))
(define-struct <when> (test body))
(define-struct <unless> (test body))
(define-struct <and> (exprs))
(define-struct <or> (exprs))
(define-struct <time> (expr))
(define-struct <empty> ())
(define-struct <identifier> (symbol))
;(define-struct <prim-op> (name))
;(define-struct <quoted-id> (id))
;(define-struct <quoted-value> (quoted))
(define-struct <number> (number))
(define-struct <true> ())
(define-struct <false> ())
(define-struct <string> (string))
(define-struct <character> (char))

(define (<expr>? x)
  (or (<begin>? x)
      (<begin0>? x)
      (<set!>? x)
      (<delay>? x)
      (<lambda>? x)
      (<local>? x)
      (<letrec>? x)
      (<shared>? x) 
      (<let>? x)
      (<let*>? x)
      (<recur>? x)
      (<application>? x)
      (<cond>? x)
      (<cond/else>? x)
      (<case>? x)
      (<case/else>? x)
      (<if>? x)
      (<when>? x)
      (<unless>? x)
      (<and>? x)
      (<or>? x)
      (<time>? x)
      (<empty>? x)
      (<identifier>? x)
      ;(<prim-op>? x)
      ;(<quoted-id>? x)
      (<quote>? x)
      (<quasiquote>? x)
      (<number>? x)
      (<true>? x)
      (<false>? x)
      (<string>? x)
      (<character>? x)))

(define (<choice>? x)
  (or (<identifier>? x)
      (<number>? x)))

(define-struct <quote>            (body))
(define-struct <quasiquote>       (body))
(define-struct <unquote>          (body))
(define-struct <unquote-splicing> (body))
(define-struct <quoted-list>      (bodies))

(define (<quoted>? x)
  (or (<identifier>? x)
      (<number>? x)
      (<string>? x)
      (<character>? x)
      (<quoted-list>? x)
      (<quote>? x)
      (<quasiquote>? x)
      (<unquote>? x)
      (<unquote-splicing>? x)))
           
(define (<quasiquoted>? x)
  (or (<identifier>? x)
      (<number>? x)
      (<string>? x)
      (<character>? x)
      (<quoted-list>? x)
      (<quote>? x)
      (<quasiquote>? x)
      (<unquote>? x)
      (<unquote-splicing>? x)))

(define-struct <check-expect> (check expect))
(define-struct <check-within> (check expect delta))
(define-struct <check-error>  (check message))

(define (<test-case>? x)
  (or (<check-expect>? x)
      (<check-within>? x)
      (<check-error>? x)))

(define-struct <require-file> (string))
(define-struct <require-lib> (strings))
(define-struct <require-planet> (file author package major minor))

(define (<library-require>? x)
  (or (<require-file>? x)
      (<require-lib>? x)
      (<require-planet>? x)))