Big newline at EOF scan.
This commit is contained in:
Eli Barzilay
parent
0243b50368
commit
f7c67b49a4
|
|
@ -15,4 +15,4 @@
|
|||
(apply launch-many-worlds/proc
|
||||
(build-list 20 (lambda (x) (lambda () (aworld (+ 10 x) (make-color 255 255 x)))))))
|
||||
|
||||
(main)
|
||||
(main)
|
||||
|
|
|
|||
|
|
@ -6,4 +6,3 @@
|
|||
(on-tick (lambda (w) (make-bundle (add1 w) '() '())) 1/28 3)
|
||||
(on-msg void)
|
||||
(on-new cons))
|
||||
|
||||
|
|
@ -5,4 +5,3 @@
|
|||
(big-bang 0
|
||||
(on-tick add1 1/28 3)
|
||||
(to-draw (lambda (w) (circle (- 100 w) 'solid 'red))))
|
||||
|
||||
|
|
@ -15,4 +15,4 @@
|
|||
(big-bang 0+0i
|
||||
(to-draw render)
|
||||
(on-tick add1-i 1/28 50)
|
||||
(on-pad (pad-handler (up sub1-i) (down add1-i) (left sub1) (right add1))))
|
||||
(on-pad (pad-handler (up sub1-i) (down add1-i) (left sub1) (right add1))))
|
||||
|
|
|
|||
|
|
@ -45,4 +45,4 @@
|
|||
|
||||
(require 'server)
|
||||
|
||||
(require 'client)
|
||||
(require 'client)
|
||||
|
|
|
|||
|
|
@ -59,4 +59,4 @@
|
|||
(overlay (text (number->string w) 22 c) (empty-scene 100 100))))
|
||||
|
||||
;; run universe run
|
||||
(main 1 3)
|
||||
(main 1 3)
|
||||
|
|
|
|||
|
|
@ -34,4 +34,4 @@
|
|||
|
||||
(provide/contract
|
||||
[write-theory (-> theory/c void)]
|
||||
[read-theory (-> theory/c)])
|
||||
[read-theory (-> theory/c)])
|
||||
|
|
|
|||
|
|
@ -41,4 +41,4 @@
|
|||
|
||||
set-syncheck-mode
|
||||
get-syncheck-mode
|
||||
update-menu-status)
|
||||
update-menu-status)
|
||||
|
|
|
|||
|
|
@ -90,4 +90,4 @@
|
|||
(define/public (get-length) all-completions-length)
|
||||
(define/public (empty?) (eq? (get-length) 0))
|
||||
|
||||
(super-new)))
|
||||
(super-new)))
|
||||
|
|
|
|||
|
|
@ -1474,4 +1474,3 @@
|
|||
(if (< start-pos click-pos)
|
||||
(f click-pos eol start-pos click-pos)
|
||||
(f click-pos eol click-pos end-pos))))
|
||||
|
||||
|
|
@ -161,4 +161,4 @@
|
|||
[(8) "eighth"]
|
||||
[(9) "ninth"]
|
||||
[(10) "tenth"]
|
||||
[else (number->ord arg-posn)])]))
|
||||
[else (number->ord arg-posn)])]))
|
||||
|
|
|
|||
|
|
@ -151,4 +151,4 @@
|
|||
(raise (exn:fail:filesystem
|
||||
(string-append (format "~a: " sym)
|
||||
(apply format fmt args))
|
||||
(current-continuation-marks))))
|
||||
(current-continuation-marks))))
|
||||
|
|
|
|||
|
|
@ -5,4 +5,4 @@
|
|||
|
||||
(define-unit-from-context cookie@ cookie^)
|
||||
|
||||
(provide cookie@)
|
||||
(provide cookie@)
|
||||
|
|
|
|||
|
|
@ -462,4 +462,4 @@ pic:bloch
|
|||
(clip-picture-colors 240 pic:bloch)
|
||||
(clip-picture-colors 200 pic:bloch)
|
||||
(clip-picture-colors 150 pic:bloch)
|
||||
(clip-picture-colors 100 pic:bloch)
|
||||
(clip-picture-colors 100 pic:bloch)
|
||||
|
|
|
|||
|
|
@ -34,4 +34,4 @@
|
|||
(check-error (rotate-ccw true)
|
||||
"rotate-ccw: expected <image> as first argument, given: true")
|
||||
(check-error (rotate-180 "goodbye")
|
||||
"rotate-180: expected <image> as first argument, given: \"goodbye\"")
|
||||
"rotate-180: expected <image> as first argument, given: \"goodbye\"")
|
||||
|
|
|
|||
|
|
@ -172,4 +172,4 @@
|
|||
(map
|
||||
(lambda (x) (cons (car x) (map (lambda (y) (drop-last (cadr y))) (cdr x))))
|
||||
buckets)))
|
||||
|#
|
||||
|#
|
||||
|
|
|
|||
|
|
@ -703,4 +703,4 @@ This function is called by PLaneT to announce when things are happening. See als
|
|||
|
||||
@defproc[(get-planet-cache-path) (and/c path? absolute-path?)]{
|
||||
Returns the path to the @filepath{cache.rktd} file for the planet installation.
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -928,4 +928,4 @@
|
|||
(atomically
|
||||
(when s
|
||||
(cairo_surface_destroy s)
|
||||
(set! s #f))))))
|
||||
(set! s #f))))))
|
||||
|
|
|
|||
|
|
@ -15,4 +15,4 @@
|
|||
(raise-syntax-error #f "bad syntax" stx)
|
||||
(datum->syntax stx (cdr (syntax-e stx)) stx stx))))
|
||||
|
||||
(#%provide (all-from '#%kernel) #%top-interaction))
|
||||
(#%provide (all-from '#%kernel) #%top-interaction))
|
||||
|
|
|
|||
|
|
@ -78,4 +78,4 @@
|
|||
(syntax-case stx ()
|
||||
[(_ val comp)
|
||||
#'(? (lambda (x) (comp val x)))]
|
||||
[(_ val) #'(? (lambda (x) (equal? val x)))])))
|
||||
[(_ val) #'(? (lambda (x) (equal? val x)))])))
|
||||
|
|
|
|||
|
|
@ -12,6 +12,3 @@
|
|||
[(a) a]
|
||||
[(a b) a]
|
||||
[(a b c) a])])))
|
||||
|
||||
|
||||
|
||||
|
|
@ -96,4 +96,4 @@
|
|||
(test-equal (term (does-not-bind? (letrec ([x x] [y hole] [z z]) y) z)) #f)
|
||||
(test-equal (term (does-not-bind? (letrec ([x x] [y hole] [z z]) y) a)) #t)
|
||||
(test-equal (term (does-not-bind? (letrec ([x x]) (letrec ([y y]) hole)) y)) #f)
|
||||
(test-equal (term (does-not-bind? (letrec ([x x]) (letrec ([y hole]) y)) y)) #f)
|
||||
(test-equal (term (does-not-bind? (letrec ([x x]) (letrec ([y hole]) y)) y)) #f)
|
||||
|
|
|
|||
|
|
@ -5,4 +5,4 @@
|
|||
"CMT-test.rkt"
|
||||
redex/reduction-semantics)
|
||||
|
||||
(test-results)
|
||||
(test-results)
|
||||
|
|
|
|||
|
|
@ -86,4 +86,4 @@
|
|||
(term 2))
|
||||
(test-->> reduction
|
||||
(term (((λ (x) (λ (y) (x y))) (λ (z) z)) 1))
|
||||
(term 1))
|
||||
(term 1))
|
||||
|
|
|
|||
|
|
@ -135,4 +135,4 @@
|
|||
(judgment-holds (small-step e_1 e_2)))))
|
||||
|
||||
(define (trace-λv expr)
|
||||
(traces small-step-rr expr))
|
||||
(traces small-step-rr expr))
|
||||
|
|
|
|||
|
|
@ -109,4 +109,4 @@
|
|||
(['typeof rewrite-typeof]
|
||||
['extend rewrite-extend]
|
||||
['lookup rewrite-lookup])
|
||||
(render-judgment-form typeof))
|
||||
(render-judgment-form typeof))
|
||||
|
|
|
|||
|
|
@ -46,4 +46,4 @@
|
|||
(format
|
||||
"found a cycle that includes the non-terminal ~a"
|
||||
cycle)
|
||||
stx)))
|
||||
stx)))
|
||||
|
|
|
|||
|
|
@ -14,4 +14,4 @@
|
|||
(thunk)))
|
||||
|
||||
(define (report-undefined name desc)
|
||||
(redex-error #f "reference to ~a ~s before its definition" desc name))
|
||||
(redex-error #f "reference to ~a ~s before its definition" desc name))
|
||||
|
|
|
|||
|
|
@ -128,4 +128,3 @@ turns into this:
|
|||
(car should-be-pats))
|
||||
stx))
|
||||
#'(match to-match [pats rhs ...] ...))]))
|
||||
|
||||
|
|
@ -38,4 +38,4 @@
|
|||
|
||||
(define (not-expression-context stx)
|
||||
(when (eq? (syntax-local-context) 'expression)
|
||||
(raise-syntax-error #f "not allowed in an expression context" stx)))
|
||||
(raise-syntax-error #f "not allowed in an expression context" stx)))
|
||||
|
|
|
|||
|
|
@ -63,4 +63,4 @@
|
|||
#:volume 9
|
||||
#:number "4"
|
||||
#:pages '(244 257))
|
||||
#:date "1970"))
|
||||
#:date "1970"))
|
||||
|
|
|
|||
|
|
@ -179,4 +179,4 @@
|
|||
(test (send annotations collected-rename-class use-name)
|
||||
(expected-rename-class (list def-name use-name))))
|
||||
|
||||
(print-tests-passed 'check-syntax-test.rkt)
|
||||
(print-tests-passed 'check-syntax-test.rkt)
|
||||
|
|
|
|||
|
|
@ -21,4 +21,4 @@
|
|||
|
||||
(define x 4)
|
||||
|
||||
(print-tests-passed 'defined-checks-test.rkt)
|
||||
(print-tests-passed 'defined-checks-test.rkt)
|
||||
|
|
|
|||
|
|
@ -9,4 +9,4 @@
|
|||
(judgment-holds judgment))
|
||||
(#rx"output q at position 2"
|
||||
([judgment (ctc-fail c s)])
|
||||
(judgment-holds judgment))
|
||||
(judgment-holds judgment))
|
||||
|
|
|
|||
|
|
@ -7,4 +7,4 @@
|
|||
#:mode (name I)
|
||||
[(name (binder1 ellipsis binder2 ellipsis))
|
||||
premise])
|
||||
(judgment-holds (name (1 2)))))
|
||||
(judgment-holds (name (1 2)))))
|
||||
|
|
|
|||
|
|
@ -6,4 +6,4 @@
|
|||
(define-judgment-form L
|
||||
#:mode (def I)
|
||||
[(def 1)])
|
||||
#f))
|
||||
#f))
|
||||
|
|
|
|||
|
|
@ -5,4 +5,4 @@
|
|||
(define-language L)
|
||||
(define-metafunction L
|
||||
[(def) ()])
|
||||
#f))
|
||||
#f))
|
||||
|
|
|
|||
|
|
@ -46,4 +46,4 @@
|
|||
(let ()
|
||||
(define t (term (use y)))
|
||||
(define-term def z)
|
||||
t))
|
||||
t))
|
||||
|
|
|
|||
|
|
@ -206,4 +206,4 @@
|
|||
[(K a any_1 x)
|
||||
(K b (use) (name inner-def any))]
|
||||
[(K b any K-b-out)])
|
||||
(void)))
|
||||
(void)))
|
||||
|
|
|
|||
|
|
@ -9,4 +9,4 @@
|
|||
(define-judgment-form syn-err-lang
|
||||
#:mode (name I)
|
||||
[(name a)])
|
||||
(judgment-holds bad-judgment)))
|
||||
(judgment-holds bad-judgment)))
|
||||
|
|
|
|||
|
|
@ -44,4 +44,4 @@
|
|||
(-e any))
|
||||
(define-language L2
|
||||
(e any))
|
||||
(define-union-language L L1r L2r)))
|
||||
(define-union-language L L1r L2r)))
|
||||
|
|
|
|||
|
|
@ -17,4 +17,4 @@
|
|||
(define-metafunction not-id also-junk))
|
||||
(#rx"expected an identifier"
|
||||
([not-id junk])
|
||||
(define-metafunction not-id also-junk))
|
||||
(define-metafunction not-id also-junk))
|
||||
|
|
|
|||
|
|
@ -1,3 +1,3 @@
|
|||
(#rx"redex-let: duplicate pattern variable"
|
||||
([dup number])
|
||||
(redex-let syn-err-lang ([(dup) 1] [dup 1]) (term dup)))
|
||||
(redex-let syn-err-lang ([(dup) 1] [dup 1]) (term dup)))
|
||||
|
|
|
|||
|
|
@ -135,4 +135,4 @@
|
|||
(reduction-relation
|
||||
syn-err-lang
|
||||
(--> 1 1
|
||||
(judgment-holds bad-judgment)))))
|
||||
(judgment-holds bad-judgment)))))
|
||||
|
|
|
|||
|
|
@ -5,4 +5,4 @@
|
|||
(#rx"too few ellipses"
|
||||
([bound x]) ([bind x])
|
||||
(... (term-let ([((bind ...) ...) '()])
|
||||
(term (bound ...)))))
|
||||
(term (bound ...)))))
|
||||
|
|
|
|||
|
|
@ -686,4 +686,4 @@ Different kinds of bitmaps can produce different results:
|
|||
when consistency with screen drawing is needed for some other
|
||||
reason.}
|
||||
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -280,12 +280,12 @@ Returns @racket[(not v)].}
|
|||
(implies #f #f)
|
||||
(implies #t #f)
|
||||
(implies #f (error 'ack "we don't get here"))]
|
||||
|
||||
|
||||
}
|
||||
|
||||
@defproc[(xor [b1 any/c] [b2 any/c]) any]{
|
||||
Returns the exclusive or of @racket[b1] and @racket[b2].
|
||||
|
||||
|
||||
If exactly one of @racket[b1] and @racket[b2] is
|
||||
not @racket[#f], then return it. Otherwise, returns
|
||||
@racket[#f].
|
||||
|
|
@ -296,5 +296,5 @@ Returns @racket[(not v)].}
|
|||
(xor #f 22)
|
||||
(xor 11 22)
|
||||
(xor #f #f)]
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -45,4 +45,4 @@ for the @racketmodname[racket/base] language.
|
|||
is a minimal initial environment intended for scripts that require low
|
||||
startup time. It re-exports the bindings of the
|
||||
@indexed-racket['#%kernel], along with a binding for
|
||||
@racket[#%top-interaction].}
|
||||
@racket[#%top-interaction].}
|
||||
|
|
|
|||
|
|
@ -97,4 +97,4 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
|
|||
|
||||
(define (set-port-next-location-from src dest)
|
||||
(define-values (line col pos) (port-next-location src))
|
||||
(set-port-next-location! dest line col pos))
|
||||
(set-port-next-location! dest line col pos))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang datalog
|
||||
friend(arnold,arnold).
|
||||
student(arnold,arnold,arnold) :- friend(arnold,arnold).
|
||||
student(arnold,arnold,arnold)?
|
||||
student(arnold,arnold,arnold)?
|
||||
|
|
|
|||
|
|
@ -102,4 +102,4 @@ in let
|
|||
t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
|
||||
in let times4 = (fix t4m)
|
||||
in (times4 3)" 12)
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -102,4 +102,4 @@ in let
|
|||
in let times4 = (fix t4m)
|
||||
in (times4 3)" 12)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -196,4 +196,4 @@ in -((g 22), (g 22))"
|
|||
in -((g 22), (g 22))"
|
||||
-1)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -263,4 +263,4 @@ in begin
|
|||
end"
|
||||
44)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -190,4 +190,4 @@ in begin
|
|||
end"
|
||||
11)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -162,4 +162,4 @@ let f = proc (x) proc (y)
|
|||
in ((f 44) 33)"
|
||||
12)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -9097,4 +9097,4 @@ lecture09/exceptions/interp.scm 15-Mar-06
|
|||
#(struct:end-cont))
|
||||
|(apply-cont #(struct:end-cont) #(struct:num-val -1))
|
||||
|#(struct:num-val -1)
|
||||
>
|
||||
>
|
||||
|
|
|
|||
|
|
@ -134,4 +134,4 @@ in let times4 = (fix t4m)
|
|||
in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1))
|
||||
in (odd 13)" 1)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -183,4 +183,4 @@ in let times4 = (fix t4m)
|
|||
in +((fib 1), 12, (fib 5))"
|
||||
21)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -236,4 +236,4 @@
|
|||
proc (y) -(x,y))))"
|
||||
-1)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -237,4 +237,4 @@ in let f = proc (z) let zz = newref(-(z,deref(x))) in deref(zz)
|
|||
in -((f 66), (f 55))"
|
||||
11)
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -357,4 +357,4 @@ in fact"
|
|||
"letrec ? f (x : ?) = (f x) in proc (n : ?) (f -(n,1))"
|
||||
(int -> tvar01))
|
||||
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -973,9 +973,3 @@ from m2 take foo"
|
|||
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -44,4 +44,4 @@
|
|||
((and (pair? x) (pair? y)
|
||||
(= (length x) (length y))
|
||||
(map foo x y))
|
||||
(else '**))))
|
||||
(else '**))))
|
||||
|
|
|
|||
|
|
@ -1636,9 +1636,3 @@ from m2 take foo"
|
|||
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -334,9 +334,3 @@ module m
|
|||
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -755,14 +755,4 @@ We should also test deep continuations.
|
|||
(run-tests future)
|
||||
(run-tests would-be-future)
|
||||
|
||||
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
|
|||
|
|
@ -3,4 +3,4 @@
|
|||
(define-struct a (b))
|
||||
(match (make-a 1)
|
||||
[(struct a (b)) b]
|
||||
[#f 3])
|
||||
[#f 3])
|
||||
|
|
|
|||
|
|
@ -8,4 +8,4 @@
|
|||
|
||||
;; The body of this function should be the only red in the file
|
||||
(define (f x)
|
||||
(+ 1 1))
|
||||
(+ 1 1))
|
||||
|
|
|
|||
|
|
@ -11,4 +11,4 @@
|
|||
(define (f x)
|
||||
(cond* x
|
||||
[(string? x) #t]
|
||||
[(exact-nonnegative-integer? x) #f]))
|
||||
[(exact-nonnegative-integer? x) #f]))
|
||||
|
|
|
|||
|
|
@ -13,4 +13,4 @@
|
|||
(ann (match pi
|
||||
[(list n) 'success]
|
||||
[other 'failure])
|
||||
(U #;'success 'failure)))
|
||||
(U #;'success 'failure)))
|
||||
|
|
|
|||
|
|
@ -15,4 +15,4 @@
|
|||
|
||||
|
||||
(add1 (f 0))
|
||||
(add1 (f))
|
||||
(add1 (f))
|
||||
|
|
|
|||
|
|
@ -4,4 +4,4 @@
|
|||
|
||||
(unless (equal? (parameter? current-directory)
|
||||
(if (parameter? current-directory) #t #f))
|
||||
(error 'unsound!))
|
||||
(error 'unsound!))
|
||||
|
|
|
|||
|
|
@ -123,4 +123,4 @@
|
|||
|
||||
|
||||
(define-go typecheck-special-tests)
|
||||
(provide typecheck-special-tests)
|
||||
(provide typecheck-special-tests)
|
||||
|
|
|
|||
|
|
@ -19,4 +19,4 @@
|
|||
(serve/servlet app-dispatch
|
||||
#:port 8000
|
||||
#:servlet-regexp #rx""
|
||||
#:command-line? #t)
|
||||
#:command-line? #t)
|
||||
|
|
|
|||
|
|
@ -77,4 +77,4 @@
|
|||
(get-post-data/raw "hello=world") #"hello=world")
|
||||
(test-equal? "simple test 3"
|
||||
(binding:form-value (bindings-assq #"hello" (force (get-bindings "hello=world"))))
|
||||
#"world")))))
|
||||
#"world")))))
|
||||
|
|
|
|||
|
|
@ -87,4 +87,4 @@
|
|||
(test-case "double-counters"
|
||||
(test-double-counters
|
||||
(make-servlet-tester ex:double:start)))))
|
||||
(provide test-tests)
|
||||
(provide test-tests)
|
||||
|
|
|
|||
|
|
@ -30,4 +30,4 @@
|
|||
(se-path* '(p) '(html (body (p "Hey"))))
|
||||
=> "Hey"
|
||||
(se-path* '(p #:bar) '(html (body (p ([bar "Zog"]) "Hey"))))
|
||||
=> "Zog")
|
||||
=> "Zog")
|
||||
|
|
|
|||
|
|
@ -57,4 +57,3 @@
|
|||
(provide convert convertible?)
|
||||
(provide/contract
|
||||
[prop:convertible (struct-type-property/c (-> convertible? pict?))])
|
||||
|
||||
|
|
@ -20,4 +20,4 @@
|
|||
#:attr mapping (dict-set (make-immutable-free-id-table) #'e.i #'x)
|
||||
#:attr flag-mapping (if (attribute e.j)
|
||||
(dict-set (make-immutable-free-id-table) #'e.i #'e.j)
|
||||
(make-immutable-free-id-table))))
|
||||
(make-immutable-free-id-table))))
|
||||
|
|
|
|||
|
|
@ -12,4 +12,4 @@
|
|||
[find-seconds (case-> (Integer Integer Integer Integer Integer Integer -> Integer)
|
||||
(Integer Integer Integer Integer Integer Integer Any -> Integer))]
|
||||
[date->julian/scalinger (date -> Integer)]
|
||||
[julian/scalinger->string (Integer -> String)])
|
||||
[julian/scalinger->string (Integer -> String)])
|
||||
|
|
|
|||
|
|
@ -74,4 +74,4 @@ example that tests an Add-Two-Numbers.com:
|
|||
(make-servlet-tester ex:add1:start))
|
||||
(test-add-two-numbers
|
||||
(make-servlet-tester ex:add2:start))
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1410,4 +1410,4 @@ to be useful. There are interfaces to other databases, many tools for generating
|
|||
output in HTML, XML, Javascript, etc.
|
||||
|
||||
There is also an active community of users on the Racket mailing list. We
|
||||
welcome new users!
|
||||
welcome new users!
|
||||
|
|
|
|||
|
|
@ -78,4 +78,4 @@
|
|||
[se-path*/list
|
||||
(-> se-path? xexpr?
|
||||
; XXX see above
|
||||
(listof any/c))])
|
||||
(listof any/c))])
|
||||
|
|
|
|||
|
|
@ -8,7 +8,6 @@
|
|||
(define url-base (string-append "http://" url-host url-path))
|
||||
(define architecture #f) ;; set in `do-download'
|
||||
|
||||
|
||||
(define (delete-path path)
|
||||
(cond [(directory-exists? path)
|
||||
(parameterize ([current-directory path])
|
||||
|
|
@ -61,7 +60,6 @@
|
|||
"size of ~a is ~a; doesn't match expected size ~a"
|
||||
file sz size)))
|
||||
|
||||
|
||||
(define (unpack-tgz tgz)
|
||||
(printf " unpacking...") (flush-output)
|
||||
(define-values [p pout pin perr]
|
||||
|
|
@ -77,7 +75,6 @@
|
|||
(raise-user-error 'get-libs "don't know how to install file: ~a"
|
||||
file)]))
|
||||
|
||||
|
||||
(define (do-download needed really-needed arch)
|
||||
(set! architecture arch)
|
||||
(printf ">> Downloading files from\n>> ~a~a\n" url-base architecture)
|
||||
|
|
@ -95,4 +92,4 @@
|
|||
(delete-path (caddr file+size))
|
||||
(install file))
|
||||
(printf " done.\n"))
|
||||
(printf " already exists.\n"))))
|
||||
(printf " already exists.\n"))))
|
||||
|
|
|
|||
|
|
@ -1,16 +1,16 @@
|
|||
;; This program avoids is written in #%kernel and
|
||||
;; This program is written in #%kernel and
|
||||
;; dynamic-requires the real downloading,
|
||||
;; because it is loaded without using bytecode.
|
||||
(module get-libs '#%kernel
|
||||
(#%require '#%paramz (for-syntax '#%kernel))
|
||||
(#%provide all-files+sizes)
|
||||
|
||||
|
||||
(define-values (all-files+sizes)
|
||||
;; alist mapping package to
|
||||
;; alist mapping architecture to
|
||||
;; a list of entries, each has filename and size
|
||||
;; and optionally a path that it would install to and the installed size
|
||||
(list
|
||||
(list
|
||||
;; Core Libraries
|
||||
'[core
|
||||
[win32/i386
|
||||
|
|
@ -22,7 +22,7 @@
|
|||
["libeay32.dll" 1503232]
|
||||
["ssleay32.dll" 309760]]]
|
||||
;; GUI Libraries
|
||||
[list
|
||||
[list
|
||||
'gui
|
||||
'[i386-macosx
|
||||
["libcairo.2.dylib" 802620]
|
||||
|
|
@ -69,7 +69,7 @@
|
|||
["libgthread-2.0.0.dylib" 25068]
|
||||
["libpng15.15.dylib" 570228]
|
||||
["PSMTabBarControl.tgz" 96039 "PSMTabBarControl.framework" 229501]]
|
||||
(append
|
||||
(append
|
||||
'[win32/i386
|
||||
["libjpeg-7.dll" 233192]
|
||||
["libcairo-2.dll" 921369]
|
||||
|
|
@ -123,27 +123,27 @@
|
|||
["myssink.dll" 92672]]
|
||||
[win32/x86_64
|
||||
["myssink.dll" 108032]]]))
|
||||
|
||||
|
||||
(define-values [package dest-dir]
|
||||
(let-values ([(args) (vector->list (current-command-line-arguments))])
|
||||
(let-values
|
||||
([(package) (if (null? args)
|
||||
(error 'get-libs "missing \'package\' command-line argument")
|
||||
(car args))])
|
||||
(let-values ([(dd)
|
||||
(error 'get-libs "missing \'package\' command-line argument")
|
||||
(car args))])
|
||||
(let-values ([(dd)
|
||||
(if (null? (cdr args)) (current-directory) (cadr args))])
|
||||
(values (string->symbol package) dd)))))
|
||||
|
||||
|
||||
(define-values (unixize)
|
||||
(lambda (p)
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(if (path? base)
|
||||
(string-append (unixize base) "/" (path->string name))
|
||||
(path->string name)))))
|
||||
|
||||
|
||||
(define-values (architecture)
|
||||
(string->symbol (unixize (system-library-subpath #f))))
|
||||
|
||||
|
||||
(define-values (needed-files+sizes)
|
||||
(lambda ()
|
||||
(define-values (l) (assq package all-files+sizes))
|
||||
|
|
@ -156,30 +156,29 @@
|
|||
(if arch
|
||||
(cdr arch)
|
||||
'())))
|
||||
|
||||
|
||||
(define-values (directory-size)
|
||||
(lambda (dir)
|
||||
(define-values (loop)
|
||||
(lambda (l)
|
||||
(if (null? l)
|
||||
0
|
||||
(+ (path-size (build-path dir (car l))) (loop (cdr l))))))
|
||||
(if (null? l)
|
||||
0
|
||||
(+ (path-size (build-path dir (car l))) (loop (cdr l))))))
|
||||
(loop (directory-list dir))))
|
||||
|
||||
|
||||
(define-values (path-size)
|
||||
(lambda (path)
|
||||
(if (file-exists? path) (file-size path)
|
||||
(if (directory-exists? path)
|
||||
(if (directory-exists? path)
|
||||
(directory-size path)
|
||||
0))))
|
||||
|
||||
|
||||
(define-values (got-path?) ; approximate, using size
|
||||
(case-lambda [(path size unpacked-path unpacked-size)
|
||||
(got-path? unpacked-path unpacked-size)]
|
||||
[(path size)
|
||||
(equal? size (path-size path))]))
|
||||
|
||||
|
||||
|
||||
;; not provided by #%kernel
|
||||
(define-values (filter)
|
||||
(lambda (f l)
|
||||
|
|
@ -188,9 +187,9 @@
|
|||
(if (f (car l))
|
||||
(cons (car l) (filter f (cdr l)))
|
||||
(filter f (cdr l))))))
|
||||
|
||||
|
||||
(define-syntaxes (here-dir)
|
||||
(λ (stx)
|
||||
(λ (stx)
|
||||
(define-values (base name dir?) (split-path (syntax-source stx)))
|
||||
(datum->syntax (quote-syntax 'here) base)))
|
||||
|
||||
|
|
@ -204,7 +203,7 @@
|
|||
current-directory dest-dir)
|
||||
(let-values ()
|
||||
(define-values (needed) (needed-files+sizes))
|
||||
(define-values (really-needed)
|
||||
(define-values (really-needed)
|
||||
(filter (λ (n) (not (apply got-path? n))) needed))
|
||||
(printf (if (null? needed)
|
||||
">> No ~a libraries to download for ~a\n"
|
||||
|
|
@ -212,7 +211,7 @@
|
|||
package architecture)
|
||||
(if (null? needed)
|
||||
(void)
|
||||
(if (null? really-needed)
|
||||
(if (null? really-needed)
|
||||
(printf ">> All files present, no downloads needed.\n")
|
||||
((dynamic-require (build-path here-dir "download-libs.rkt") 'do-download)
|
||||
needed really-needed architecture))))))))
|
||||
needed really-needed architecture))))))))
|
||||
|
|
|
|||
2
src/myssink/.gitignore
vendored
2
src/myssink/.gitignore
vendored
|
|
@ -3,4 +3,4 @@
|
|||
/myssink_p.c
|
||||
/myssink.tlb
|
||||
/myssink.res
|
||||
/dlldata.c
|
||||
/dlldata.c
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user