#lang racket

;; file: language.rkt
;; author: Bill Turtle
;;
;; Defines the semantics of pyret/bsl


(require syntax/stx)
(require racket/stxparam)

(provide fun def begin local pyret-struct return)
(require racket/base)
(provide (all-from-out racket/base))

(define source-name (make-parameter #f))

(define-syntax-rule (return expr) expr)
;; An example:
;; struct point (x,y)
;; =>
;; (define (point x y)
;;   (lambda (n)
;;     (cond
;;       ((equal? n 'x) x)
;;       ((equal? n 'y) y)
;;       (else (error 'point "structure has no field named ~a" n))))
;;
;; so a structure is a function, and field access is the result of calling
;; that function

(define-syntax pyret-struct
  (syntax-rules ()
    ((_ id ()) 
     (error 'struct "cannot create a structure with no fields!"))
    ((_ id (args ...))
     (define (id args ...)
       (lambda (n)
         (cond
           ((equal? n 'args) args)
           ...
           (else (parameterize ((error-print-source-location #t))
                   (raise-syntax-error 'id 
                                       (format "structure has no field named ~a" 
                                               n))))))))))

#|
(define-syntax (pyret-struct stx)
  (syntax-case stx ()
    ((_ id (args ...))
     (let ((line (syntax-line stx))
           (column (syntax-column stx)))
     #`(define (id args ...)
         (lambda (n)
           (cond
             ((equal? n 'args) args)
             ...
             (else (raise-syntax-error 'id
                                       (format "~a ~a (~a ~a ~a ~a)"
                                               "structure has no field named"
                                               n
                                               "structure defined at line"
                                               #,line
                                               "column"
                                               #,column))))))))))
|#
(define-syntax (fun stx)
  (syntax-case stx ()
    [(_ id (args ...) body) ; 0-arity functions not allowed
     (syntax/loc stx 
       (define (id args ...)
         body))]))

;; check-for-return: (syntax -> syntax)
;; raises an error if there is no 'return' found in tail
(define (check-for-return stx)
  stx) ; this is on the "TODO list"

(define-syntax (def stx)
  (syntax-case stx ()
    [(_ id (args ...) body) ; 0-arity procedures not allowed
     (syntax/loc stx
       (define (id args ...)
         body))]))