suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add Whalesong specific versions of letrec and letrec-values to avoid the undefined value

Browse Source
This commit is contained in:
Jens Axel Søgaard 2014-08-12 19:35:15 +02:00
parent 60a70798a8
commit daa767998a
1 changed files with 369 additions and 348 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

717
whalesong/lang/kernel.rkt
View File

@ -3,8 +3,8 @@
sgn conjugate)) sgn conjugate))
(prefix-in racket: racket/base) (prefix-in racket: racket/base)
racket/provide racket/provide
racket/local racket/local
(for-syntax racket/base) (for-syntax racket/base)
racket/stxparam racket/stxparam
(only-in '#%paramz (only-in '#%paramz
@ -37,6 +37,27 @@
(provide current-print-mode) (provide current-print-mode)
;; Custom letrec and letrec-values in order to avoid running
;; into the (in Racket) newly introduced undefined value.
(provide letrec letrec-values)
(define-syntax (letrec stx)
(syntax-case stx ()
[(_ ([id expr] ...) body ...)
(syntax/loc stx
(let ([id '**undefined**] ...)
(set! id expr) ...
(let () body ...)))]))
(define-syntax (letrec-values stx)
(syntax-case stx ()
[(_ ([(id ...) expr] ...) body ...)
(syntax/loc stx
(let ([id '**undefined**] ... ...)
(set!-values (id ...) expr) ...
(let () body ...)))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Primitive function stubs ;; Primitive function stubs
@ -83,74 +104,74 @@
null null
eof eof
#%plain-module-begin #%plain-module-begin
#%module-begin #%module-begin
#%datum #%datum
#%app #%app
#%plain-app #%plain-app
#%top-interaction #%top-interaction
#%top #%top
module module
define define
define-values define-values
let-syntax let-syntax
let-values let-values
let*-values let*-values
define-struct define-struct
struct struct
if if
cond cond
else else
=> =>
case case
quote quote
unquote unquote
unquote-splicing unquote-splicing
lambda lambda
case-lambda case-lambda
let let
let* let*
letrec letrec
letrec-values letrec-values
local local
begin begin
begin0 begin0
set! set!
and and
or or
when when
unless unless
do do
require require
for-syntax for-syntax
for-template for-template
define-for-syntax define-for-syntax
begin-for-syntax begin-for-syntax
prefix-in prefix-in
only-in only-in
rename-in rename-in
except-in except-in
provide provide
planet planet
all-defined-out all-defined-out
all-from-out all-from-out
prefix-out prefix-out
except-out except-out
rename-out rename-out
struct-out struct-out
filtered-out filtered-out
combine-in combine-in
protect-out protect-out
combine-out combine-out
define-syntax-rule define-syntax-rule
define-syntax define-syntax
define-syntaxes define-syntaxes
let/cc let/cc
with-continuation-mark with-continuation-mark
hash? hash?
hash-equal? hash-equal?
hash-eq? hash-eq?
@ -172,20 +193,20 @@
hash-remove hash-remove
equal-hash-code equal-hash-code
hash-count hash-count
;; Kernel inlinable ;; Kernel inlinable
* *
- -
+ +
= =
/ /
sub1 sub1
add1 add1
< <
> >
<= <=
>= >=
cons cons
car car
cdr cdr
@ -196,15 +217,15 @@
not not
eq? eq?
values values
;; The version of apply in racket/base is doing some stuff that ;; The version of apply in racket/base is doing some stuff that
;; we are not handling yet. So we expose the raw apply here instead. ;; we are not handling yet. So we expose the raw apply here instead.
(rename-out [kernel:apply apply]) (rename-out [kernel:apply apply])
call-with-values call-with-values
gensym gensym
srcloc srcloc
make-srcloc make-srcloc
srcloc? srcloc?
@ -213,25 +234,25 @@
srcloc-column srcloc-column
srcloc-position srcloc-position
srcloc-span srcloc-span
make-struct-type make-struct-type
make-struct-field-accessor make-struct-field-accessor
make-struct-field-mutator make-struct-field-mutator
struct-type? struct-type?
exn:fail exn:fail
struct:exn:fail struct:exn:fail
prop:exn:srclocs prop:exn:srclocs
current-inexact-milliseconds current-inexact-milliseconds
current-seconds current-seconds
continuation-prompt-available? continuation-prompt-available?
abort-current-continuation abort-current-continuation
call-with-continuation-prompt call-with-continuation-prompt
;; needed for cs019-local ;; needed for cs019-local
#%stratified-body #%stratified-body
) )
@ -248,293 +269,293 @@
;; Many of these should be pushed upward rather than stubbed, so that ;; Many of these should be pushed upward rather than stubbed, so that
;; Racket's compiler can optimize these. ;; Racket's compiler can optimize these.
(provide-stub-function (provide-stub-function
current-output-port current-output-port
current-print current-print
write write
write-byte write-byte
display display
newline newline
displayln displayln
current-continuation-marks current-continuation-marks
continuation-mark-set->list continuation-mark-set->list
;; continuation-mark-set? ;; continuation-mark-set?
;; continuation-mark-set->list ;; continuation-mark-set->list
;; struct-constructor-procedure? ;; struct-constructor-procedure?
;; struct-predicate-procedure? ;; struct-predicate-procedure?
;; struct-accessor-procedure? ;; struct-accessor-procedure?
;; struct-mutator-procedure? ;; struct-mutator-procedure?
;; make-arity-at-least ;; make-arity-at-least
;; arity-at-least? ;; arity-at-least?
;; arity-at-least-value ;; arity-at-least-value
;; compose ;; compose
;; current-inexact-milliseconds ;; current-inexact-milliseconds
;; current-seconds ;; current-seconds
void void
random random
;; sleep ;; sleep
;; (identity -identity) ;; (identity -identity)
raise raise
error error
raise-type-error raise-type-error
raise-mismatch-error raise-mismatch-error
make-exn make-exn
make-exn:fail make-exn:fail
make-exn:fail:contract make-exn:fail:contract
make-exn:fail:contract:arity make-exn:fail:contract:arity
make-exn:fail:contract:variable make-exn:fail:contract:variable
make-exn:fail:contract:divide-by-zero make-exn:fail:contract:divide-by-zero
;; exn? ;; exn?
;; exn:fail:contract:arity? ;; exn:fail:contract:arity?
;; exn:fail:contract:variable? ;; exn:fail:contract:variable?
;; exn:fail:contract:divide-by-zero? ;; exn:fail:contract:divide-by-zero?
exn:fail? exn:fail?
exn:fail:contract? exn:fail:contract?
exn:fail:contract:arity? exn:fail:contract:arity?
exn-message exn-message
exn-continuation-marks exn-continuation-marks
abs abs
quotient quotient
remainder remainder
modulo modulo
max max
min min
gcd gcd
lcm lcm
floor floor
ceiling ceiling
round round
truncate truncate
numerator numerator
denominator denominator
expt expt
exp exp
log log
sin sin
sinh sinh
cos cos
cosh cosh
tan tan
asin asin
acos acos
atan atan
sqr sqr
sqrt sqrt
integer-sqrt integer-sqrt
sgn sgn
make-rectangular make-rectangular
make-polar make-polar
real-part real-part
imag-part imag-part
angle angle
magnitude magnitude
conjugate conjugate
inexact->exact inexact->exact
exact->inexact exact->inexact
number->string number->string
string->number string->number
procedure? procedure?
procedure-arity procedure-arity
procedure-arity-includes? procedure-arity-includes?
procedure-rename procedure-rename
;; (undefined? -undefined?) ;; (undefined? -undefined?)
;; immutable? ;; immutable?
void? void?
symbol? symbol?
string? string?
char? char?
boolean? boolean?
vector? vector?
struct? struct?
;; bytes? ;; bytes?
byte? byte?
number? number?
complex? complex?
real? real?
rational? rational?
integer? integer?
exact-integer? exact-integer?
exact? exact?
exact-nonnegative-integer? exact-nonnegative-integer?
inexact? inexact?
odd? odd?
even? even?
zero? zero?
positive? positive?
negative? negative?
box? box?
;; hash? ;; hash?
equal? equal?
eqv? eqv?
caar caar
cdar cdar
cadr cadr
cddr cddr
caaar caaar
cdaar cdaar
cadar cadar
cddar cddar
caadr caadr
cdadr cdadr
caddr caddr
cdddr cdddr
caaaar caaaar
cdaaar cdaaar
cadaar cadaar
cddaar cddaar
caadar caadar
cdadar cdadar
caddar caddar
cdddar cdddar
caaadr caaadr
cdaadr cdaadr
cadadr cadadr
cddadr cddadr
caaddr caaddr
cdaddr cdaddr
cadddr cadddr
cddddr cddddr
length length
list* list*
list-ref list-ref
;; list-tail ;; list-tail
append append
reverse reverse
for-each for-each
map map
andmap andmap
ormap ormap
memq memq
memv memv
member member
memf memf
assq assq
assv assv
assoc assoc
;; sort ;; sort
box box
;; box-immutable ;; box-immutable
unbox unbox
set-box! set-box!
;; make-hash ;; make-hash
;; make-hasheq ;; make-hasheq
;; hash-set! ;; hash-set!
;; hash-ref ;; hash-ref
;; hash-remove! ;; hash-remove!
;; hash-map ;; hash-map
;; hash-for-each ;; hash-for-each
make-string make-string
string string
string-length string-length
string-ref string-ref
string=? string=?
string<? string<?
string>? string>?
string<=? string<=?
string>=? string>=?
string-ci=? string-ci=?
string-ci<? string-ci<?
string-ci>? string-ci>?
string-ci<=? string-ci<=?
string-ci>=? string-ci>=?
string-copy string-copy
substring substring
string-append string-append
string->list string->list
list->string list->string
string->symbol string->symbol
symbol->string symbol->string
format format
printf printf
fprintf fprintf
;; string->immutable-string ;; string->immutable-string
string-set! string-set!
;; string-fill! ;; string-fill!
;; make-bytes ;; make-bytes
;; bytes ;; bytes
;; bytes->immutable-bytes ;; bytes->immutable-bytes
;; bytes-length ;; bytes-length
;; bytes-ref ;; bytes-ref
;; bytes-set! ;; bytes-set!
;; subbytes ;; subbytes
;; bytes-copy ;; bytes-copy
;; bytes-fill! ;; bytes-fill!
;; bytes-append ;; bytes-append
;; bytes->list ;; bytes->list
;; list->bytes ;; list->bytes
;; bytes=? ;; bytes=?
;; bytes<? ;; bytes<?
;; bytes>? ;; bytes>?
make-vector make-vector
vector vector
vector-length vector-length
vector-ref vector-ref
vector-set! vector-set!
vector->list vector->list
list->vector list->vector
char=? char=?
char<? char<?
char>? char>?
char<=? char<=?
char>=? char>=?
char-ci=? char-ci=?
char-ci<? char-ci<?
char-ci>? char-ci>?
char-ci<=? char-ci<=?
char-ci>=? char-ci>=?
char-alphabetic? char-alphabetic?
char-numeric? char-numeric?
char-whitespace? char-whitespace?
char-upper-case? char-upper-case?
char-lower-case? char-lower-case?
char->integer char->integer
integer->char integer->char
char-upcase char-upcase
char-downcase char-downcase
;; these are defined in bootstrapped-primitives in Whalesong's compiler package ;; these are defined in bootstrapped-primitives in Whalesong's compiler package
call-with-current-continuation call-with-current-continuation
call/cc call/cc
;; call-with-continuation-prompt ;; call-with-continuation-prompt
;; abort-current-continuation ;; abort-current-continuation
default-continuation-prompt-tag default-continuation-prompt-tag
make-continuation-prompt-tag make-continuation-prompt-tag
continuation-prompt-tag? continuation-prompt-tag?
make-reader-graph make-reader-graph
make-placeholder make-placeholder
placeholder-set! placeholder-set!
eof-object? eof-object?
read-byte read-byte
hash-has-key? hash-has-key?
hash-keys hash-keys
hash-values hash-values
) )