#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))]))