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

163
whalesong/lang/kernel.rkt
View File

@ -37,6 +37,27 @@
(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
@ -264,26 +285,26 @@
current-continuation-marks
continuation-mark-set->list
;; continuation-mark-set?
;; continuation-mark-set->list
;; continuation-mark-set?
;; continuation-mark-set->list
;; struct-constructor-procedure?
;; struct-predicate-procedure?
;; struct-accessor-procedure?
;; struct-mutator-procedure?
;; struct-constructor-procedure?
;; struct-predicate-procedure?
;; struct-accessor-procedure?
;; struct-mutator-procedure?
;; make-arity-at-least
;; arity-at-least?
;; arity-at-least-value
;; make-arity-at-least
;; arity-at-least?
;; arity-at-least-value
;; compose
;; current-inexact-milliseconds
;; current-seconds
;; compose
;; current-inexact-milliseconds
;; current-seconds
void
random
;; sleep
;; (identity -identity)
;; sleep
;; (identity -identity)
raise
error
@ -297,10 +318,10 @@
make-exn:fail:contract:variable
make-exn:fail:contract:divide-by-zero
;; exn?
;; exn:fail:contract:arity?
;; exn:fail:contract:variable?
;; exn:fail:contract:divide-by-zero?
;; exn?
;; exn:fail:contract:arity?
;; exn:fail:contract:variable?
;; exn:fail:contract:divide-by-zero?
exn:fail?
exn:fail:contract?
exn:fail:contract:arity?
@ -353,32 +374,32 @@
procedure-arity-includes?
procedure-rename
;; (undefined? -undefined?)
;; immutable?
void?
symbol?
string?
char?
boolean?
vector?
struct?
;; bytes?
byte?
number?
complex?
real?
rational?
integer?
exact-integer?
exact?
exact-nonnegative-integer?
inexact?
odd?
even?
zero?
positive?
negative?
box?
;; hash?
;; immutable?
void?
symbol?
string?
char?
boolean?
vector?
struct?
;; bytes?
byte?
number?
complex?
real?
rational?
integer?
exact-integer?
exact?
exact-nonnegative-integer?
inexact?
odd?
even?
zero?
positive?
negative?
box?
;; hash?
equal?
eqv?
@ -415,7 +436,7 @@ box?
length
list*
list-ref
;; list-tail
;; list-tail
append
reverse
for-each
@ -429,18 +450,18 @@ box?
assq
assv
assoc
;; sort
;; sort
box
;; box-immutable
;; box-immutable
unbox
set-box!
;; make-hash
;; make-hasheq
;; hash-set!
;; hash-ref
;; hash-remove!
;; hash-map
;; hash-for-each
;; make-hash
;; make-hasheq
;; hash-set!
;; hash-ref
;; hash-remove!
;; hash-map
;; hash-for-each
make-string
string
string-length
@ -467,24 +488,24 @@ box?
format
printf
fprintf
;; string->immutable-string
;; string->immutable-string
string-set!
;; string-fill!
;; make-bytes
;; bytes
;; bytes->immutable-bytes
;; bytes-length
;; bytes-ref
;; bytes-set!
;; subbytes
;; bytes-copy
;; bytes-fill!
;; bytes-append
;; bytes->list
;; list->bytes
;; bytes=?
;; bytes<?
;; bytes>?
;; string-fill!
;; make-bytes
;; bytes
;; bytes->immutable-bytes
;; bytes-length
;; bytes-ref
;; bytes-set!
;; subbytes
;; bytes-copy
;; bytes-fill!
;; bytes-append
;; bytes->list
;; list->bytes
;; bytes=?
;; bytes<?
;; bytes>?
make-vector
vector
vector-length