Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

67 lines (52 sloc) 2.19 kb
#lang s-exp "kernel.rkt"
;; Acts like the "Pretty Big" kind of language; has several features turned on by default.
;; These include:
;;
;; * Automatically running tests
;; * Annotating all applications so they produce stack traces on error
;; * Adding the "shared" form by default.
;; * define-struct automatically has #:transparent and #:mutable
(require "base.rkt"
"private/traced-app.rkt"
"private/shared.rkt"
"check-expect/check-expect.rkt"
"bool.rkt"
"posn.rkt"
(for-syntax racket/base))
;; Programs written in Whalesong will have tracing enabled by default.
;; If you don't want this, write in whalesong/base instead.
(provide (except-out (all-from-out "base.rkt")
#%app
#%module-begin
define-struct)
(rename-out [traced-app #%app]
[my-module-begin #%module-begin]
[my-define-struct define-struct])
shared
(all-from-out "bool.rkt")
(all-from-out "posn.rkt")
(except-out (all-from-out "check-expect/check-expect.rkt")
run-tests)
λ)
(define-syntax (my-module-begin stx)
(syntax-case stx ()
[(_ body ...)
(syntax/loc stx
(#%module-begin body ...
(run-tests)))]))
(define-syntax λ (make-rename-transformer #'lambda))
(define-syntax (my-define-struct stx)
(syntax-case stx ()
[(_ id (fields ...) options ...)
(let* ([new-options (syntax->list #'(options ...))]
[new-options (cond [(memq '#:transparent (map syntax-e new-options))
new-options]
[else
(cons (syntax #:transparent) new-options)])]
[new-options (cond [(memq '#:mutable (map syntax-e new-options))
new-options]
[else
(cons (syntax #:mutable) new-options)])])
(with-syntax [((new-options ...) new-options)]
(syntax/loc stx
(define-struct id (fields ...) new-options ...))))]))
Jump to Line
Something went wrong with that request. Please try again.