#|

File: semantics/lookup.rkt
Author: Bill Turtle

Provides the semantics for the `lookup` operation (i.e., dot)

|#
#lang racket

(require (for-syntax "../utilities.rkt"))
(require "../utilities.rkt")
(require "../semantics/structures.rkt")
(require 2htdp/image)
(require lang/posn)

; beginner-lookup is like normal lookup, except we don't consider
; objects.
(define-syntax (beginner-lookup stx)
  (syntax-case stx ()
    [(_ strct_ sym_)
     (identifier? (syntax sym_))
     (with-syntax ([srcloc (syntax->vector stx)])
       (syntax/loc stx (pyret-do-lookup strct_ (quote sym_) #f srcloc)))]))
(define-syntax (lookup stx)
  (syntax-case stx ()
    [(_ strct_ sym_)
     (identifier? (syntax sym_))
     (with-syntax ([srcloc (syntax->vector stx)])
       (syntax/loc stx (pyret-do-lookup strct_ (quote sym_) #t srcloc)))]))

(define/contract (if-symbol-symbol->string s)
  (-> (or/c string? symbol?) string?)
  (if (string? s)
      s
      (symbol->string s)))
(define (pyret-do-lookup strct sym objects? sl)
  (unless (symbol? sym)
    (raise-type-error 'pyret-do-lookup
                      "symbol"
                      sym))
  (cond
    [(posn? strct)
     (if (symbol=? sym 'x)
         (posn-x strct)
         (if (symbol=? sym 'y)
             (posn-y strct)
             (raise-pyret-error (format "struct \'posn\' has no field named ~a"
                                        (symbol->string sym))
                                sl)))]
    [(image? strct)
     (if (symbol=? sym 'height)
         (image-height strct)
         (if (symbol=? sym 'width)
             (image-width strct)
             (if (symbol=? sym 'baseline)
                 (image-baseline strct)
                 (raise-pyret-error (format "struct \'image\' has no field named ~a"
                                            (symbol->string sym))
                                    sl))))]
    [(color? strct)
     (if (symbol=? sym 'red)
         (color-red strct)
         (if (symbol=? sym 'green)
             (color-green strct)
             (if (symbol=? sym 'blue)
                 (color-blue strct)
                 (raise-pyret-error (format
                                       "struct \'color\' has no field named ~a"
                                       (symbol->string sym))
                                    sl))))]
    [(pen? strct)
     (if (symbol=? sym 'color)
         (pen-color strct)
         (if (symbol=? sym 'width)
             (pen-width strct)
             (if (symbol=? sym 'style)
                 (if-symbol-symbol->string (pen-style strct))
                 (if (symbol=? sym 'join)
                     (if-symbol-symbol->string (pen-join strct))
                     (if (symbol=? sym 'cap)
                         (if-symbol-symbol->string (pen-cap strct))
                         (raise-pyret-error
                         (format "struct \'pen\' has no field named ~a" sym)
                      sl))))))]
    [(pyret-struct-instance? strct)
     (pyret-struct-lookup strct sym sl)]
    [else
     (raise-pyret-error "expected a structure as the first argument"
                        sl)]))
  


(provide beginner-lookup lookup)