mprodrigues/emacs.d
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update packages

Browse Source
This commit is contained in:
Mateus Pinto Rodrigues
2018-10-04 13:56:56 -03:00
parent 5d03e5e124
commit d272c43bcd
785 changed files with 367265 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

276
elpa/racket-mode-20181004.309/racket/commands/requires.rkt Normal file
View File

@@ -0,0 +1,276 @@
#lang at-exp racket/base
(require (only-in macro-debugger/analysis/check-requires show-requires)
racket/format
racket/function
racket/list
racket/match
racket/set)
(provide requires/tidy
requires/trim
requires/base)
(module+ test
(require rackunit))
;; requires/tidy : (listof require-sexpr) -> require-sexpr
(define (requires/tidy reqs)
(let* ([reqs (combine-requires reqs)]
[reqs (group-requires reqs)])
(require-pretty-format reqs)))
;; requires/trim : path-string? (listof require-sexpr) -> require-sexpr
;;
;; Note: Why pass in a list of the existing require forms -- why not
;; just use the "keep" list from show-requires? Because the keep list
;; only states the module name, not the original form. Therefore if
;; the original require has a subform like `(only-in mod f)` (or
;; rename-in, except-in, &c), we won't know how to preserve that
;; unless we're given it. That's why our strategy must be to look for
;; things to drop, as opposed to things to keep.
(define (requires/trim path-str reqs)
(let* ([reqs (combine-requires reqs)]
[sr (show-requires* path-str)]
[drops (filter-map (λ (x)
(match x
[(list 'drop mod lvl) (list mod lvl)]
[_ #f]))
sr)]
[reqs (filter-map (λ (req)
(cond [(member req drops) #f]
[else req]))
reqs)]
[reqs (group-requires reqs)])
(require-pretty-format reqs)))
;; Use `bypass` to help convert from `#lang racket` to `#lang
;; racket/base` plus explicit requires.
;;
;; Note: Currently this is hardcoded to `#lang racket`, only.
(define (requires/base path-str reqs)
(let* ([reqs (combine-requires reqs)]
[sr (show-requires* path-str)]
[drops (filter-map (λ (x)
(match x
[(list 'drop mod lvl) (list mod lvl)]
[_ #f]))
sr)]
[adds (append*
(filter-map (λ (x)
(match x
[(list 'bypass 'racket 0
(list (list mod lvl _) ...))
(filter (λ (x)
(match x
[(list 'racket/base 0) #f]
[_ #t]))
(map list mod lvl))]
[_ #f]))
sr))]
[reqs (filter-map (λ (req)
(cond [(member req drops) #f]
[else req]))
reqs)]
[reqs (append reqs adds)]
[reqs (group-requires reqs)])
(require-pretty-format reqs)))
;; show-requires* : Like show-requires but accepts a path-string? that
;; need not already be a module path.
(define (show-requires* path-str)
(define-values (base name _) (split-path (string->path path-str)))
(parameterize ([current-load-relative-directory base]
[current-directory base])
(show-requires name)))
(define (combine-requires reqs)
(remove-duplicates
(append* (for/list ([req reqs])
(match req
[(list* 'require vs)
(append*
(for/list ([v vs])
;; Use (list mod level), like `show-requires` uses.
(match v
[(list* 'for-meta level vs) (map (curryr list level) vs)]
[(list* 'for-syntax vs) (map (curryr list 1) vs)]
[(list* 'for-template vs) (map (curryr list -1) vs)]
[(list* 'for-label vs) (map (curryr list #f) vs)]
[v (list (list v 0))])))])))))
(module+ test
(check-equal?
(combine-requires '((require a b c)
(require d e)
(require a f)
(require (for-syntax s t u) (for-label l0 l1 l2))
(require (for-meta 1 m1a m1b)
(for-meta 2 m2a m2b))))
'((a 0) (b 0) (c 0) (d 0) (e 0) (f 0)
(s 1) (t 1) (u 1)
(l0 #f) (l1 #f) (l2 #f)
(m1a 1) (m1b 1) (m2a 2) (m2b 2))))
;; Given a list of requires -- each in the (list module level) form
;; used by `show-requires` -- group them by level and convert them to
;; a Racket `require` form. Also, sort the subforms by phase level:
;; for-syntax, for-template, for-label, for-meta, and plain (0).
;; Within each such group, sort them first by module paths then
;; relative requires. Within each such group, sort alphabetically.
(define (group-requires reqs)
;; Put the requires into a hash of sets.
(define ht (make-hasheq)) ;(hash/c <level> (set <mod>))
(for ([req reqs]) (match req
[(list mod lvl) (hash-update! ht lvl
(lambda (s) (set-add s mod))
(set mod))]))
(define (mod-set->mod-list mod-set)
(sort (set->list mod-set) mod<?))
(define (for-level level k)
(define mods (hash-ref ht level #f))
(cond [mods (k (mod-set->mod-list mods))]
[else '()]))
(define (preface . pres)
(λ (mods) `((,@pres ,@mods))))
(define (meta-levels)
(sort (for/list ([x (hash-keys ht)] #:when (not (member x '(-1 0 1 #f)))) x)
<))
`(require
,@(for-level 1 (preface 'for-syntax))
,@(for-level -1 (preface 'for-template))
,@(for-level #f (preface 'for-label))
,@(append* (for/list ([level (in-list (meta-levels))])
(for-level level (preface 'for-meta level))))
,@(for-level 0 values)))
(module+ test
(check-equal? (group-requires
(combine-requires
'((require z c b a)
(require (for-meta 4 m41 m40))
(require (for-meta -4 m-41 m-40))
(require (for-label l1 l0))
(require (for-template t1 t0))
(require (for-syntax s1 s0))
(require "a.rkt" "b.rkt" "c.rkt" "z.rkt"
(only-in "mod.rkt" oi)
(only-in mod oi)))))
'(require
(for-syntax s0 s1)
(for-template t0 t1)
(for-label l0 l1)
(for-meta -4 m-40 m-41)
(for-meta 4 m40 m41)
a b c (only-in mod oi) z
"a.rkt" "b.rkt" "c.rkt" (only-in "mod.rkt" oi) "z.rkt")))
(define (mod<? a b)
(define (key x)
(match x
[(list 'only-in m _ ...) (key m)]
[(list 'except-in m _ ...) (key m)]
[(list 'prefix-in _ m) (key m)]
[(list 'relative-in _ m _ ...) (key m)]
[m m]))
(let ([a (key a)]
[b (key b)])
(or (and (symbol? a) (not (symbol? b)))
(and (list? a) (not (list? b)))
(and (not (string? a)) (string? a))
(and (string? a) (string? b)
(string<? a b))
(and (symbol? a) (symbol? b)
(string<? (symbol->string a) (symbol->string b))))))
(module+ test
(check-true (mod<? 'a 'b))
(check-false (mod<? 'b 'a))
(check-true (mod<? 'a '(only-in b)))
(check-true (mod<? '(only-in a) 'b))
(check-true (mod<? 'a '(except-in b)))
(check-true (mod<? '(except-in a) 'b))
(check-true (mod<? 'a '(prefix-in p 'b)))
(check-true (mod<? '(prefix-in p 'a) 'b))
(check-true (mod<? 'a '(relative-in p 'b)))
(check-true (mod<? '(relative-in p 'a) 'b))
(check-true (mod<? 'a '(prefix-in p (only-in b))))
(check-true (mod<? '(prefix-in p (only-in a)) 'b)))
;; require-pretty-format : list? -> string?
(define (require-pretty-format x)
(define out (open-output-string))
(parameterize ([current-output-port out])
(require-pretty-print x))
(get-output-string out))
(module+ test
(check-equal? (require-pretty-format
'(require a))
@~a{(require a)
})
(check-equal? (require-pretty-format
'(require a b))
@~a{(require a
b)
})
(check-equal? (require-pretty-format
'(require (for-syntax a b) (for-meta 2 c d) e f))
@~a{(require (for-syntax a
b)
(for-meta 2 c
d)
e
f)
})
(check-equal? (require-pretty-format
`(require (only-in m a b) (except-in m a b)))
@~a{(require (only-in m
a
b)
(except-in m
a
b))
}))
;; Pretty print a require form with one module per line and with
;; indentation for the `for-X` subforms. Example:
;;
;; (require (for-syntax racket/base
;; syntax/parse)
;; (for-meta 3 racket/a
;; racket/b)
;; racket/format
;; racket/string
;; "a.rkt"
;; "b.rkt")
(define (require-pretty-print x)
(define (prn x first? indent)
(define (indent-string)
(if first? "" (make-string indent #\space)))
(define (prn-form pre this more)
(define new-indent (+ indent (+ 2 (string-length pre))))
(printf "~a(~a " (indent-string) pre)
(prn this #t new-indent)
(for ([x more])
(newline)
(prn x #f new-indent))
(display ")"))
(match x
[(list 'require)
(void)]
[(list* (and pre (or 'require 'for-syntax 'for-template 'for-label
'only-in 'except-in))
this more)
(prn-form (format "~s" pre) this more)
(when (eq? pre 'require)
(newline))]
[(list* 'for-meta level this more)
(prn-form (format "for-meta ~a" level) this more)]
[this
(printf "~a~s" (indent-string) this)]))
(prn x #t 0))