[make works] Added raco test to makefile, fixed long lines in all *.rkt files.
This commit is contained in:
Georges Dupéron
parent
a2e37a10a4
commit
f43b08eba3
|
|
@ -1,190 +0,0 @@
|
|||
#lang typed/racket
|
||||
|
||||
(require "cond-abort.rkt")
|
||||
(require "variant.lp2.rkt")
|
||||
(require typed/rackunit)
|
||||
|
||||
(check-equal?
|
||||
(match-abort '(1 (a b) 3)
|
||||
[(list x y z)
|
||||
(let-abort ([new-x x]
|
||||
[new-y (match-abort y
|
||||
[(list n p) (list 'A n p)]
|
||||
[(list q r s) (list 'B q r s)])]
|
||||
[new-z z])
|
||||
(list new-x new-y new-z))])
|
||||
'(1 (A a b) 3))
|
||||
|
||||
(let ()
|
||||
(λ ([x : (U (Vector Number) (Vector String String))])
|
||||
(if (= (vector-length x) 1)
|
||||
x ;; Occurrence typing didn't narrow the type of x to (Vector Number).
|
||||
x))
|
||||
(void))
|
||||
|
||||
#|
|
||||
|
||||
(λ ((v : (List Symbol String)))
|
||||
(match-abort
|
||||
v
|
||||
((list Symbol1 String2)
|
||||
(let-abort
|
||||
((Symbol3 (protected Symbol1)) (String4 (match-abort String2 ((and String5) (string-length String5)))))
|
||||
(list (unprotect Symbol3) (unprotect String4))))))
|
||||
|
||||
(λ ([v : (List Symbol String)])
|
||||
(match-abort
|
||||
v
|
||||
((list Symbol1 String2)
|
||||
(let-abort
|
||||
((Symbol3 #t) (String4 (match-abort String2 ((and String5) (string-length String5)))))
|
||||
(list Symbol3 String4)))))
|
||||
|
||||
(λ ((v : (List Symbol String)))
|
||||
(unprotect
|
||||
(match-abort
|
||||
v
|
||||
((list Symbol1 String2)
|
||||
(let-abort
|
||||
((Symbol3 (protected Symbol1)) (String4 (match-abort String2 ((and String5) (protected (string-length String5))))))
|
||||
(protected (list (unprotect Symbol3) (unprotect String4))))))))
|
||||
|
||||
|#
|
||||
|
||||
|
||||
|
||||
(check-equal?
|
||||
(foldl
|
||||
(λ (x acc)
|
||||
(if (null? x)
|
||||
acc;(reverse acc)
|
||||
(if (eq? x 'boo)
|
||||
'continue
|
||||
(cons x acc))))
|
||||
'()
|
||||
'(a b c))
|
||||
'(c b a))
|
||||
|
||||
|
||||
(begin
|
||||
(:
|
||||
test1a
|
||||
(→
|
||||
(List (Pairof (List Symbol (Listof String)) String))
|
||||
(List (Pairof (List Symbol (Listof Number)) Number))))
|
||||
(define (test1a v)
|
||||
(let-values (((temp2) (apply values v)))
|
||||
(list
|
||||
(let ((val-cache3 temp2))
|
||||
(cons
|
||||
(let-values (((Symbol5 temp6) (apply values (car val-cache3))))
|
||||
(list Symbol5 (map (λ ((String9 : String)) (string-length String9)) temp6)))
|
||||
(string-length (cdr val-cache3))))))))
|
||||
|
||||
|
||||
|
||||
(begin
|
||||
(:
|
||||
test1
|
||||
(→
|
||||
(List
|
||||
(Pairof
|
||||
(U
|
||||
(List 'tag1 (List (Vector Symbol) (Listof String)))
|
||||
(List 'tag2 (List (Vector Symbol) (Listof String))))
|
||||
String))
|
||||
(List
|
||||
(Pairof
|
||||
(U
|
||||
(List 'tag1 (List (Vector Symbol) (Listof Number)))
|
||||
(List 'tag2 (List (Vector Symbol) (Listof Number))))
|
||||
Number))))
|
||||
(define (test1 v)
|
||||
(let-values (((temp2) (apply values v)))
|
||||
(list
|
||||
(let ((val-cache3 temp2))
|
||||
(cons
|
||||
(let ((val-cache4 (car val-cache3)))
|
||||
(cond
|
||||
((and (list? val-cache4) (eq? 'tag1 (car val-cache4)))
|
||||
(let-values (((temp6 temp7) (apply values val-cache4)))
|
||||
(list
|
||||
temp6
|
||||
(let-values (((temp10 temp11) (apply values temp7)))
|
||||
(list
|
||||
(let ((val-cache12 temp10))
|
||||
(let ((Symbol13 (vector-ref val-cache12 0))) (vector Symbol13)))
|
||||
(map (λ ((String16 : String)) (string-length String16)) temp11))))))
|
||||
((and (list? val-cache4) (eq? 'tag2 (car val-cache4)))
|
||||
(let-values (((temp20 temp21) (apply values val-cache4)))
|
||||
(list
|
||||
temp20
|
||||
(let-values (((temp24 temp25) (apply values temp21)))
|
||||
(list
|
||||
(let ((val-cache26 temp24))
|
||||
(let ((Symbol27 (vector-ref val-cache26 0))) (vector Symbol27)))
|
||||
(map (λ ((String30 : String)) (string-length String30)) temp25))))))))
|
||||
(string-length (cdr val-cache3))))))))
|
||||
|
||||
#|
|
||||
(define-syntax-rule (map-abort lst v . body)
|
||||
#;(let ([l (foldl (λ (v acc)
|
||||
(let ([result (let () . body)])
|
||||
(if (eq? result 'continue)
|
||||
'continue
|
||||
(if (eq? result 'break)
|
||||
'break
|
||||
(cons (unprotect result) acc)))))
|
||||
'()
|
||||
lst)])
|
||||
(if (or (eq? l 'continue) (eq? l 'break))
|
||||
l
|
||||
(reverse l))))
|
||||
|
||||
(begin
|
||||
(:
|
||||
test1
|
||||
(→
|
||||
(List (Pairof (List Symbol (Listof String)) String))
|
||||
(List (Pairof (List Symbol (Listof Number)) Number))))
|
||||
(define (test1 v)
|
||||
(unprotect
|
||||
(match-abort
|
||||
v
|
||||
((list temp1)
|
||||
(let-abort
|
||||
((temp2
|
||||
(match-abort
|
||||
temp1
|
||||
((cons temp3 String4)
|
||||
(let-abort
|
||||
((temp5
|
||||
(match-abort
|
||||
temp3
|
||||
((list Symbol7 temp8)
|
||||
(let-abort
|
||||
((Symbol9 (protected Symbol7))
|
||||
(temp10
|
||||
#;(match-abort
|
||||
temp8
|
||||
((list String11 ...)
|
||||
(begin String11 (error "e"))))
|
||||
(match-abort
|
||||
temp8
|
||||
((list String11 ...)
|
||||
(map-abort
|
||||
String11
|
||||
String12
|
||||
(match-abort
|
||||
String12
|
||||
((and String13)
|
||||
(protected (string-length String13)))))))))
|
||||
(protected
|
||||
(list (unprotect Symbol9) (unprotect temp10)))))))
|
||||
(String6
|
||||
(match-abort
|
||||
String4
|
||||
((and String14) (protected (string-length String14))))))
|
||||
(protected (cons (unprotect temp5) (unprotect String6))))))))
|
||||
(protected (list (unprotect temp2)))))))))
|
||||
|#
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
#lang typed/racket/no-check
|
||||
|
||||
|
||||
#;(λ ([x : (U (Vector Number) (Vector String String))])
|
||||
(ann (vector-ref x 0) (U Number String)))
|
||||
|
||||
(let ()
|
||||
(ann (λ ([x : (U (Vector Number) (Vector String String) Symbol)])
|
||||
(if (vector? x)
|
||||
x
|
||||
#f))
|
||||
(→ (U (Vector Number) (Vector String String) Symbol)
|
||||
(U False (Vector Number) (Vector String String))))
|
||||
|
||||
|
||||
(λ ([x : (U (→ Number Number Number) (→ Number Number))])
|
||||
(procedure-arity x))
|
||||
(void))
|
||||
|
|
@ -5,13 +5,27 @@
|
|||
|
||||
(define-struct untyped-object ()
|
||||
#:transparent
|
||||
;#:property prop:procedure (λ (self . rest) (apply (untyped-object-proc self) rest))
|
||||
;#:property prop:procedure (λ (self . rest)
|
||||
; (apply (untyped-object-proc self) rest))
|
||||
#:methods gen:custom-write
|
||||
[(define write-proc (λ (self port mode) (((vector-ref (struct->vector self) 1) 'write-proc) port mode)))]
|
||||
[(define write-proc (λ (self port mode)
|
||||
(let* ([f (vector-ref (struct->vector self) 1)]
|
||||
[write-proc (f 'write-proc)])
|
||||
(write-proc port mode))))]
|
||||
#:methods gen:equal+hash
|
||||
[(define equal-proc (λ (x y recursive-equal?) (((vector-ref (struct->vector x) 1) 'equal-proc) y recursive-equal?)))
|
||||
(define hash-proc (λ (x recursive-equal-hash-code?) (((vector-ref (struct->vector x) 1) 'hash-proc) recursive-equal-hash-code?)))
|
||||
(define hash2-proc (λ (x recursive-equal-secondary-hash-code?) (((vector-ref (struct->vector x) 1) 'hash2-proc) recursive-equal-secondary-hash-code?)))]))
|
||||
[(define equal-proc (λ (x y recursive-equal?)
|
||||
(let* ([f (vector-ref (struct->vector x) 1)]
|
||||
[equal-proc (f 'equal-proc)])
|
||||
(f y recursive-equal?))))
|
||||
(define hash-proc (λ (x recursive-equal-hash-code?)
|
||||
(let* ([f (vector-ref (struct->vector x) 1)]
|
||||
[hash-proc (f 'hash-proc)])
|
||||
(hash-proc recursive-equal-hash-code?))))
|
||||
(define hash2-proc (λ (x recursive-equal-secondary-hash-code?)
|
||||
(let* ([f (vector-ref (struct->vector x) 1)]
|
||||
[hash2-proc (f 'hash2-proc)])
|
||||
(hash2-proc
|
||||
recursive-equal-secondary-hash-code?))))]))
|
||||
|
||||
|
||||
(module typed typed/racket
|
||||
|
|
@ -19,23 +33,31 @@
|
|||
[#:struct untyped-object ()])
|
||||
|
||||
(define-type Field-Present (Vector Any))
|
||||
|
||||
|
||||
(: field-present (→ Any Field-Present))
|
||||
(define (field-present x) (vector x))
|
||||
|
||||
|
||||
(: field-present-get-value (→ Field-Present Any))
|
||||
(define (field-present-get-value fp) (vector-ref fp 0))
|
||||
|
||||
(struct (T) Equatable untyped-object
|
||||
([f : (case→ [→ 'value T] ;; Sadly, we can't extend a case→ described by T, so we have to chain two calls to access any field.
|
||||
([f : (case→ [→ 'value T]
|
||||
;; Above: Sadly, we can't extend a case→ described by T,
|
||||
;; so we have to chain two calls to access any field.
|
||||
|
||||
;; TODO: we could just directly accept the other parameters
|
||||
[→ 'write-proc (→ Output-Port (U #t #f 0 1) Any)]
|
||||
[→ 'equal-proc (→ (U Equatable Any) (→ Any Any Boolean) Boolean)]
|
||||
[→ 'hash-proc (→ (→ Any Fixnum) Fixnum)]
|
||||
[→ 'hash2-proc (→ (→ Any Fixnum) Fixnum)]
|
||||
[→ 'reflect (→ (U Index Symbol) (U Field-Present #f))])])
|
||||
[→ 'write-proc (→ Output-Port (U #t #f 0 1)
|
||||
Any)]
|
||||
[→ 'equal-proc (→ (U Equatable Any) (→ Any Any Boolean)
|
||||
Boolean)]
|
||||
[→ 'hash-proc (→ (→ Any Fixnum)
|
||||
Fixnum)]
|
||||
[→ 'hash2-proc (→ (→ Any Fixnum)
|
||||
Fixnum)]
|
||||
[→ 'reflect (→ (U Index Symbol)
|
||||
(U Field-Present #f))])])
|
||||
#:transparent)
|
||||
|
||||
|
||||
(: Equatable-value (∀ (T) (→ (Equatable T) T)))
|
||||
(define (Equatable-value e) ((Equatable-f e) 'value))
|
||||
|
||||
|
|
|
|||
|
|
@ -188,14 +188,14 @@ Here is an overview of the architecture of the graph constructor:
|
|||
<stx-transform/result-node/extract-link-requests>
|
||||
<stx-transform/link-request→incomplete>
|
||||
#`(let ()
|
||||
<param-type/old>
|
||||
(let ()
|
||||
<define-incomplete-types>
|
||||
<define-make-link-requests>
|
||||
<transform/link-request→incomplete>
|
||||
<define-transforms>
|
||||
<make-graph-database>
|
||||
make-graph-database)))]
|
||||
<param-type/old>
|
||||
(let ()
|
||||
<define-incomplete-types>
|
||||
<define-make-link-requests>
|
||||
<transform/link-request→incomplete>
|
||||
<define-transforms>
|
||||
<make-graph-database>
|
||||
make-graph-database)))]
|
||||
|
||||
@chunk[<test-make-graph-constructor>
|
||||
(define make-g (make-graph-constructor
|
||||
|
|
@ -412,7 +412,8 @@ those to the queue.
|
|||
(let* ([transformed
|
||||
: transform/result-node/incomplete
|
||||
(apply transform/link-request→incomplete
|
||||
(cdr (transform/link-request-pre-declared-key request)))]
|
||||
(cdr (transform/link-request-pre-declared-key
|
||||
request)))]
|
||||
[transform/transformed
|
||||
(cons transformed transform/transformed)]
|
||||
[extracted
|
||||
|
|
|
|||
|
|
@ -64,7 +64,12 @@ some of those need to be deleted before being processed).
|
|||
Result)))]
|
||||
|
||||
@chunk[<fold-queue>
|
||||
(define (fold-queue initial-queue accumulator last-result dequeue empty? process)
|
||||
(define (fold-queue initial-queue
|
||||
accumulator
|
||||
last-result
|
||||
dequeue
|
||||
empty?
|
||||
process)
|
||||
(let process-rest ([queue initial-queue] [accumulator accumulator])
|
||||
(if (empty? queue)
|
||||
(last-result accumulator)
|
||||
|
|
|
|||
|
|
@ -556,8 +556,7 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and
|
|||
"variant.lp2.rkt"
|
||||
"../type-expander/multi-id.lp2.rkt"
|
||||
"../type-expander/type-expander.lp2.rkt"
|
||||
"../lib/low.rkt"
|
||||
"cond-abort.rkt")
|
||||
"../lib/low.rkt")
|
||||
(begin-for-syntax (provide replace-in-type
|
||||
;replace-in-instance
|
||||
fold-instance
|
||||
|
|
@ -582,8 +581,7 @@ These metafunctions just extract the arguments for @tc[replace-in-type] and
|
|||
"structure.lp2.rkt"
|
||||
"variant.lp2.rkt"
|
||||
"../type-expander/multi-id.lp2.rkt"
|
||||
"../type-expander/type-expander.lp2.rkt"
|
||||
"cond-abort.rkt")
|
||||
"../type-expander/type-expander.lp2.rkt")
|
||||
|
||||
<test-make-replace>
|
||||
<test-example>
|
||||
|
|
|
|||
|
|
@ -38,7 +38,8 @@
|
|||
|
||||
(require (for-syntax mzlib/etc))
|
||||
(define-syntax (doc-lib-setup stx)
|
||||
;(display (build-path (this-expression-source-directory) (this-expression-file-name)))
|
||||
;(display (build-path (this-expression-source-directory)
|
||||
; (this-expression-file-name)))
|
||||
#'setup-math) ;; NOTE: setup-math must be returned, not just called!
|
||||
|
||||
(provide doc-lib-setup)
|
||||
|
|
@ -56,10 +57,12 @@
|
|||
|
||||
|
||||
|
||||
;; Copied from /usr/local/racket-6.2.900.6/share/pkgs/scribble-lib/scribble/private/lp.rkt
|
||||
;; Copied from the file:
|
||||
;; /usr/local/racket-6.2.900.6/share/pkgs/scribble-lib/scribble/private/lp.rkt
|
||||
|
||||
(require (for-syntax racket/base syntax/boundmap)
|
||||
scribble/scheme scribble/decode scribble/manual (except-in scribble/struct table))
|
||||
scribble/scheme scribble/decode scribble/manual
|
||||
(except-in scribble/struct table))
|
||||
|
||||
(begin-for-syntax
|
||||
;; maps chunk identifiers to a counter, so we can distinguish multiple uses
|
||||
|
|
@ -68,7 +71,10 @@
|
|||
(define (get-chunk-number id)
|
||||
(free-identifier-mapping-get chunk-numbers id (lambda () #f)))
|
||||
(define (inc-chunk-number id)
|
||||
(free-identifier-mapping-put! chunk-numbers id (+ 1 (free-identifier-mapping-get chunk-numbers id))))
|
||||
(free-identifier-mapping-put! chunk-numbers id
|
||||
(+ 1
|
||||
(free-identifier-mapping-get chunk-numbers
|
||||
id))))
|
||||
(define (init-chunk-number id)
|
||||
(free-identifier-mapping-put! chunk-numbers id 2)))
|
||||
|
||||
|
|
@ -85,7 +91,9 @@
|
|||
(when n
|
||||
(inc-chunk-number (syntax-local-introduce #'name)))
|
||||
|
||||
(syntax-local-lift-expression #'(quote-syntax (a-chunk name expr (... ...))))
|
||||
(syntax-local-lift-expression #'(quote-syntax (a-chunk name
|
||||
expr
|
||||
(... ...))))
|
||||
|
||||
(with-syntax ([tag tag]
|
||||
[str str]
|
||||
|
|
@ -93,13 +101,15 @@
|
|||
(map (lambda (expr)
|
||||
(syntax-case expr (require)
|
||||
[(require mod (... ...))
|
||||
(let loop ([mods (syntax->list #'(mod (... ...)))])
|
||||
(let loop
|
||||
([mods (syntax->list #'(mod (... ...)))])
|
||||
(cond
|
||||
[(null? mods) null]
|
||||
[else
|
||||
(syntax-case (car mods) (for-syntax)
|
||||
[(for-syntax x (... ...))
|
||||
(append (loop (syntax->list #'(x (... ...))))
|
||||
(append (loop (syntax->list
|
||||
#'(x (... ...))))
|
||||
(loop (cdr mods)))]
|
||||
[x
|
||||
(cons #'x (loop (cdr mods)))])]))]
|
||||
|
|
|
|||
|
|
@ -35,10 +35,13 @@
|
|||
Symbol
|
||||
Char
|
||||
Void
|
||||
;Input-Port ;; Not quite mutable, but not really immutable either.
|
||||
;Output-Port ;; Not quite mutable, but not really immutable either.
|
||||
;Port ;; Not quite mutable, but not really immutable either.
|
||||
#| I haven't checked the mutability of the ones in the #||# comments below
|
||||
;Input-Port ;; Not quite mutable, nor immutable.
|
||||
;Output-Port ;; Not quite mutable, nor immutable.
|
||||
;Port ;; Not quite mutable, nor immutable.
|
||||
|
||||
;; I haven't checked the mutability of the ones
|
||||
;; inside in the #||# comments below
|
||||
#|
|
||||
Path
|
||||
Path-For-Some-System
|
||||
Regexp
|
||||
|
|
@ -55,7 +58,11 @@
|
|||
EOF
|
||||
Continuation-Mark-Set
|
||||
|#
|
||||
; Undefined ;; We definitely don't want that one, it's not mutable but it's an error if present anywhere 99.9% of the time.
|
||||
;; We definitely don't Undefined, it's not mutable
|
||||
;; but it's an error if present anywhere 99.9% of
|
||||
;; the time. Typed/racket is moving towards making
|
||||
;; occurrences of this type an error, anyway.
|
||||
; Undefined
|
||||
#|
|
||||
Module-Path
|
||||
Module-Path-Index
|
||||
|
|
@ -92,7 +99,9 @@
|
|||
(Pairof AnyImmutable AnyImmutable)
|
||||
(Listof AnyImmutable)
|
||||
; Plus many others, not added yet.
|
||||
; -> ; Not closures, because they can contain mutable variables, and we can't eq? them
|
||||
;; Don't include closures, because they can contain
|
||||
;; mutable variables, and we can't eq? them.
|
||||
; ->
|
||||
; maybe Prefab? Or are they mutable?
|
||||
))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
#lang typed/racket/no-check
|
||||
|
||||
;; When creating the html document with scribble/lp2, it does not see the macros defined in low.rkt when including it with sugar/include.
|
||||
;; Using a raw include/reader works.
|
||||
;; When creating the html document with scribble/lp2, it does not see the macros
|
||||
;; defined in low.rkt when including it with sugar/include.
|
||||
;; But using a raw include/reader works.
|
||||
|
||||
;(require sugar/include)
|
||||
;(include-without-lang-line "low.rkt")
|
||||
|
|
|
|||
|
|
@ -2,9 +2,12 @@
|
|||
|
||||
;; Using check-equal? on our variants result in the following error message:
|
||||
;; Attempted to use a higher-order value passed as `Any` in untyped code
|
||||
;; check-equal? and check-not-equal? are replaced by versions that work with “higher-order values” below.
|
||||
;; check-equal? and check-not-equal? are replaced by versions that work with
|
||||
;; “higher-order values” below.
|
||||
|
||||
(require (except-in (only-meta-in 0 typed/rackunit) ;; typed/racket risks complaining that it can't do for-meta in all-from-out otherwise.
|
||||
(require (except-in (only-meta-in 0 typed/rackunit)
|
||||
;; Above: typed/racket risks complaining that it can't do
|
||||
;; for-meta in all-from-out if we don't use `only-meta-in`.
|
||||
check-equal?
|
||||
check-not-equal?))
|
||||
|
||||
|
|
@ -26,15 +29,23 @@
|
|||
(check-true (not (equal? x y)) . message))
|
||||
|
||||
(define-simple-macro (check-eval-equal? to-eval y . message)
|
||||
(check-true (equal? (eval-get-values to-eval (variable-reference->namespace (#%variable-reference))) y) . message))
|
||||
(check-true (equal? (eval-get-values to-eval
|
||||
(variable-reference->namespace
|
||||
(#%variable-reference)))
|
||||
y)
|
||||
. message))
|
||||
|
||||
(define-simple-macro (check-eval-string-equal? to-eval y . message)
|
||||
(check-true (equal? (eval-get-values (read (open-input-string to-eval)) (variable-reference->namespace (#%variable-reference)))
|
||||
(check-true (equal? (eval-get-values (read (open-input-string to-eval))
|
||||
(variable-reference->namespace
|
||||
(#%variable-reference)))
|
||||
y)
|
||||
. message))
|
||||
|
||||
(define-simple-macro (check-eval-string-equal?/ns ns-anchor to-eval y . message)
|
||||
(check-true (equal? (eval-get-values (read (open-input-string to-eval)) (namespace-anchor->namespace ns-anchor))
|
||||
(check-true (equal? (eval-get-values (read (open-input-string to-eval))
|
||||
(namespace-anchor->namespace
|
||||
ns-anchor))
|
||||
y)
|
||||
. message))
|
||||
|
||||
|
|
|
|||
|
|
@ -11,36 +11,61 @@
|
|||
#:with for-kind (if (attribute star) #'for*/list #'for/list)))
|
||||
|
||||
(syntax-parse stx
|
||||
[(_ sequences:sequences ... body)
|
||||
[(_ [sequences:sequences ...] . body)
|
||||
(foldl (λ (for-kind clauses acc)
|
||||
#`(#,for-kind #,clauses #,acc))
|
||||
#'body
|
||||
#'(let () . body)
|
||||
(reverse (syntax-e #'(sequences.for-kind ...)))
|
||||
(reverse (syntax-e #'(([sequences.id sequences.seq-expr] ...) ...))))]))
|
||||
(reverse (syntax-e #'(([sequences.id sequences.seq-expr] ...)
|
||||
...))))]))
|
||||
|
||||
;; Test for*/list*
|
||||
(module* test racket
|
||||
(require rackunit)
|
||||
(require (submod ".."))
|
||||
(check-equal? (for*/list* ([x '(a b c)]
|
||||
[y '(1 2 3)])
|
||||
(* [z '(d e f)]
|
||||
[t '(4 5 6)])
|
||||
(list x y z t))
|
||||
'(((a 1 d 4) (a 1 d 5) (a 1 d 6) (a 1 e 4) (a 1 e 5) (a 1 e 6) (a 1 f 4) (a 1 f 5) (a 1 f 6))
|
||||
((b 2 d 4) (b 2 d 5) (b 2 d 6) (b 2 e 4) (b 2 e 5) (b 2 e 6) (b 2 f 4) (b 2 f 5) (b 2 f 6))
|
||||
((c 3 d 4) (c 3 d 5) (c 3 d 6) (c 3 e 4) (c 3 e 5) (c 3 e 6) (c 3 f 4) (c 3 f 5) (c 3 f 6))))
|
||||
(check-equal? (for*/list* ([x '(a b c)])
|
||||
([y '(1 2 3)])
|
||||
(* [z '(d e f)]
|
||||
[t '(4 5 6)])
|
||||
(list x y z t))
|
||||
'((((a 1 d 4) (a 1 d 5) (a 1 d 6) (a 1 e 4) (a 1 e 5) (a 1 e 6) (a 1 f 4) (a 1 f 5) (a 1 f 6))
|
||||
((a 2 d 4) (a 2 d 5) (a 2 d 6) (a 2 e 4) (a 2 e 5) (a 2 e 6) (a 2 f 4) (a 2 f 5) (a 2 f 6))
|
||||
((a 3 d 4) (a 3 d 5) (a 3 d 6) (a 3 e 4) (a 3 e 5) (a 3 e 6) (a 3 f 4) (a 3 f 5) (a 3 f 6)))
|
||||
(((b 1 d 4) (b 1 d 5) (b 1 d 6) (b 1 e 4) (b 1 e 5) (b 1 e 6) (b 1 f 4) (b 1 f 5) (b 1 f 6))
|
||||
((b 2 d 4) (b 2 d 5) (b 2 d 6) (b 2 e 4) (b 2 e 5) (b 2 e 6) (b 2 f 4) (b 2 f 5) (b 2 f 6))
|
||||
((b 3 d 4) (b 3 d 5) (b 3 d 6) (b 3 e 4) (b 3 e 5) (b 3 e 6) (b 3 f 4) (b 3 f 5) (b 3 f 6)))
|
||||
(((c 1 d 4) (c 1 d 5) (c 1 d 6) (c 1 e 4) (c 1 e 5) (c 1 e 6) (c 1 f 4) (c 1 f 5) (c 1 f 6))
|
||||
((c 2 d 4) (c 2 d 5) (c 2 d 6) (c 2 e 4) (c 2 e 5) (c 2 e 6) (c 2 f 4) (c 2 f 5) (c 2 f 6))
|
||||
((c 3 d 4) (c 3 d 5) (c 3 d 6) (c 3 e 4) (c 3 e 5) (c 3 e 6) (c 3 f 4) (c 3 f 5) (c 3 f 6))))))
|
||||
(check-equal? (for*/list* [([x '(a b c)]
|
||||
[y '(1 2 3)])
|
||||
(* [z '(d e f)]
|
||||
[t '(4 5 6)])]
|
||||
(list x y z t))
|
||||
'(((a 1 d 4) (a 1 d 5) (a 1 d 6)
|
||||
(a 1 e 4) (a 1 e 5) (a 1 e 6)
|
||||
(a 1 f 4) (a 1 f 5) (a 1 f 6))
|
||||
((b 2 d 4) (b 2 d 5) (b 2 d 6)
|
||||
(b 2 e 4) (b 2 e 5) (b 2 e 6)
|
||||
(b 2 f 4) (b 2 f 5) (b 2 f 6))
|
||||
((c 3 d 4) (c 3 d 5) (c 3 d 6)
|
||||
(c 3 e 4) (c 3 e 5) (c 3 e 6)
|
||||
(c 3 f 4) (c 3 f 5) (c 3 f 6))))
|
||||
(check-equal? (for*/list* [([x '(a b c)])
|
||||
([y '(1 2 3)])
|
||||
(* [z '(d e f)]
|
||||
[t '(4 5 6)])]
|
||||
(list x y z t))
|
||||
'((((a 1 d 4) (a 1 d 5) (a 1 d 6)
|
||||
(a 1 e 4) (a 1 e 5) (a 1 e 6)
|
||||
(a 1 f 4) (a 1 f 5) (a 1 f 6))
|
||||
((a 2 d 4) (a 2 d 5) (a 2 d 6)
|
||||
(a 2 e 4) (a 2 e 5) (a 2 e 6)
|
||||
(a 2 f 4) (a 2 f 5) (a 2 f 6))
|
||||
((a 3 d 4) (a 3 d 5) (a 3 d 6)
|
||||
(a 3 e 4) (a 3 e 5) (a 3 e 6)
|
||||
(a 3 f 4) (a 3 f 5) (a 3 f 6)))
|
||||
(((b 1 d 4) (b 1 d 5) (b 1 d 6)
|
||||
(b 1 e 4) (b 1 e 5) (b 1 e 6)
|
||||
(b 1 f 4) (b 1 f 5) (b 1 f 6))
|
||||
((b 2 d 4) (b 2 d 5) (b 2 d 6)
|
||||
(b 2 e 4) (b 2 e 5) (b 2 e 6)
|
||||
(b 2 f 4) (b 2 f 5) (b 2 f 6))
|
||||
((b 3 d 4) (b 3 d 5) (b 3 d 6) (b 3 e 4)
|
||||
(b 3 e 5) (b 3 e 6) (b 3 f 4)
|
||||
(b 3 f 5) (b 3 f 6)))
|
||||
(((c 1 d 4) (c 1 d 5) (c 1 d 6) (c 1 e 4)
|
||||
(c 1 e 5) (c 1 e 6) (c 1 f 4)
|
||||
(c 1 f 5) (c 1 f 6))
|
||||
((c 2 d 4) (c 2 d 5) (c 2 d 6) (c 2 e 4)
|
||||
(c 2 e 5) (c 2 e 6) (c 2 f 4)
|
||||
(c 2 f 5) (c 2 f 6))
|
||||
((c 3 d 4) (c 3 d 5) (c 3 d 6) (c 3 e 4)
|
||||
(c 3 e 5) (c 3 e 6) (c 3 f 4)
|
||||
(c 3 f 5) (c 3 f 6))))))
|
||||
|
|
@ -54,7 +54,8 @@
|
|||
(define-type to (List (Pairof String Boolean) (Listof String)))
|
||||
|
||||
(: convert (case→ (→ from to)
|
||||
(→ (Pairof (Listof Number) Null) (Pairof (Listof String) Null))
|
||||
(→ (Pairof (Listof Number) Null)
|
||||
(Pairof (Listof String) Null))
|
||||
(→ (Pairof Number Boolean) (Pairof String Boolean))
|
||||
(→ (Listof Number) (Listof String))
|
||||
(→ Number String)
|
||||
|
|
|
|||
|
|
@ -21,7 +21,8 @@
|
|||
rkt->zo-file
|
||||
make-collection
|
||||
run
|
||||
run!)
|
||||
run!
|
||||
find-executable-path-or-fail)
|
||||
|
||||
(require/typed make [make/proc (→ (Listof
|
||||
(Pairof (U Path-String (Listof Path-String))
|
||||
|
|
@ -30,11 +31,17 @@
|
|||
(List (-> Any))))))
|
||||
(U String (Vectorof String) (Listof String))
|
||||
Void)])
|
||||
;(require/typed make/collection [make-collection (→ Any (Listof Path-String) (U String (Vectorof String)) Void)])
|
||||
;(require/typed make/collection [make-collection (→ Any (Listof Path-String)
|
||||
; (U String (Vectorof String))
|
||||
; Void)])
|
||||
|
||||
(require/typed srfi/13
|
||||
[string-suffix? (->* (String String) (Integer Integer Integer Integer) Boolean)]
|
||||
[string-prefix? (->* (String String) (Integer Integer Integer Integer) Boolean)])
|
||||
[string-suffix? (->* (String String)
|
||||
(Integer Integer Integer Integer)
|
||||
Boolean)]
|
||||
[string-prefix? (->* (String String)
|
||||
(Integer Integer Integer Integer)
|
||||
Boolean)])
|
||||
|
||||
(define (find-files-by-extension [ext : String])
|
||||
(find-files (λ ([path : Path]) (string-suffix? ext (path->string path)))))
|
||||
|
|
@ -50,13 +57,26 @@
|
|||
(: rules (→ (U t-rule (Listof t-rule)) * (Listof t-rule)))
|
||||
(define (rules . rs)
|
||||
(apply append (map (λ ([x : (U t-rule (Listof t-rule))])
|
||||
(cond [(null? x) '()] ;; x = '() is an empty (Listof t-rule)
|
||||
[(null? (cdr x)) x] ;; x = '([target dep maybe-proc]) is a (Listof t-rule) with just one element
|
||||
[(null? (cadr x)) (list x)] ;; x = '[target () maybe-proc] is a t-rule with an empty list of dependencies
|
||||
;; Below, either x = '[target (dep₁ . ?) maybe-proc] or x = '([target dep maybe-proc] [target dep maybe-proc])
|
||||
[(null? (cdadr x)) (list x)] ;; x = '[target (dep₁ . ()) maybe-proc]
|
||||
[(list? (cadadr x)) x] ;; x = '([target dep maybe-proc] [target (?) maybe-proc])
|
||||
[else (list x)])) ; x = '[target (dep₁ dep₂ . ()) maybe-proc]
|
||||
(cond
|
||||
;; x = '() is an empty (Listof t-rule)
|
||||
[(null? x) '()]
|
||||
;; x = '([target dep maybe-proc]) is a (Listof t-rule)
|
||||
;; with just one element
|
||||
[(null? (cdr x)) x]
|
||||
;; x = '[target () maybe-proc] is a t-rule
|
||||
;; with an empty list of dependencies
|
||||
[(null? (cadr x)) (list x)]
|
||||
;; Below, either x = '[target (dep₁ . ?) maybe-proc]
|
||||
;; or x = '([target dep maybe-proc]
|
||||
;; [target dep maybe-proc])
|
||||
[else (cond
|
||||
;; x = '[target (dep₁ . ()) maybe-proc]
|
||||
[(null? (cdadr x)) (list x)]
|
||||
;; x = '([target dep maybe-proc]
|
||||
;; [target (?) maybe-proc])
|
||||
[(list? (cadadr x)) x]
|
||||
; x = '[target (dep₁ dep₂ . ()) maybe-proc]
|
||||
[else (list x)])]))
|
||||
rs)))
|
||||
|
||||
#|
|
||||
|
|
@ -77,7 +97,8 @@
|
|||
(list depend ...)
|
||||
(λ () body ...))))
|
||||
|
||||
(define-syntax-rule (for/rules ([arg files] ...) (target ...) (depend ...) body ...)
|
||||
(define-syntax-rule (for/rules ([arg files] ...) (target ...) (depend ...)
|
||||
body ...)
|
||||
(map (implicit-rule (arg ...) (target ...) (depend ...) body ...) files ...))
|
||||
|
||||
(: path-string->string (→ Path-String String))
|
||||
|
|
@ -98,11 +119,13 @@
|
|||
(path-string->string b))))
|
||||
|
||||
(define-syntax-rule (regexp-case input [pattern replacement] ...)
|
||||
(let ([input-cache input]) ;; TODO: should also cache the patterns, but lazily.
|
||||
(let ([input-cache input]) ;; TODO: should also cache the patterns, but lazily
|
||||
(cond
|
||||
[(regexp-match pattern input-cache) (regexp-replace pattern input-cache replacement)]
|
||||
[(regexp-match pattern input-cache)
|
||||
(regexp-replace pattern input-cache replacement)]
|
||||
...
|
||||
[else input-cache])))
|
||||
[else
|
||||
input-cache])))
|
||||
|
||||
(: dirname (→ Path Path))
|
||||
(define (dirname p)
|
||||
|
|
@ -132,15 +155,26 @@
|
|||
#("zo")
|
||||
argv)))
|
||||
|
||||
;; make-collection from /usr/local/racket-6.2.900.6/share/pkgs/make/collection-unit.rkt
|
||||
(require/typed compiler/compiler [compile-zos (->* (Any) (#:module? Any #:verbose? Any) (→ (Listof Path-String) (U Path-String #f 'auto) Void))])
|
||||
(require/typed dynext/file [append-zo-suffix (→ Path-String Path)])
|
||||
;; make-collection copied from the file
|
||||
;; /usr/local/racket-6.2.900.6/share/pkgs/make/collection-unit.rkt
|
||||
(require/typed compiler/compiler
|
||||
[compile-zos (->* (Any)
|
||||
(#:module? Any #:verbose? Any)
|
||||
(→ (Listof Path-String)
|
||||
(U Path-String #f 'auto)
|
||||
Void))])
|
||||
(require/typed dynext/file
|
||||
[append-zo-suffix (→ Path-String Path)])
|
||||
|
||||
(: cache (∀ (T) (→ (→ T) (→ T))))
|
||||
(define (cache producer)
|
||||
(let ([cache : (U False (List T)) #f]) ;; Use (List T) instead of T, so that if the producer returns #f, we don't call it each time.
|
||||
;; Use (List T) instead of T, so that if the producer returns #f,
|
||||
;; we don't call it each time.
|
||||
(let ([cache : (U False (List T)) #f])
|
||||
(λ ()
|
||||
(let ([c cache]) ;; since cache is mutated by set!, occurrence typing won't work on it, so we need to take a copy.
|
||||
;; since cache is mutated by set!, occurrence typing won't work on it,
|
||||
;; so we need to take a copy:
|
||||
(let ([c cache])
|
||||
(if c
|
||||
(car c)
|
||||
(let ((producer-result (producer)))
|
||||
|
|
@ -153,9 +187,11 @@
|
|||
|
||||
(: rkt->zo-file (→ Path-String Path))
|
||||
(define (rkt->zo-file src-file)
|
||||
(build-path (rkt->zo-dir src-file) (append-zo-suffix (assert (file-name-from-path src-file)))))
|
||||
(build-path (rkt->zo-dir src-file)
|
||||
(append-zo-suffix (assert (file-name-from-path src-file)))))
|
||||
|
||||
(: make-collection (→ Any (Listof Path-String) (U String (Vectorof String)) Void))
|
||||
(: make-collection (→ Any (Listof Path-String) (U String (Vectorof String))
|
||||
Void))
|
||||
(define (make-collection collection-name collection-files argv)
|
||||
(printf "building collection ~a: ~a\n" collection-name collection-files)
|
||||
(let* ([zo-compiler (cache (λ () (compile-zos #f)))]
|
||||
|
|
@ -171,17 +207,23 @@
|
|||
`(,zo (,rkt)
|
||||
,(lambda ()
|
||||
(let ([dest (rkt->zo-dir rkt)])
|
||||
(unless (directory-exists? dest) (make-directory dest))
|
||||
(unless (directory-exists? dest)
|
||||
(make-directory dest))
|
||||
((zo-compiler) (list rkt) dest)))))
|
||||
rkts zos)])
|
||||
(make/proc (append `(("zo" ,zos)) rkt->zo-list) argv)))
|
||||
|
||||
(: run (→ (U Path-String (Pairof Path-String (Listof (U Path-String Bytes)))) [#:set-pwd? Any] (U Path-String Bytes) * Boolean))
|
||||
(: run (→ (U Path-String (Pairof Path-String (Listof (U Path-String Bytes))))
|
||||
[#:set-pwd? Any]
|
||||
(U Path-String Bytes) *
|
||||
Boolean))
|
||||
(define (run arg0 #:set-pwd? [set-pwd? #f] . args)
|
||||
(if (list? arg0)
|
||||
(apply run arg0)
|
||||
(begin
|
||||
(displayln (string-append (string-join (cons (path-string->string arg0) (map (λ (x) (format "~a" x)) args)) " ")))
|
||||
(displayln (string-join (cons (path-string->string arg0)
|
||||
(map (λ (x) (format "~a" x)) args))
|
||||
" "))
|
||||
(display "\033[1;34m")
|
||||
(flush-output)
|
||||
(let ((result (apply system* arg0 args)))
|
||||
|
|
@ -191,4 +233,24 @@
|
|||
(raise "Command failed."))
|
||||
result))))
|
||||
|
||||
(define-syntax-rule (run! . rest) (let () (run . rest) (values)))
|
||||
(define-syntax-rule (run! . rest) (let () (run . rest) (values)))
|
||||
|
||||
(: find-executable-path-or-fail (->* (Path-String)
|
||||
((U Path-String False) Any)
|
||||
Path))
|
||||
(define find-executable-path-or-fail
|
||||
(let ((fn (λ ([executable-name : Path-String]
|
||||
[a : (U Path-String False 'none)]
|
||||
[b : (U (List Any) 'none)])
|
||||
: Path
|
||||
(or (if (eq? a 'none)
|
||||
(find-executable-path executable-name)
|
||||
(if (eq? b 'none)
|
||||
(find-executable-path executable-name a)
|
||||
(find-executable-path executable-name a (car b))))
|
||||
(error (format "Can't find executable '~a'"
|
||||
executable-name))))))
|
||||
(case-lambda
|
||||
[(x) (fn x 'none 'none)]
|
||||
[(x a) (fn x a 'none)]
|
||||
[(x a b) (fn x a (list b))])))
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
#lang typed/racket
|
||||
#lang at-exp typed/racket
|
||||
|
||||
(require "lib.rkt")
|
||||
|
||||
|
|
@ -9,11 +9,60 @@
|
|||
;raco pkg install alexis-util
|
||||
;And some other collections too.
|
||||
;
|
||||
;cat graph/structure.lp2.rkt | awk '{if (length > 80) print NR "\t" length "\t" $0}' | sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'
|
||||
;cat graph/structure.lp2.rkt \
|
||||
;| awk '{if (length > 80) print NR "\t" length "\t" $0}' \
|
||||
;| sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'
|
||||
;
|
||||
;for i in `find \( -path ./lib/doc/bracket -prune -and -false \) \
|
||||
; -or \( -name compiled -prune -and -false \) \
|
||||
; -or -name '*.rkt'`;
|
||||
; do
|
||||
; x=`cat "$i" \
|
||||
; | awk '{if (length > 80) print NR "\t" length "\t" $0}' \
|
||||
; | sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'`
|
||||
; [ -n "$x" ] && echo -e "\033[1;31m$i:\033[m" && echo $x
|
||||
; done
|
||||
|
||||
#|
|
||||
"for i in `find \( -path ./lib/doc/bracket -prune -and -false \) \
|
||||
-or \( -name compiled -prune -and -false \) \
|
||||
-or -name '*.rkt'`;
|
||||
do
|
||||
x=`cat "$i" \
|
||||
| awk '{if (length > 80) print NR "\t" length "\t" $0}' \
|
||||
| sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'`
|
||||
[ -n "$x" ] && echo -e "\033[1;31m$i:\033[m" && echo $x
|
||||
done"
|
||||
|#
|
||||
|
||||
(run! (list (find-executable-path-or-fail "sh")
|
||||
"-c"
|
||||
@string-append{
|
||||
fond_long_lines=0
|
||||
for i in `find \
|
||||
\( -path ./lib/doc/bracket -prune -and -false \) \
|
||||
-or \( -name compiled -prune -and -false \) \
|
||||
-or -name '*.rkt'`
|
||||
do
|
||||
x=`cat "$i" \
|
||||
| awk '{if (length > 80) print NR "\t" length "\t" $0}' \
|
||||
| sed -e 's/^\([0-9]*\t[0-9]*\t.\{80\}\)\(.*\)$/\1\x1b[0;30;41m\2\x1b[m/'`
|
||||
if test -n "$x"; then
|
||||
fond_long_lines=1
|
||||
printf '\033[1;31m%s:\033[m\n' "$i" && printf "%s\n" "$x"
|
||||
fi
|
||||
done
|
||||
exit $fond_long_lines
|
||||
}))
|
||||
|
||||
;; TODO: should directly exclude them in find-files-by-extension.
|
||||
(define excluded-dirs (list "docs/" "bug/" "lib/doc/bracket/" "lib/doc/math-scribble/" "lib/doc/MathJax/"))
|
||||
(define (exclude-dirs [files : (Listof Path)] [excluded-dirs : (Listof String) excluded-dirs])
|
||||
(define excluded-dirs (list "docs/"
|
||||
"bug/"
|
||||
"lib/doc/bracket/"
|
||||
"lib/doc/math-scribble/"
|
||||
"lib/doc/MathJax/"))
|
||||
(define (exclude-dirs [files : (Listof Path)]
|
||||
[excluded-dirs : (Listof String) excluded-dirs])
|
||||
(filter-not (λ ([p : Path])
|
||||
(ormap (λ ([excluded-dir : String])
|
||||
(string-prefix? excluded-dir (path->string p)))
|
||||
|
|
@ -24,11 +73,25 @@
|
|||
(define lp2-files (exclude-dirs (find-files-by-extension ".lp2.rkt")))
|
||||
(define rkt-files (exclude-dirs (find-files-by-extension ".rkt")))
|
||||
(define doc-sources (append scrbl-files lp2-files))
|
||||
(define html-files (map (λ ([scrbl-or-lp2 : Path]) (build-path "docs/" (regexp-case (path->string scrbl-or-lp2) [#rx"\\.scrbl" ".html"] [#rx"\\.lp2\\.rkt" ".lp2.html"])))
|
||||
(define html-files (map (λ ([scrbl-or-lp2 : Path])
|
||||
(build-path "docs/"
|
||||
(regexp-case (path->string scrbl-or-lp2)
|
||||
[#rx"\\.scrbl"
|
||||
".html"]
|
||||
[#rx"\\.lp2\\.rkt"
|
||||
".lp2.html"])))
|
||||
doc-sources))
|
||||
(define pdf-files (map (λ ([scrbl-or-lp2 : Path]) (build-path "docs/" (regexp-case (path->string scrbl-or-lp2) [#rx"\\.scrbl" ".pdf"] [#rx"\\.lp2\\.rkt" ".lp2.pdf"])))
|
||||
(define pdf-files (map (λ ([scrbl-or-lp2 : Path])
|
||||
(build-path "docs/"
|
||||
(regexp-case (path->string scrbl-or-lp2)
|
||||
[#rx"\\.scrbl"
|
||||
".pdf"]
|
||||
[#rx"\\.lp2\\.rkt"
|
||||
".lp2.pdf"])))
|
||||
doc-sources))
|
||||
(define mathjax-links (map (λ ([d : Path]) (build-path d "MathJax")) (remove-duplicates (map dirname html-files))))
|
||||
(define mathjax-links (map (λ ([d : Path])
|
||||
(build-path d "MathJax"))
|
||||
(remove-duplicates (map dirname html-files))))
|
||||
|
||||
(define-type ScribbleRenderers
|
||||
; TODO: add --html-tree <n> and '(other . "…") to be future-proof.
|
||||
|
|
@ -36,14 +99,15 @@
|
|||
"--text" "--markdown"))
|
||||
(: scribble (→ Path (Listof Path) ScribbleRenderers Any))
|
||||
(define (scribble file all-files renderer)
|
||||
(run `(,(or (find-executable-path "scribble") (error "Can't find executable 'scribble'"))
|
||||
(run `(,(find-executable-path-or-fail "scribble")
|
||||
,renderer
|
||||
"--dest" ,(build-path "docs/" (dirname file))
|
||||
"+m"
|
||||
"--redirect-main" "http://docs.racket-lang.org/"
|
||||
"--info-out" ,(build-path "docs/" (path-append file ".sxref"))
|
||||
,@(append-map (λ ([f : Path-String]) : (Listof Path-String)
|
||||
(let ([sxref (build-path "docs/" (path-append f ".sxref"))])
|
||||
(let ([sxref (build-path "docs/"
|
||||
(path-append f ".sxref"))])
|
||||
(if (file-exists? sxref)
|
||||
(list "++info-in" sxref)
|
||||
(list))))
|
||||
|
|
@ -52,19 +116,29 @@
|
|||
|
||||
;(make-collection "phc" rkt-files (argv))
|
||||
;(make-collection "phc" '("graph/all-fields.rkt") #("zo"))
|
||||
;(require/typed compiler/cm [managed-compile-zo (->* (Path-String) ((→ Any Input-Port Syntax) #:security-guard Security-Guard) Void)])
|
||||
;(require/typed compiler/cm [managed-compile-zo
|
||||
; (->* (Path-String)
|
||||
; ((→ Any Input-Port Syntax)
|
||||
; #:security-guard Security-Guard)
|
||||
; Void)])
|
||||
;(managed-compile-zo (build-path (current-directory) "graph/all-fields.rkt"))
|
||||
|
||||
;; make-collection doesn't handle dependencies due to (require), so if a.rkt requires b.rkt, and b.rkt is changed, a.rkt won't be rebuilt.
|
||||
;; this re-compiles each-time, even when nothing was changed.
|
||||
;; make-collection doesn't handle dependencies due to (require), so if a.rkt
|
||||
;; requires b.rkt, and b.rkt is changed, a.rkt won't be rebuilt.
|
||||
;; Yhis re-compiles each-time, even when nothing was changed.
|
||||
;((compile-zos #f) rkt-files 'auto)
|
||||
|
||||
;; This does not work, because it tries to create the directory /usr/local/racket-6.2.900.6/collects/syntax/parse/private/compiled/drracket/
|
||||
;(require/typed compiler/cm [managed-compile-zo (->* (Path-String) ((→ Any Input-Port Syntax) #:security-guard Security-Guard) Void)])
|
||||
;; This does not work, because it tries to create the following directory:
|
||||
;; /usr/local/racket-6.2.900.6/collects/syntax/parse/private/compiled/drracket/
|
||||
;(require/typed compiler/cm [managed-compile-zo
|
||||
; (->* (Path-String)
|
||||
; ((→ Any Input-Port Syntax)
|
||||
; #:security-guard Security-Guard)
|
||||
; Void)])
|
||||
;(for ([rkt rkt-files])
|
||||
; (managed-compile-zo (build-path (current-directory) rkt)))
|
||||
|
||||
(run! `(,(or (find-executable-path "raco") (error "Can't find executable 'raco'"))
|
||||
(run! `(,(find-executable-path-or-fail "raco")
|
||||
"make"
|
||||
,@rkt-files))
|
||||
|
||||
|
|
@ -85,10 +159,21 @@
|
|||
(for/rules ([mathjax-link mathjax-links])
|
||||
(mathjax-link)
|
||||
()
|
||||
(make-file-or-directory-link (simplify-path (apply build-path `(same ,@(map (λ (x) 'up) (explode-path (dirname mathjax-link))) "lib" "doc" "MathJax")) #f)
|
||||
mathjax-link)))
|
||||
(let ([mathjax-dir
|
||||
(simplify-path
|
||||
(apply build-path
|
||||
`(same
|
||||
,@(map (λ (x) 'up)
|
||||
(explode-path (dirname mathjax-link)))
|
||||
"lib" "doc" "MathJax"))
|
||||
#f)])
|
||||
(make-file-or-directory-link mathjax-dir mathjax-link))))
|
||||
(argv))
|
||||
|
||||
(run! `(,(or (find-executable-path "raco") (error "Can't find executable 'raco'"))
|
||||
(run! `(,(find-executable-path-or-fail "raco")
|
||||
"cover"
|
||||
,@(exclude-dirs rkt-files (list "make/"))))
|
||||
|
||||
(run! `(,(find-executable-path-or-fail "raco")
|
||||
"test"
|
||||
,@(exclude-dirs rkt-files (list "make/"))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user