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

Begin transition to racket lang in lang-utils.rkt

Browse Source 
-Maximize the number of bindings brought in from racket vs. mzscheme by
replacing mzscheme in the (all-except mzscheme form with racket.
-import from mzscheme sparingly rather than bringing it all in except
the lang-core bindings.
-switch mzlib/list require to racket/list
-some cleanup of requires and provides
This commit is contained in:
Patrick Mahoney 2012-08-03 19:29:03 -04:00 committed by Gregory Cooper
parent 69de8e95b3
commit 01ec2d3fde
2 changed files with 55 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/frtime/frtime-lang-only.rkt
View File

@ -1,5 +1,5 @@
(module frtime-lang-only "lang-utils.rkt" (module frtime-lang-only "lang-utils.rkt"
(require frtime/lang-ext) (require (only frtime/lang-ext undefined? signal? value-now lift))
(require (as-is:unchecked frtime/core/frp (require (as-is:unchecked frtime/core/frp
event-set? signal-value)) event-set? signal-value))
@ -14,4 +14,4 @@
(provide value-nowable? behaviorof (provide value-nowable? behaviorof
(all-from "lang-utils.rkt") (all-from "lang-utils.rkt")
(all-from-except frtime/lang-ext lift))) (all-from-except frtime/lang-ext lift)))

80
collects/frtime/lang-utils.rkt
View File

@ -1,18 +1,43 @@
(module lang-utils "lang-core.rkt" (module lang-utils "lang-core.rkt"
(require (all-except mzscheme (require (only mzscheme let define-syntax define apply procedure-arity syntax-object->datum with-input-from-file require-for-syntax make-namespace expand-path collection-path begin syntax-rules)
(all-except racket
else
module module
begin
syntax-rules
#%app #%app
#%top #%top
#%datum #%datum
#%plain-module-begin #%plain-module-begin
#%module-begin #%module-begin
#%top-interaction
λ
let
define
define-syntax
define-for-syntax
case
apply
if if
lambda lambda
case-lambda case-lambda
chaperone-procedure
free-identifier=?
reverse reverse
collection-path
collection-file-path
list-ref list-ref
require require
collection-path
raise-arity-error
procedure-rename
impersonate-procedure
procedure-reduce-arity
procedure-arity
procedure->method
prop:procedure
regexp-replace*
provide provide
letrec letrec
match match
@ -25,20 +50,20 @@
vector-ref vector-ref
define-struct define-struct
list list
list* list*
list? list?
append append
and and
or or
cond when unless cond when unless
map ormap andmap assoc member) map ormap andmap assoc member open-input-file open-output-file open-input-output-file call-with-output-file call-with-input-file with-output-to-file with-input-from-file)
(rename mzscheme mzscheme:if if) (rename mzscheme mzscheme:if if)
(rename "lang-ext.rkt" lift lift) (rename "lang-ext.rkt" lift lift)
(only frtime/core/frp super-lift behavior? value-now) (only frtime/core/frp super-lift behavior? value-now)
(rename "lang-ext.rkt" undefined undefined) (rename "lang-ext.rkt" undefined undefined)
(rename "lang-ext.rkt" undefined? undefined?) (rename "lang-ext.rkt" undefined? undefined?)
mzlib/class) mzlib/class)
(require mzlib/list) (require (only racket/list empty))
(define-syntax (lifted-send stx) (define-syntax (lifted-send stx)
(syntax-case stx () (syntax-case stx ()
@ -49,13 +74,13 @@
(lambda (obj-tmp arg-tmp ...) (lambda (obj-tmp arg-tmp ...)
(send obj-tmp meth arg-tmp ...)) (send obj-tmp meth arg-tmp ...))
obj arg ...))])) obj arg ...))]))
(define (list-ref lst idx) (define (list-ref lst idx)
(if (lift #t positive? idx) (if (lift #t positive? idx)
(list-ref (cdr lst) (lift #t sub1 idx)) (list-ref (cdr lst) (lift #t sub1 idx))
(car lst))) (car lst)))
(define-syntax cond (define-syntax cond
(syntax-rules (else =>) (syntax-rules (else =>)
[(_ [else result1 result2 ...]) [(_ [else result1 result2 ...])
@ -104,7 +129,7 @@
(or-undef exps ...)))])) (or-undef exps ...)))]))
(define-syntax or-undef (define-syntax or-undef
(syntax-rules () (syntax-rules ()
[(_) undefined] [(_) undefined]
[(_ exp) (let ([v exp]) (if v v undefined))] [(_ exp) (let ([v exp]) (if v v undefined))]
@ -114,7 +139,7 @@
(or-undef exps ...) (or-undef exps ...)
(or-undef exps ...)))])) (or-undef exps ...)))]))
(define-syntax when (define-syntax when
(syntax-rules () (syntax-rules ()
@ -181,7 +206,7 @@
(define (cddddr v) (define (cddddr v)
(cdr (cdddr v))) (cdr (cdddr v)))
(define (split-list acc lst) (define (split-list acc lst)
(if (null? (cdr lst)) (if (null? (cdr lst))
(values acc (car lst)) (values acc (car lst))
@ -200,7 +225,7 @@
(lambda (last-args) (lambda (last-args)
(apply apply fn (append first-args (cons last-args empty)))) (apply apply fn (append first-args (cons last-args empty))))
last-args)))) last-args))))
(define-syntax frp:case (define-syntax frp:case
(syntax-rules () (syntax-rules ()
[(_ exp clause ...) [(_ exp clause ...)
@ -241,16 +266,16 @@
(cons (apply f (car l) (map car ls)) (apply map f (cdr l) (map cdr ls))) (cons (apply f (car l) (map car ls)) (apply map f (cdr l) (map cdr ls)))
null)])) null)]))
(define (frp:length lst) (define (frp:length lst)
(cond (cond
[(pair? lst) (lift #t add1 (frp:length (cdr lst)))] [(pair? lst) (lift #t add1 (frp:length (cdr lst)))]
[(null? lst) 0] [(null? lst) 0]
[else (error 'length (format "expects list, given ~a" lst))])) [else (error 'length (format "expects list, given ~a" lst))]))
(define (frp:list->string lst) (define (frp:list->string lst)
(lift #t list->string (raise-reactivity lst))) (lift #t list->string (raise-reactivity lst)))
(define (reverse lst) (define (reverse lst)
(let loop ([lst lst] [acc ()]) (let loop ([lst lst] [acc ()])
(if (pair? lst) (if (pair? lst)
@ -262,7 +287,7 @@
;; language. Ironically, frtime-opt has its *own* definition of this ;; language. Ironically, frtime-opt has its *own* definition of this
;; function; this one is just for source compatibility. ;; function; this one is just for source compatibility.
(define (dont-optimize x) x) (define (dont-optimize x) x)
(provide cond (provide cond
and and
or or
@ -284,6 +309,8 @@
cddddr cddddr
build-path build-path
collection-path collection-path
lifted-send
dont-optimize
list-ref list-ref
(rename frp:case case) (rename frp:case case)
@ -318,7 +345,7 @@
expand syntax-object->datum exn-message continuation-mark-set->list exn-continuation-marks expand syntax-object->datum exn-message continuation-mark-set->list exn-continuation-marks
exn:fail? regexp-match exn:fail? regexp-match
vector->list list->vector make-vector) vector->list list->vector make-vector)
(rename eq? mzscheme:eq?) (rename eq? mzscheme:eq?)
make-exn:fail current-inspector make-inspector make-exn:fail current-inspector make-inspector
make-namespace namespace? namespace-symbol->identifier namespace-variable-value make-namespace namespace? namespace-symbol->identifier namespace-variable-value
@ -346,7 +373,7 @@
quasiquote quasiquote
unquote unquote
unquote-splicing unquote-splicing
syntax syntax
let/ec let/ec
with-handlers with-handlers
@ -363,9 +390,8 @@
current-directory current-directory
exit exit
system-type system-type
lifted-send
unsyntax-splicing unsyntax-splicing
delay delay
force force
random random
@ -374,12 +400,12 @@
file-exists? file-exists?
with-input-from-file with-input-from-file
read read
dont-optimize
) )
; from core ; from core
(provide (all-from "lang-core.rkt")) (provide (all-from "lang-core.rkt"))
) )