racket/racket/collects/xml/path.rkt
Matthew Flatt 67a9889ef7 add "share", move "collects" back out of "lib", move "pkgs"
The "share" directory holds platform-independent files, while
"lib" holds platform-specific files.

In principle, the "collects" directory belongs in "share",
as does "doc". Those directories are put into "share"
by a Unix-style install, but left at top level for an
in-place install.

Packages in installation scope are put in "share" instead
of "lib", and the top-level Makefile puts development links
in "share/devel-pkgs".

The `configure' script now supports `--docdir' and `--collectsdir'.

Changed the version to 5.90.0.1.
2013-07-19 11:52:02 -06:00

82 lines
2.0 KiB
Racket

#lang racket/base
(require racket/contract
racket/match
racket/dict
racket/function
racket/list
xml)
(define keyword->symbol (compose string->symbol keyword->string))
(define (se-path/xexpr p x)
(match p
[(list)
(list x)]
[(list-rest (? symbol? s) r)
(match x
[(list-rest (? (curry equal? s)) rs)
(se-path/tag-body r rs)]
[_
empty])]
[_
empty]))
(define (se-path/tag-body p x)
(match p
[(list)
(match x
[(list) empty]
[(list-rest (list (list (? symbol?) (? string?)) ...) rs)
(se-path/tag-body p rs)]
[(? list?)
x]
[_
empty])]
[(list-rest (? symbol?) _)
(match x
[(list-rest (list (list (? symbol?) (? string?)) ...) rs)
(append-map (curry se-path/xexpr p) rs)]
[(? list?)
(append-map (curry se-path/xexpr p) x)]
[_
empty])]
[(list (? keyword? k))
(match x
[(list-rest (and attrs (list (list (? symbol?) (? string?)) ...)) rs)
(se-path/attr (keyword->symbol k) attrs)]
[_
empty])]
[_
empty]))
(define (se-path/attr k attrs)
(dict-ref attrs k empty))
(define (se-path*/list p x)
(append (se-path/xexpr p x)
(match x
[(list (? symbol? tag) (list (list (? symbol?) (? string?)) ...) rs ...)
(append-map (curry se-path*/list p) rs)]
[(list (? symbol? tag) rs ...)
(append-map (curry se-path*/list p) rs)]
[_
empty])))
(define (se-path* p x)
(match (se-path*/list p x)
[(list) #f]
[(list-rest f rs) f]))
(define se-path?
(match-lambda
[(list) #t]
[(list (? keyword?)) #t]
[(list-rest (? symbol?) l) (se-path? l)]
[_ #f]))
(provide/contract
[se-path? contract?]
[se-path*
(-> se-path? xexpr?
; XXX maybe this shouldn't be any/c
any/c)]
[se-path*/list
(-> se-path? xexpr?
; XXX see above
(listof any/c))])