├── example ├── error.rkt ├── require-error.rkt ├── define-bar.rkt ├── define-foo.rkt ├── ado-require.rkt ├── prefix-all-from-source.rkt ├── require-re-provide.rkt ├── typed.rkt ├── meta-lang.rkt ├── multi │ ├── 1.rkt │ └── 2.rkt ├── typed-error.rkt ├── ado-define.rkt ├── re-provide.rkt ├── phase │ ├── define.rkt │ ├── require.rkt │ └── single.rkt ├── space │ ├── define.rkt │ └── require.rkt ├── macro.rkt ├── modules.rkt ├── prefix-require.rkt ├── prefix-define.rkt ├── require.rkt └── define.rkt ├── .gitignore ├── info.rkt ├── gzip.rkt ├── main.rkt ├── Makefile ├── .github └── workflows │ └── test.yml ├── cache.rkt ├── common.rkt ├── import-symbols.rkt ├── cli.rkt ├── extra-arrows.rkt ├── syncheck-api.rkt ├── data-types.rkt ├── design.org ├── span-map.rkt ├── relations.rkt ├── README.md ├── analyze-more.rkt ├── query.rkt ├── store.rkt └── LICENSE /example/error.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require unknown) 3 | 4 | -------------------------------------------------------------------------------- /example/require-error.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "error.rkt") 3 | -------------------------------------------------------------------------------- /example/define-bar.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide bar) 3 | (define bar 43) 4 | -------------------------------------------------------------------------------- /example/define-foo.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide foo) 3 | (define foo 42) 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | compiled/ 2 | doc/ 3 | data/ 4 | *.sqlite* 5 | *.rktd.gz 6 | *.rktd 7 | -------------------------------------------------------------------------------- /example/ado-require.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "ado-define.rkt") 3 | a 4 | -------------------------------------------------------------------------------- /example/prefix-all-from-source.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (define re 42) 3 | (provide re) 4 | -------------------------------------------------------------------------------- /example/require-re-provide.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require "re-provide.rkt") 3 | foo 4 | bar 5 | -------------------------------------------------------------------------------- /example/typed.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (define (f [x : Number]) 4 | (+ x 1)) 5 | -------------------------------------------------------------------------------- /example/meta-lang.rkt: -------------------------------------------------------------------------------- 1 | #lang at-exp racket/base 2 | (require racket/format) 3 | (println @~a{bar}) 4 | "foo" 5 | -------------------------------------------------------------------------------- /example/multi/1.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (define m1 42) 3 | (provide m1 4 | (prefix-out multi-1: m1)) 5 | -------------------------------------------------------------------------------- /example/multi/2.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (define m2 42) 3 | (provide m2 4 | (prefix-out multi-2: m2)) 5 | -------------------------------------------------------------------------------- /example/typed-error.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (define (f x) 4 | (+ x 1)) 5 | 6 | (define (g x) 7 | (+ x 1)) 8 | -------------------------------------------------------------------------------- /example/ado-define.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (define-values (a b) (values 42 42)) 3 | (provide (except-out (all-defined-out) b)) 4 | -------------------------------------------------------------------------------- /example/re-provide.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require "define-foo.rkt") 3 | (provide (all-from-out "define-foo.rkt")) 4 | (require "define-bar.rkt") 5 | (provide bar) 6 | -------------------------------------------------------------------------------- /example/phase/define.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base)) 4 | 5 | (define x 0) 6 | (provide x) 7 | 8 | (begin-for-syntax 9 | (define x 1) 10 | (provide x 11 | (rename-out [x x-renamed-out]))) 12 | -------------------------------------------------------------------------------- /example/phase/require.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base) 4 | "define.rkt") 5 | 6 | (printf "0 = ~a\n" x) 7 | 8 | (begin-for-syntax 9 | (printf "1 = ~a\n" x) 10 | (printf "1 = ~a\n" x-renamed-out)) 11 | -------------------------------------------------------------------------------- /example/phase/single.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require (for-syntax racket/base)) 3 | 4 | (module m racket/base 5 | (require (for-syntax racket/base)) 6 | 7 | (define x 0) 8 | (provide x) 9 | 10 | (begin-for-syntax 11 | (define x 1) 12 | (provide x))) 13 | 14 | (require 'm) 15 | (printf "0 = ~a\n" x) 16 | 17 | (begin-for-syntax 18 | (printf "1 = ~a\n" x)) 19 | -------------------------------------------------------------------------------- /example/space/define.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base)) 4 | (provide (for-space soup kettle) 5 | kettle) 6 | 7 | (define-syntax (define-soup stx) 8 | (syntax-case stx () 9 | [(_ id rhs) 10 | #`(define #,((make-interned-syntax-introducer 'soup) 11 | #'id) 12 | rhs)])) 13 | 14 | (define-soup kettle 'soup) 15 | (define kettle 'default) 16 | 17 | -------------------------------------------------------------------------------- /example/macro.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require syntax/parse) 3 | (define (go/one parse stx expr clauses) 4 | (define-syntax-class cl 5 | #:description "a clause with a pattern and a result" 6 | (pattern [p . rhs] 7 | #:with res (syntax/loc this-syntax [(p) . rhs]))) 8 | (syntax-parse clauses 9 | #:context stx 10 | [(c:cl ...) 11 | (go parse stx (quasisyntax/loc expr (#,expr)) 12 | #'(c.res ...))])) 13 | (define (go . _) 14 | (void)) 15 | -------------------------------------------------------------------------------- /example/modules.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require net/url) 3 | get-pure-port 4 | 5 | (module+ m+ 6 | (require racket/path) 7 | simple-form-path 8 | get-pure-port) 9 | 10 | (module m racket/base 11 | (module n racket/base 12 | (module o racket/base))) 13 | 14 | (module+ m+ 15 | (require racket/file) 16 | file->bytes) 17 | 18 | (module+ m+ 19 | (module+ n+ 20 | file->bytes)) 21 | 22 | (define foo 42) 23 | (module+ a 24 | (define bar 43) 25 | (module b racket/base 26 | (define baz 44) 27 | baz) 28 | bar) 29 | -------------------------------------------------------------------------------- /example/space/require.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (module m1 racket/base 4 | (require "define.rkt") 5 | kettle) 6 | 7 | (module m2 racket/base 8 | (require (only-space-in soup "define.rkt")) 9 | (require (for-syntax racket/base)) 10 | (define-syntax (in-space stx) 11 | (syntax-case stx () 12 | [(_ space id) #`(quote-syntax 13 | #,((make-interned-syntax-introducer (syntax-e #'space)) 14 | (syntax-local-introduce (datum->syntax #f (syntax-e #'id)))))])) 15 | (in-space soup kettle)) 16 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection "pdb") 4 | (define version "0.1") 5 | (define deps '(["base" #:version "8.9.0.1"] 6 | ["drracket-tool-text-lib" #:version "1.3"] 7 | "sql" 8 | "db-lib" 9 | "data-lib" 10 | "rackunit-lib")) 11 | (define build-deps '("rackunit-lib" 12 | "at-exp-lib")) 13 | (define compile-omit-paths '("example/")) 14 | (define test-omit-paths '("example/")) 15 | (define clean '("compiled")) 16 | (define raco-commands '(("pdb" pdb/cli "program database" #f))) 17 | -------------------------------------------------------------------------------- /example/prefix-require.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "prefix-define.rkt" 3 | (prefix-in IN: "prefix-define.rkt")) 4 | A:a 5 | ALL:a 6 | ALL:b 7 | IN:A:a 8 | IN:ALL:a 9 | IN:ALL:b 10 | NESTED:PREFIXES:FUN:c 11 | (require (prefix-in OUTER: (prefix-in INNER: "prefix-define.rkt"))) 12 | OUTER:INNER:d 13 | OUTER:INNER:NESTED:PREFIXES:FUN:c 14 | (let ([OUTER:INNER:d 42]) ;red herring 15 | OUTER:INNER:d) 16 | pre:re 17 | zoom-apples-field 18 | (require racket/require 19 | (multi-in "multi" ("1.rkt" "2.rkt"))) 20 | m1 21 | multi-1:m1 22 | m2 23 | multi-2:m2 24 | outer:inner:x 25 | -------------------------------------------------------------------------------- /example/prefix-define.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (define a 42) 3 | (define b 42) 4 | (provide (prefix-out A: a) 5 | (prefix-out ALL: (all-defined-out))) 6 | (define c 42) 7 | (provide (prefix-out NESTED: (prefix-out PREFIXES: (prefix-out FUN: c)))) 8 | (define d 42) 9 | (provide d) 10 | 11 | (require "prefix-all-from-source.rkt") 12 | (provide (prefix-out pre: (all-from-out "prefix-all-from-source.rkt"))) 13 | 14 | (struct apples (field)) 15 | (provide (prefix-out zoom- (struct-out apples))) 16 | 17 | (module m racket/base 18 | (module m racket/base 19 | (define x 42) 20 | (provide (prefix-out inner: x))) 21 | (require 'm) 22 | (provide (prefix-out outer: inner:x))) 23 | (require 'm) 24 | outer:inner:x 25 | (provide outer:inner:x) 26 | -------------------------------------------------------------------------------- /gzip.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require file/gzip 7 | file/gunzip 8 | racket/function) 9 | 10 | (provide gzip-bytes 11 | gunzip-bytes) 12 | 13 | (define ((codec-bytes codec) bstr) 14 | (define in (open-input-bytes bstr)) 15 | (define out (open-output-bytes)) 16 | (codec in out) 17 | (get-output-bytes out)) 18 | 19 | (define gzip-bytes (codec-bytes (curryr gzip-through-ports #f 0))) 20 | (define gunzip-bytes (codec-bytes gunzip-through-ports)) 21 | 22 | (module+ test 23 | (require rackunit) 24 | (define bstr #"asdf;lkjadsfplkjasdfadsfadsf") 25 | (check-equal? (gunzip-bytes (gzip-bytes bstr)) 26 | bstr)) 27 | -------------------------------------------------------------------------------- /example/require.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "define.rkt") 3 | plain 4 | renamed 5 | contracted1 6 | contracted2 7 | contracted/renamed 8 | plain-by-macro 9 | contracted-by-macro 10 | sub 11 | sub/renamed 12 | foo 13 | a-number 14 | a-parameter 15 | from-m 16 | d/c 17 | renamed-d/c 18 | (module m racket/base 19 | (require (prefix-in PRE: "define.rkt")) 20 | PRE:plain 21 | PRE:renamed 22 | PRE:contracted/renamed 23 | ;; red herring for renames: 24 | (require (only-in "define.rkt" 25 | [renamed plain] 26 | [contracted/renamed c/r])) 27 | plain 28 | c/r 29 | (require (rename-in "define.rkt" [plain XXX])) 30 | XXX) 31 | a-struct 32 | a-struct? 33 | a-struct-a 34 | a-struct-b 35 | (module m2 racket/base 36 | (require (rename-in "define.rkt" [renamed XXX])) 37 | XXX 38 | (provide (rename-out [XXX renamed]))) 39 | (module m3 racket/base 40 | (require (submod "define.rkt" sub)) 41 | sub) 42 | -------------------------------------------------------------------------------- /main.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require "analyze.rkt" 7 | "query.rkt" 8 | "relations.rkt" 9 | "syncheck-api.rkt" 10 | (only-in (submod "store.rkt" stats) 11 | db-stats 12 | file-stats)) 13 | 14 | (provide analyze-path 15 | fresh-analysis? 16 | fresh-analysis-expanded-syntax 17 | forget-path 18 | add-directory 19 | forget-directory 20 | 21 | get-annotations 22 | get-submodule-names 23 | get-completion-candidates 24 | get-errors 25 | get-point-info 26 | get-doc-link 27 | get-require-path 28 | 29 | send-to-syncheck-annotations-object 30 | 31 | use->def 32 | nominal-use->def 33 | rename-sites 34 | 35 | db-stats 36 | file-stats) 37 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PACKAGE-NAME=pdb 2 | 3 | DEPS-FLAGS=--check-pkg-deps --unused-pkg-deps 4 | 5 | all: setup 6 | 7 | # Primarily for use by CI. 8 | # Installs dependencies as well as linking this as a package. 9 | install: 10 | raco pkg install --deps search-auto 11 | 12 | remove: 13 | raco pkg remove $(PACKAGE-NAME) 14 | 15 | # Primarily for day-to-day dev. 16 | # Note: Also builds docs (if any) and checks deps. 17 | setup: 18 | raco setup --tidy $(DEPS-FLAGS) --pkgs $(PACKAGE-NAME) 19 | 20 | # Note: Each collection's info.rkt can say what to clean, for example 21 | # (define clean '("compiled" "doc" "doc/")) to clean 22 | # generated docs, too. 23 | clean: 24 | raco setup --fast-clean --pkgs $(PACKAGE-NAME) 25 | 26 | # Primarily for use by CI, after make install -- since that already 27 | # does the equivalent of make setup, this tries to do as little as 28 | # possible except checking deps. 29 | check-deps: 30 | raco setup --no-docs $(DEPS-FLAGS) --pkgs $(PACKAGE-NAME) 31 | 32 | # Suitable for both day-to-day dev and CI 33 | test: 34 | raco test -x -p $(PACKAGE-NAME) 35 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | pull_request: 6 | 7 | jobs: 8 | ubuntu: 9 | runs-on: ubuntu-latest 10 | strategy: 11 | fail-fast: false 12 | matrix: 13 | racket_version: 14 | # Although today we need super-new versions of Racket and 15 | # drracket-tool-text-lib (unfortunately), someday this 16 | # matrix will grow to add a `stable` item, at least. 17 | - 'stable' 18 | - 'current' # our minimum supported version 19 | name: Ubuntu Racket ${{ matrix.racket_version }} 20 | steps: 21 | - name: Checkout 22 | uses: actions/checkout@master 23 | - name: Install Racket 24 | uses: Bogdanp/setup-racket@v1.11 25 | with: 26 | architecture: 'x64' 27 | distribution: 'full' 28 | version: ${{ matrix.racket_version }} 29 | - name: Install Package 30 | run: make install 31 | - name: Check Deps 32 | run: make check-deps 33 | - name: Run Tests 34 | run: make test 35 | 36 | windows: 37 | runs-on: windows-latest 38 | strategy: 39 | fail-fast: false 40 | matrix: 41 | racket_version: 42 | - 'stable' 43 | - 'current' # our minimum supported version 44 | name: Windows Racket ${{ matrix.racket_version }} 45 | steps: 46 | - name: Checkout 47 | uses: actions/checkout@master 48 | - name: Install Racket 49 | uses: Bogdanp/setup-racket@v1.11 50 | with: 51 | architecture: 'x64' 52 | distribution: 'full' 53 | version: ${{ matrix.racket_version }} 54 | - name: Install Package 55 | run: make install 56 | - name: Check Deps 57 | run: make check-deps 58 | - name: Run Tests 59 | run: make test 60 | -------------------------------------------------------------------------------- /example/define.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract) 4 | 5 | ;; Examples for main.rkt test. 6 | 7 | (define (plain x) x) 8 | (provide plain) 9 | (provide (rename-out [plain renamed])) 10 | 11 | (define (contracted1 x) x) 12 | (provide (contract-out [contracted1 (-> any/c any)])) 13 | (define (contracted2 x) x) 14 | (provide/contract [contracted2 (-> any/c any)]) 15 | 16 | (define (c/r x) x) 17 | (provide (contract-out [rename c/r contracted/renamed (-> any/c any)])) 18 | 19 | (define-syntax-rule (plain-definer name) 20 | (begin 21 | (define (name x) x) 22 | (provide name))) 23 | (plain-definer plain-by-macro) 24 | 25 | (define-syntax-rule (contracted-definer name) 26 | (begin 27 | (define (name x) x) 28 | (provide (contract-out [name (-> any/c any)])))) 29 | (contracted-definer contracted-by-macro) 30 | 31 | ;; This is here to try to trip naive matching, by having a definition 32 | ;; of `sub` that is not actually provided, unlike the one in the `sub` 33 | ;; module just below. 34 | (module red-herring racket/base 35 | (define (sub) #f)) 36 | 37 | (module sub racket/base 38 | (define (sub x) x) 39 | (provide sub 40 | (rename-out [sub sub/renamed]))) 41 | (require 'sub) 42 | (provide sub sub/renamed) 43 | 44 | ;; Likewise, another case of naive matching: 45 | (module red-herring-2 racket/base 46 | (define (foo) #f)) 47 | 48 | (define (foo x) x) 49 | (provide foo) 50 | 51 | ;; Issue 317 52 | (define a-number 42) 53 | (provide a-number) 54 | (define a-parameter (make-parameter #f)) 55 | (provide a-parameter) 56 | 57 | (module m racket/base 58 | (define from-m #f) 59 | (provide from-m)) 60 | (require 'm) 61 | (provide (contract-out [from-m any/c])) 62 | 63 | (define/contract (d/c x) (-> any/c any) x) 64 | (provide d/c) 65 | (provide (rename-out [d/c renamed-d/c])) 66 | 67 | (struct a-struct (a b)) 68 | (provide (struct-out a-struct)) 69 | a-struct-a 70 | a-struct-b 71 | -------------------------------------------------------------------------------- /cache.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/match 4 | syntax/parse/define 5 | (prefix-in store: "store.rkt")) 6 | 7 | (provide get-file 8 | forget 9 | put) 10 | 11 | ;; This acts as a write-through cache for store.rkt. We want things 12 | ;; like get-mouse-overs etc. to work fast for the small working set of 13 | ;; files the user is editing. (However things like def->uses/same-name 14 | ;; may use store.rkt directly to avoid disturbing the working set when 15 | ;; they access analysis data for potentially very many files.) 16 | 17 | (struct entry (last-access f+d)) 18 | (define cache (make-hash)) ;complete-path? => entry? 19 | (define current-cache-maximum-entries (make-parameter 32)) 20 | (define sema (make-semaphore 1)) 21 | (define-simple-macro (with-semaphore e:expr ...+) 22 | (call-with-semaphore sema (λ () e ...))) 23 | 24 | (define (now) (current-inexact-monotonic-milliseconds)) 25 | 26 | (define (get-file path [desired-digest #f]) 27 | (with-semaphore 28 | (match (hash-ref cache path #f) 29 | [(entry _time (and f+d (store:file+digest file digest))) 30 | #:when (or (not desired-digest) 31 | (equal? desired-digest digest)) 32 | ;; cache hit, but update the last-access time 33 | (hash-set! cache path (entry (now) f+d)) 34 | file] 35 | [_ ;cache miss 36 | (match (store:get-file+digest path desired-digest) 37 | [(and f+d (store:file+digest file _digest)) 38 | (hash-set! cache path (entry (now) f+d)) 39 | (maybe-remove-oldest!) ;in case cache grew 40 | file] 41 | [#f #f])]))) 42 | 43 | (define (forget path) 44 | (with-semaphore 45 | (hash-remove! cache path) 46 | (store:forget path))) 47 | 48 | (define (put path file digest #:exports exports #:re-exports re-exports #:imports imports) 49 | (with-semaphore 50 | (hash-set! cache path (entry (now) (store:file+digest file digest))) 51 | (maybe-remove-oldest!) 52 | (store:put path file digest #:exports exports #:re-exports re-exports #:imports imports))) 53 | 54 | (define (maybe-remove-oldest!) 55 | ;; assumes called in with-semaphore from get-file or put 56 | (when (>= (hash-count cache) (current-cache-maximum-entries)) 57 | (define-values (oldest-path _) 58 | (for/fold ([oldest-path #f] 59 | [oldest-time +inf.0]) 60 | ([(path entry) (in-hash cache)]) 61 | (if (< (entry-last-access entry) oldest-time) 62 | (values path (entry-last-access entry)) 63 | (values oldest-path oldest-time)))) 64 | (hash-remove! cache oldest-path))) 65 | -------------------------------------------------------------------------------- /common.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require racket/format 7 | racket/match 8 | syntax/parse/define 9 | (only-in syntax/modresolve resolve-module-path-index)) 10 | 11 | (provide (all-defined-out)) 12 | 13 | ;;; logger/timing 14 | 15 | (define-logger pdb) 16 | 17 | (define (time-apply/log what proc args) 18 | (cond [(log-level? (current-logger) 'debug 'pdb) 19 | (define old-mem (current-memory-use)) 20 | (define-values (vs cpu real gc) (time-apply proc args)) 21 | (define new-mem (current-memory-use)) 22 | (define delta (- new-mem old-mem)) 23 | (define (fmt n) (~v #:align 'right #:min-width 4 n)) 24 | (log-pdb-debug "~a cpu ~a real ~a gc ~aMiB :: ~a" 25 | (fmt cpu) (fmt real) (fmt gc) 26 | (~a #:align 'right #:min-width 4 27 | (~r #:precision 0 #:groups '(3) #:group-sep "," 28 | (/ new-mem 1024.0 1024.0))) 29 | what) 30 | (apply values vs)] 31 | [else (apply proc args)])) 32 | 33 | (define-simple-macro (with-time/log what e ...+) 34 | (time-apply/log what (λ () e ...) '())) 35 | 36 | (define (exn->string e) 37 | (define o (open-output-string)) 38 | (parameterize ([current-error-port o]) 39 | ((error-display-handler) (exn-message e) e)) 40 | (get-output-string o)) 41 | 42 | ;;; identifier-binding 43 | 44 | ;; This 9 field struct corresponds to the 7 item list returned by 45 | ;; identifier-binding. Each of the list's module-path-index items -- 46 | ;; "from-mod" and "nominal-from-mod" -- is resolved into a pair of 47 | ;; `-path` and `-subs` fields. 48 | (struct resolved-binding 49 | (from-path ;resolved from identifier-binding's "from-mod" 50 | from-subs ;/ 51 | from-sym 52 | from-phase 53 | nom-path ;resolved from identifier-binding's "nominal-from-modpath" 54 | nom-subs ;/ 55 | nom-sym 56 | nom-import-phase+space-shift 57 | nom-export-phase+space) 58 | #:prefab) 59 | 60 | ;; Note: `phase` cannot be a phase+space; identifier-binding doesn't 61 | ;; accept that. 62 | (define (identifier-binding/resolved src id-stx phase) 63 | (define (mpi->path+submods mpi) 64 | (match (resolve-module-path-index mpi src) 65 | [(? path? path) (values path null)] 66 | [(? symbol? sym) (values sym null)] 67 | [(list* 'submod (? path? path) subs) (values path subs)] 68 | [(list* 'submod (? symbol? sym) subs) (values sym subs)])) 69 | (match (identifier-binding id-stx phase) 70 | [(list from-mod from-sym nom-mod nom-sym from-phase nom-import-phase+space-shift nom-export-phase+space) 71 | (define-values (from-path from-subs) (mpi->path+submods from-mod)) 72 | (define-values (nom-path nom-subs) (mpi->path+submods nom-mod)) 73 | (resolved-binding from-path from-subs from-sym from-phase 74 | nom-path nom-subs nom-sym nom-import-phase+space-shift nom-export-phase+space)] 75 | [v v])) 76 | -------------------------------------------------------------------------------- /import-symbols.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require racket/format 7 | racket/match 8 | syntax/modcollapse 9 | syntax/modresolve 10 | "data-types.rkt" 11 | (prefix-in store: (only-in "store.rkt" 12 | put-resolved-module-path-exports 13 | get-resolved-module-path-exports))) 14 | 15 | (provide module-import-spec 16 | resolve-import-set) 17 | 18 | (define (module-import-spec path submodules lang-stx raw-module-path-stx 19 | #:prefix [prefix-stx #f] 20 | #:except [exceptions #f]) 21 | (define raw-module-path (syntax->datum raw-module-path-stx)) 22 | ;; Collapse the module path to disambiguate relative module paths 23 | ;; like (submod "." m). The "." or ".." is replaced by a unique, 24 | ;; complete path. 25 | (define rel-to (if (null? submodules) 26 | `(file ,(path->string path)) 27 | `(submod (file ,(path->string path)) ,@submodules))) 28 | (define collapsed-module-path (collapse-module-path raw-module-path rel-to)) 29 | (define resolved-module-path (resolve-module-path collapsed-module-path path)) 30 | ;; It would be wasteful to store a copy of the symbols in our 31 | ;; analysis data for importing file; there could even be copies for 32 | ;; multiple submodules within each file. Instead we store the 33 | ;; symbols once in the db keyed by the exporter's resolved module 34 | ;; path. (Why store in the db now; why not just call 35 | ;; module->exports, later? Now the module is already declared in the 36 | ;; current namespace as a result of expansion; declaring it later 37 | ;; could be very slow.) 38 | (define symbols (module-path->exported-symbols resolved-module-path)) 39 | (unless (set-empty? symbols) 40 | (store:put-resolved-module-path-exports resolved-module-path symbols)) 41 | (define lang? (equal? raw-module-path (and lang-stx (syntax->datum lang-stx)))) 42 | (define prefix (and prefix-stx (syntax->datum prefix-stx))) 43 | (list resolved-module-path lang? prefix exceptions)) 44 | 45 | (define (spec->symbols spec) 46 | (match-define (list resolved-module-path lang? prefix exceptions) spec) 47 | (define all-syms (store:get-resolved-module-path-exports resolved-module-path)) 48 | (define syms (set-subtract all-syms (or exceptions (seteq)))) 49 | (define (prefixed) 50 | (for/seteq ([sym (in-set syms)]) 51 | (string->symbol (~a prefix sym)))) 52 | ;; If imports are from the module language, then {rename prefix}-in 53 | ;; /add aliases/, as well as the original names. Otherwise the 54 | ;; modified names /replace/ the original names. 55 | (if prefix 56 | (if lang? 57 | (set-union syms (prefixed)) 58 | (prefixed)) 59 | syms)) 60 | 61 | (define (resolve-import-set symbols-or-specs [symbols (seteq)]) 62 | (for/fold ([s symbols]) 63 | ([v (in-set symbols-or-specs)]) 64 | (match v 65 | [(? symbol? sym) (set-add s sym)] 66 | [(? list? spec) (set-union s (spec->symbols spec))]))) 67 | 68 | (define (module-path->exported-symbols resolved-module-path) 69 | (define-values (vars stxs) 70 | ;; with-handlers: Just ignore module paths module->exports can't 71 | ;; handle, including symbols. 72 | (with-handlers ([exn:fail? (λ _ (values null null))]) 73 | (module->exports resolved-module-path))) 74 | (for*/seteq ([vars+stxs (in-list (list vars stxs))] 75 | [phase+spaces (in-list vars+stxs)] 76 | [export (in-list (cdr phase+spaces))]) 77 | (car export))) 78 | -------------------------------------------------------------------------------- /cli.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2024 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang at-exp racket/base 5 | 6 | (require racket/cmdline 7 | racket/format 8 | racket/logging 9 | racket/match 10 | racket/path 11 | racket/pretty 12 | (only-in raco/command-name 13 | short-program+command-name) 14 | "analyze.rkt" 15 | "common.rkt" 16 | (only-in "query.rkt" 17 | get-annotations 18 | max-position) 19 | (only-in (submod "store.rkt" stats) 20 | db-stats 21 | file-stats)) 22 | 23 | (define (err format-string . args) 24 | (apply eprintf format-string args) 25 | (newline (current-error-port)) 26 | (exit 1)) 27 | 28 | (define current-analyze-depth (make-parameter 0)) 29 | (define current-analyze-always? (make-parameter #f)) 30 | 31 | (define (analyze-file-or-dir path) 32 | (cond 33 | [(directory-exists? path) 34 | (void (add-directory path 35 | #:import-depth (current-analyze-depth) 36 | #:always? (current-analyze-always?)))] 37 | [(file-exists? path) 38 | (void 39 | (add-file path 40 | #:import-depth (current-analyze-depth) 41 | #:always? (current-analyze-always?)))] 42 | [else 43 | (err "~v is not an existing file or directory" path)])) 44 | 45 | (define (forget-file-or-dir path) 46 | (cond 47 | [(equal? path (path-only path)) ;directory? 48 | (forget-directory path)] 49 | [else 50 | (forget-path path)])) 51 | 52 | (define (parse vec) 53 | (define log-level 'info) 54 | (command-line 55 | #:program (short-program+command-name) 56 | #:argv (match vec [(vector) (vector "--help")] [v v]) 57 | #:once-any 58 | [("-v" "--verbose") "Verbose messages" 59 | (set! log-level 'info)] 60 | [("-V" "--very-verbose") "Very verbose messages" 61 | (set! log-level 'debug)] 62 | [("-s" "--silent") "Silent; minimal messages" 63 | (set! log-level 'warning)] 64 | #:ps 65 | "" 66 | "For help on a particular subcommand, use 'raco pdb --help'." 67 | " raco pdb analyze Analyze a file or directory" 68 | " raco pdb add Alias for 'analyze'" 69 | " raco pdb forget Forget analysis of a file or directory" 70 | " raco pdb query Query annotations for a file" 71 | " raco pdb stats Show stats for a file or the entire db" 72 | #:args (subcommand . option/arg) 73 | (with-logging-to-port 74 | #:logger pdb-logger 75 | (current-error-port) 76 | (λ () (parse-subcommand subcommand option/arg)) 77 | log-level 'pdb))) 78 | 79 | (define (parse-subcommand subcommand more) 80 | (match subcommand 81 | [(or "analyze" "add") 82 | (command-line 83 | #:program (~a (short-program+command-name) " add") 84 | #:argv more 85 | #:once-each 86 | [("-a" "--always") "Always analyze, even if already cached." 87 | (current-analyze-always? #t)] 88 | #:once-any 89 | [("-d" "--depth") depth 90 | ("Analyze imported files transitively to this depth." 91 | "Reasonable values are 0 (the default) or 1." 92 | "See also --max-depth.") 93 | (current-analyze-depth (string->number depth))] 94 | [("-D" "--max-depth") ("Maximally analyze imported files transitively." 95 | "Analyzes the full import chains up to opaque modules" 96 | "such as #%core or #%runtime.") 97 | (current-analyze-depth 99999)] 98 | #:args (file-or-dir) 99 | (analyze-file-or-dir (simple-form-path file-or-dir)))] 100 | ["forget" 101 | (command-line 102 | #:program (~a (short-program+command-name) " forget") 103 | #:argv more 104 | #:args (file-or-dir) 105 | (forget-file-or-dir (simple-form-path file-or-dir)))] 106 | ["query" 107 | (define *from 1) 108 | (define *upto max-position) 109 | (command-line 110 | #:program (~a (short-program+command-name) " query") 111 | #:argv more 112 | #:once-each 113 | [("--from") from 114 | "Include from this position, inclusive. Defaults to 1." 115 | (set! *from (string->number from))] 116 | [("--upto") upto 117 | "Include up to this position, exclusive. Defaults to very large integer." 118 | (set! *upto (string->number upto))] 119 | #:ps 120 | "" 121 | "Pretty print a list of check-syntax annotations." 122 | #:args (file) 123 | (pretty-print 124 | (get-annotations (simple-form-path file) *from *upto)))] 125 | ["stats" 126 | (define path #f) 127 | (command-line 128 | #:program (~a (short-program+command-name) " stats") 129 | #:argv more 130 | #:once-each 131 | [("-f" "--file") file 132 | ("Show stats for specific ." 133 | "When this option is omitted, show summary db stats.") 134 | (set! path file)] 135 | #:args () 136 | (displayln 137 | (if path 138 | (file-stats (simple-form-path path)) 139 | (db-stats))))] 140 | [v (err "Not a valid subcommand: ~v.\nTry 'raco pdb --help'." v)])) 141 | 142 | (parse (current-command-line-arguments)) 143 | -------------------------------------------------------------------------------- /extra-arrows.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/match 4 | "common.rkt" 5 | "data-types.rkt" 6 | "span-map.rkt") 7 | (provide file-add-arrows) 8 | 9 | ;; Given a set of syncheck-arrows, create our own set of arrows that 10 | ;; enable smart renaming, as used by relations.rkt. 11 | ;; 12 | ;; Note: Some of this could go away if check-syntax used the new 13 | ;; import-or-export-prefix-ranges syntax property to supply more 14 | ;; prefix arrows in the first place. I plan to see if I can make such 15 | ;; a change to traversals.rkt myself, or at least talk to Robby about 16 | ;; him doing it. 17 | ;; 18 | ;; Another part of it is that we add an "import-rename-arrow" where we 19 | ;; detect surface syntax like rename-in or only-in. In such cases the 20 | ;; new name site is of interest for rename commands. Although that 21 | ;; seems less obviously something to add to traversals.rkt, it might 22 | ;; be. 23 | 24 | (define (file-add-arrows f) 25 | (define am (file-arrows f)) 26 | 27 | ;; Add arrows based on those from drracket/check-syntax. 28 | (for ([sa (in-set (file-syncheck-arrows f))]) 29 | (match-define (syncheck-arrow def-beg def-end _def-px _def-py 30 | use-beg use-end _use-px _use-py 31 | _actual? phase require-arrow 32 | use-sym def-sym rb) 33 | sa) 34 | (cond 35 | [(not require-arrow) 36 | (arrow-map-set! am (lexical-arrow phase 37 | use-beg use-end 38 | def-beg def-end 39 | use-sym def-sym))] 40 | [;; When a simple (require (prefix-in)) expands to (#%require 41 | ;; [prefix]) then check-syntax handles this and gives us two 42 | ;; arrows. That's fine, we just prefer to classify the prefix 43 | ;; arrow as a lexical-arrow instead of an import-arrow. 44 | (span-map-ref (file-syncheck-prefixed-requires f) def-beg #f) 45 | (arrow-map-set! am (lexical-arrow phase 46 | use-beg use-end 47 | def-beg def-end 48 | use-sym def-sym))] 49 | [else ;other require-arrow 50 | ;; Our base case import-arrow corresponding to the syncheck 51 | ;; require arrow. We might simply insert this as-is. However if 52 | ;; this import is involved with a #%require rename clause, we 53 | ;; might adjust some elements of the import arrow before 54 | ;; inserting, as well as insert additional, lexical arrows. 55 | (define ia ((if (eq? require-arrow 'module-lang) 56 | lang-import-arrow 57 | import-arrow) 58 | phase 59 | use-beg 60 | use-end 61 | def-beg 62 | def-end 63 | use-sym 64 | (cons (resolved-binding-from-path rb) 65 | (ibk (resolved-binding-from-subs rb) 66 | (resolved-binding-from-phase rb) 67 | (resolved-binding-from-sym rb))) 68 | (cons (resolved-binding-nom-path rb) 69 | (ibk (resolved-binding-nom-subs rb) 70 | (resolved-binding-nom-export-phase+space rb) 71 | (resolved-binding-nom-sym rb))))) 72 | 73 | ;; Is there a #%require rename clause associated with this, 74 | ;; i.e. its modpath loc matches this def loc, and its new 75 | ;; symbol matches this use symbol? 76 | (match (hash-ref (file-pdb-import-renames f) 77 | (list def-beg def-end use-sym) 78 | #f) 79 | [(import-rename phase modpath-beg modpath-end 80 | maybe-prefix-ranges 81 | maybe-import-rename-arrow) 82 | (when maybe-import-rename-arrow 83 | (arrow-map-set! am maybe-import-rename-arrow)) 84 | (match maybe-prefix-ranges 85 | [(? list? subs) 86 | ;; Insert multiple arrows, one for each piece. 87 | (for ([sub (in-list subs)]) 88 | (match-define (sub-range offset span sub-sym sub-pos) sub) 89 | (cond 90 | [(equal? sub-sym (resolved-binding-nom-sym rb)) 91 | ;; Adjust arrow-use-beg of base import-arrow. 92 | (arrow-map-set! am 93 | (import-arrow (arrow-phase ia) 94 | (+ (arrow-use-beg ia) offset) 95 | (arrow-use-end ia) 96 | (arrow-def-beg ia) 97 | (arrow-def-end ia) 98 | (import-arrow-sym ia) 99 | (import-arrow-from ia) 100 | (import-arrow-nom ia)))] 101 | [else 102 | (arrow-map-set! am 103 | (lexical-arrow phase 104 | (+ (arrow-use-beg ia) offset) 105 | (+ (arrow-use-beg ia) offset span) 106 | sub-pos 107 | (+ sub-pos span) 108 | sub-sym 109 | sub-sym))]))] 110 | [#f 111 | (cond 112 | [maybe-import-rename-arrow 113 | (arrow-map-set! am 114 | (lexical-arrow phase 115 | (arrow-use-beg ia) 116 | (arrow-use-end ia) 117 | (arrow-use-beg maybe-import-rename-arrow) 118 | (arrow-use-end maybe-import-rename-arrow) 119 | (rename-arrow-new-sym maybe-import-rename-arrow) 120 | (rename-arrow-new-sym maybe-import-rename-arrow))) 121 | (arrow-map-set! am 122 | (import-arrow (arrow-phase ia) 123 | (arrow-def-beg maybe-import-rename-arrow) 124 | (arrow-def-end maybe-import-rename-arrow) 125 | (arrow-def-beg ia) 126 | (arrow-def-end ia) 127 | (import-arrow-sym ia) 128 | (import-arrow-from ia) 129 | (import-arrow-nom ia)))] 130 | [else (arrow-map-set! am ia)])])] 131 | [#f (arrow-map-set! am ia)])])) 132 | 133 | ;; Add arrows for certain #%provide rename clauses. 134 | (for ([a (in-set (file-pdb-export-renames f))]) 135 | (arrow-map-set! am a))) 136 | -------------------------------------------------------------------------------- /syncheck-api.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | ;;; Support for existing clients of drracket/check-syntax that don't 7 | ;;; care about paging and do want calls to syncheck methods. 8 | 9 | (require racket/contract 10 | racket/class 11 | racket/match 12 | drracket/check-syntax 13 | (only-in "analyze.rkt" get-file) 14 | "data-types.rkt") 15 | 16 | (provide send-to-syncheck-annotations-object) 17 | 18 | (define/contract (send-to-syncheck-annotations-object path o) 19 | (-> (and/c path? complete-path?) (is-a?/c syncheck-annotations<%>) any) 20 | (define (find-source-object path) 21 | (send o 22 | syncheck:find-source-object 23 | (datum->syntax #f 'n/a (srcloc path #f #f #f #f)))) 24 | (define path-so (find-source-object path)) 25 | (unless path-so 26 | (error 'send-to-syncheck-object 27 | "The find-source-object method of ~v returned false for ~v" 28 | o 29 | path)) 30 | (define f (get-file path)) 31 | ;; file-syncheck-arrows => syncheck:add-arrow/name-dup/pxpy 32 | (for ([v (in-set (file-syncheck-arrows f))]) 33 | (match-define (syncheck-arrow def-beg def-end def-px def-py 34 | use-beg use-end use-px use-py 35 | actual? phase require-arrow 36 | _use-sym _def-sym _rb) v) 37 | (define (name-dup? . _) #f) 38 | (send o syncheck:add-arrow/name-dup/pxpy 39 | path-so (sub1 def-beg) (sub1 def-end) def-px def-py 40 | path-so (sub1 use-beg) (sub1 use-end) use-px use-py 41 | actual? phase require-arrow name-dup?)) 42 | ;; file-syncheck-jumps => syncheck:add-jump-to-definition/phase-level+space 43 | (for ([v (in-list (span-map->list (file-syncheck-jumps f)))]) 44 | (match-define (cons (cons beg end) 45 | (syncheck-jump sym path mods phase)) v) 46 | (send o syncheck:add-jump-to-definition/phase-level+space 47 | path-so (sub1 beg) (sub1 end) sym path mods phase)) 48 | ;; file-syncheck-prefixed-requires => syncheck:add-prefixed-require-reference 49 | (for ([v (in-list (span-map->list (file-syncheck-prefixed-requires f)))]) 50 | (match-define (cons (cons prefix-beg prefix-end) 51 | (syncheck-prefixed-require-reference 52 | prefix req-beg req-end)) v) 53 | (send o syncheck:add-prefixed-require-reference 54 | path-so (sub1 req-beg) (sub1 req-end) 55 | prefix 56 | path-so (sub1 prefix-beg) (sub1 prefix-end))) 57 | ;; file-defs => syncheck:add-definition-target/phase-level+space 58 | (for ([(k v) (in-hash (file-syncheck-definition-targets f))]) 59 | (match-define (ibk mods phase sym) k) 60 | (match-define (cons beg end) v) 61 | (send o syncheck:add-definition-target/phase-level+space 62 | path-so (sub1 beg) (sub1 end) sym mods phase)) 63 | ;; file-mouse-overs => syncheck:add-mouse-over-status 64 | (for ([v (in-list (span-map->list (file-syncheck-mouse-overs f)))]) 65 | (match-define (cons (cons beg end) texts) v) 66 | (for ([text (in-list texts)]) 67 | (send o syncheck:add-mouse-over-status 68 | path-so (sub1 beg) (sub1 end) text))) 69 | ;; file-docs => syncheck:add-docs-menu 70 | (for ([v (in-list (span-map->list (file-syncheck-docs-menus f)))]) 71 | (match-define (cons (cons beg end) d) v) 72 | (send o syncheck:add-docs-menu 73 | path-so 74 | (sub1 beg) 75 | (sub1 end) 76 | (syncheck-docs-menu-sym d) 77 | (syncheck-docs-menu-label d) 78 | (syncheck-docs-menu-path d) 79 | (syncheck-docs-menu-anchor d) 80 | (syncheck-docs-menu-anchor-text d))) 81 | ;; file-require-opens => syncheck:add-require-open-menu 82 | (for ([v (in-list (span-map->list (file-syncheck-require-opens f)))]) 83 | (match-define (cons (cons beg end) path) v) 84 | (send o syncheck:add-require-open-menu 85 | path-so (sub1 beg) (sub1 end) path)) 86 | ;; file-text-types => syncheck:add-text-type 87 | (for ([v (in-list (span-map->list (file-syncheck-text-types f)))]) 88 | (match-define (cons (cons beg end) sym) v) 89 | (send o 90 | syncheck:add-text-type 91 | path-so (sub1 beg) (sub1 end) sym)) 92 | ;; file-tail-arrows => syncheck:add-tail-arrow 93 | (for ([v (in-set (file-syncheck-tail-arrows f))]) 94 | (match-define (cons tail head) v) 95 | (send o syncheck:add-tail-arrow 96 | path-so ;? 97 | (sub1 tail) 98 | path-so ;? 99 | (sub1 head)))) 100 | 101 | (module+ test 102 | (require data/order 103 | (only-in drracket/private/syncheck/traversals 104 | build-trace%) 105 | racket/runtime-path 106 | rackunit 107 | (only-in "analyze.rkt" 108 | analyze-path)) 109 | (define-runtime-path file.rkt "example/require.rkt") 110 | (analyze-path file.rkt #:always? #t) 111 | (define o (new build-trace% [src file.rkt])) 112 | (send-to-syncheck-annotations-object file.rkt o) 113 | (define (massage xs) 114 | (define ignored 115 | '(;; OK to ignore forever 116 | syncheck:add-id-set 117 | ;syncheck:add-background-color - seems unused? 118 | ;syncheck:color-range - seems unused? 119 | 120 | ;; Tip: You can un-comment one or more of these temporarily, 121 | ;; when debugging test failures and overhwelmed by huge 122 | ;; check-equal? output, to help somewhat. 123 | ;syncheck:add-arrow/name-dup/pxpy 124 | ;syncheck:add-definition-target/phase-level+space 125 | ;syncheck:add-docs-menu 126 | ;syncheck:add-jump-to-definition/phase-level+space 127 | ;syncheck:add-mouse-over-status 128 | ;syncheck:add-prefixed-require-reference 129 | ;syncheck:add-require-open-menu 130 | ;syncheck:add-tail-arrow 131 | ;syncheck:add-text-type 132 | )) 133 | (for/set ([x (in-list xs)] 134 | #:when (not (memq (vector-ref x 0) ignored))) 135 | (case (vector-ref x 0) 136 | [(syncheck:add-arrow/name-dup/pxpy) ;drop last (name-dup) 137 | (apply vector (reverse (cdr (reverse (vector->list x)))))] 138 | [else 139 | x]))) 140 | (define (->sorted-list a-set) 141 | (define list a-set) lt?)) 151 | (define actual (massage (send o get-trace))) 152 | (define expected (massage (show-content file.rkt))) 153 | (check-equal? (->sorted-list actual) 154 | (->sorted-list expected) 155 | "send-to-syncheck-object is equivalent to show-content, modulo order") 156 | (check-equal? (set-subtract actual expected) 157 | (set) 158 | "send-to-syncheck-object: none unexpected") 159 | (check-equal? (set-subtract expected actual) 160 | (set) 161 | "send-to-syncheck-object: none missing")) 162 | -------------------------------------------------------------------------------- /data-types.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require (for-syntax racket/base 7 | racket/syntax 8 | syntax/parse) 9 | data/interval-map 10 | racket/dict 11 | racket/set 12 | "span-map.rkt") 13 | 14 | (require racket/lazy-require) 15 | (lazy-require ["extra-arrows.rkt" (file-add-arrows)]) 16 | 17 | (provide (all-from-out data/interval-map 18 | racket/dict 19 | racket/set 20 | "span-map.rkt") 21 | position? 22 | (struct-out ibk) 23 | (struct-out arrow) 24 | (struct-out lexical-arrow) 25 | (struct-out rename-arrow) 26 | (struct-out export-rename-arrow) 27 | (struct-out import-rename-arrow) 28 | (struct-out import-arrow) 29 | (struct-out lang-import-arrow) 30 | 31 | (struct-out sub-range) 32 | (struct-out re-export) 33 | 34 | (struct-out import-rename) 35 | 36 | make-arrow-map 37 | (struct-out arrow-map) 38 | arrow-map-set! 39 | arrow-map-remove! 40 | arrow-map-arrows 41 | 42 | (struct-out syncheck-docs-menu) 43 | (struct-out syncheck-arrow) 44 | (struct-out syncheck-jump) 45 | (struct-out syncheck-prefixed-require-reference) 46 | (struct-out file) 47 | make-file 48 | file-before-serialize 49 | file-after-deserialize) 50 | 51 | ;; We use 1-based positions just like syntax-position (but unlike 52 | ;; drracket/check-syntax). 53 | (define position? exact-positive-integer?) 54 | 55 | ;; identifier-binding uniquely refers to a non-lexical binding via a 56 | ;; tuple of . Often we need all but the path 57 | ;; since we're working on things per-file. A struct for that: 58 | (struct ibk (mods phase sym) #:prefab) 59 | 60 | ;; An arrow always has both ends in the same file. (Arrows for 61 | ;; imported definitions point to e.g. the `require` or module language 62 | ;; syntax in the importing file. For such arrows, the derived struct 63 | ;; `import-arrow`, below, also says in what other file to look.) 64 | (struct arrow (phase use-beg use-end def-beg def-end) #:prefab) 65 | 66 | (struct lexical-arrow arrow (use-sym def-sym) #:prefab) 67 | 68 | (struct rename-arrow arrow (old-sym new-sym) #:prefab) 69 | (struct export-rename-arrow rename-arrow () #:prefab) 70 | (struct import-rename-arrow rename-arrow () #:prefab) 71 | 72 | ;; `from` and `nom` correspond to identifier-binding-resolved fields 73 | ;; Both are (cons path? ibk?), and are used to look up in hash-tables 74 | ;; stored in a `file` struct's fields `syncheck-definition-targets` or 75 | ;; `pdb-exports`, respectively. 76 | (struct import-arrow arrow (sym from nom) #:prefab) 77 | (struct lang-import-arrow import-arrow () #:prefab) 78 | 79 | ;; A non-empty list of sub-range structs is the value used in both the 80 | ;; file-pdb-definitions and file-pdb-exports hash-tables, as well 81 | ;; as the maybe-prefix-ranges field of the import-rename struct. 82 | (struct sub-range 83 | (offset ;natural 84 | span ;natural 85 | sub-sym ;symbol 86 | sub-pos ;(or/c position? re-export?) 87 | ) #:prefab) 88 | (struct re-export (path ibk) #:prefab) 89 | 90 | ;; Value for file-pdb-import-renames field 91 | (struct import-rename 92 | (phase 93 | modpath-beg ;natural 94 | modpath-end ;natural 95 | maybe-prefix-ranges ;(or/c #f (listof sub-range?)) 96 | maybe-import-rename-arrow ;(or/c #f import-rename-arrow?) 97 | ) #:prefab) 98 | 99 | ;; An arrow-map is a pair of span-maps, one for each "direction" of 100 | ;; def<->uses. (The same immutable arrow struct instance is stored in 101 | ;; both; IIUC this is just a pointer, not two copies.) 102 | (struct arrow-map 103 | (def->uses ;1:many (span-map def-beg def-end (set arrow)) 104 | use->def)) ;1:1 (span-map use-beg use-end arrow) 105 | 106 | (define (make-arrow-map [as null]) 107 | (define m (arrow-map (make-span-map) (make-span-map))) 108 | (for ([a (in-list as)]) 109 | (arrow-map-set! m a)) 110 | m) 111 | 112 | (define (arrow-map-arrows am) 113 | (span-map-values (arrow-map-use->def am))) 114 | 115 | (define (arrow-map-set! am a) 116 | (span-map-add! (arrow-map-def->uses am) 117 | (arrow-def-beg a) 118 | (arrow-def-end a) 119 | a) 120 | (span-map-set! (arrow-map-use->def am) 121 | (arrow-use-beg a) 122 | (arrow-use-end a) 123 | a)) 124 | 125 | (define (arrow-map-remove! am a) 126 | (span-map-remove! (arrow-map-def->uses am) 127 | (arrow-def-beg a) 128 | (arrow-def-end a) 129 | a) 130 | (span-map-remove! (arrow-map-use->def am) 131 | (arrow-use-beg a) 132 | (arrow-use-end a) 133 | a)) 134 | 135 | (struct syncheck-docs-menu (sym label path anchor anchor-text) #:prefab) 136 | (struct syncheck-arrow (def-beg def-end def-px def-py use-beg use-end use-px use-py actual? phase require-arrow use-sym def-sym rb) #:prefab) 137 | (struct syncheck-jump (sym path mods phase) #:prefab) 138 | (struct syncheck-prefixed-require-reference (prefix req-beg req-end) #:prefab) 139 | 140 | (define-syntax (defstruct stx) 141 | (define-syntax-class field 142 | (pattern [name init pre-serialize post-deserialize]) 143 | ;; Shorthand for fields whose types need no serialization adjustment. 144 | (pattern [name init] 145 | #:with pre-serialize #'values 146 | #:with post-deserialize #'values)) 147 | (syntax-parse stx 148 | [(_ name [field:field ...+]) 149 | #:with make (format-id #'name "make-~a" #'name #:source #'name) 150 | #:with before-serialize (format-id #'name "~a-before-serialize" #'name #:source #'name) 151 | #:with after-deserialize (format-id #'name "~a-after-deserialize" #'name #:source #'name) 152 | #:with (accessor ...) (for/list ([f (in-list (syntax->list #'(field.name ...)))]) 153 | (format-id f "~a-~a" (syntax->datum #'name) (syntax->datum f))) 154 | #'(begin 155 | (struct name (field.name ...) #:prefab) 156 | (define (make) 157 | (name field.init ...)) 158 | (define (before-serialize orig) 159 | (name (field.pre-serialize (accessor orig)) ...)) 160 | (define (after-deserialize orig) 161 | (define new (name (field.post-deserialize (accessor orig)) ...)) 162 | (file-add-arrows new) 163 | new))])) 164 | 165 | (defstruct file 166 | (;; The `arrows` field is created from a few of the other fields; 167 | ;; see current-file-add-arrows parameter. To save space, we 168 | ;; serialize it as #f. Upon deserialization we create an empty 169 | ;; arrow-map, then finally (after all other struct fields 170 | ;; deserialized) call file-add-arrows to populate it. 171 | [arrows (make-arrow-map) (λ _ #f) (λ _ (make-arrow-map))] 172 | 173 | ;; From check-syntax. Effectively "just record the method calls". 174 | [syncheck-arrows (mutable-set) set->list list->mutable-set] ;(set/c syncheck-arrow?) 175 | [syncheck-definition-targets (make-hash)] ;(hash/c ibk? (cons def-beg def-end)) 176 | [syncheck-tail-arrows (mutable-set) set->list list->mutable-set] ;(set/c (list/c (or/c #f path?) integer? (or/c #f path?) integer?) 177 | [syncheck-jumps (make-span-map)] 178 | [syncheck-prefixed-requires (make-span-map)] 179 | [syncheck-mouse-overs (make-span-map)] ;also items from our expansion 180 | [syncheck-docs-menus (make-span-map)] 181 | [syncheck-unused-requires (make-span-map)] 182 | [syncheck-require-opens (make-span-map)] 183 | [syncheck-text-types (make-span-map)] 184 | 185 | ;; From our expansion 186 | [pdb-errors (make-span-map)] 187 | 188 | ;; From our extra, `analyze-more` pass 189 | [pdb-modules (make-interval-map) dict->list make-interval-map] 190 | [pdb-definitions (make-hash)] ;(hash ibk? (listof sub-range?)) 191 | [pdb-exports (make-hash)] ;(hash ibk? (listof sub-range?)) 192 | [pdb-imports (make-hash)] ;(hash (seteq (or/c symbol? spec))) 193 | [pdb-import-renames (make-hash)] ;(hash (list mod-beg mod-end new-sym) import-rename) 194 | [pdb-export-renames (mutable-set) set->list list->mutable-set] ;(set export-rename-arrow)) 195 | )) 196 | 197 | (define (list->mutable-set xs) 198 | (apply mutable-set xs)) 199 | -------------------------------------------------------------------------------- /design.org: -------------------------------------------------------------------------------- 1 | * You want to know where, when? 2 | 3 | ~check-syntax~ analyzes one file at a time: 4 | 5 | - ~syncheck:add-arrow~ reports two begin ~[beg end)~ intervals within the 6 | /same/ file. 7 | 8 | - When a binding is lexical, the arrow is between the use and the 9 | definition in the same file. 10 | 11 | - When a binding is imported, the arrow is between the use and the 12 | ~require~ in the same file. Although the required file might 13 | contain the definition, it might just re-provide something 14 | imported from yet another file. This can continue indefinitely. 15 | 16 | Furthermore, the binding can be renamed at each import or 17 | export. 18 | 19 | You could imagine following these small, precise arrows step by 20 | step until reaching the ultimate defining file and name, as 21 | reported by ~identifier-binding~. 22 | 23 | - Another wrinkle is that there may be two arrows for different 24 | portions of one identifier, as a result of ~prefix-in~ or 25 | ~sub-range-binders~ syntax properties. 26 | 27 | - ~syncheck:add-jump-to-definition~ (using ~identifier-binding~) 28 | reports a "distant" and "vague" location of a definition: A module 29 | path (some /other/ file and submodules within it) and the original 30 | name of the definition. 31 | 32 | The location within that file isn't reported. To learn that, you 33 | need to e.g. run ~check-syntax~ on that file, and process 34 | ~syncheck:add-definition-target~. 35 | 36 | You could imagine this "arrow" is a big, direct jump with an 37 | imprecise landing. 38 | 39 | * Multi-file rename 40 | 41 | Note that it is challenging to implement a "multi-file rename" 42 | command, since the "same" binding can be exported/imported an 43 | arbitrary number of times, using various names for different 44 | "segments" of the "chain" of export/imports. Ideally such a command 45 | should only rename one same-named segment. Less ideally, it could be 46 | acceptable for it to rename all segments sharing the same name. Very 47 | less ideally, it could rename the entire chain, obliterating or making 48 | redundant any renaming exports or imports. 49 | 50 | ** Brain dump of some raw thoughts 51 | 52 | When a module imports a binding, it can rename it: The ~require~ 53 | form can introduce a new name, introduce an alias. Furthermore, the 54 | module that proximally exported that binding may have introduced a 55 | new name in its ~provide~ form. Furthermore, unless that exporting 56 | module contains the definition, it may have imported it (possibly 57 | renaming) from some other module that exports it (possibly 58 | renaming). And so on indefinitely. 59 | 60 | Normally things like free-identifier=? and identifier-binding 61 | traverse this entire chain of aliases, considering or returning 62 | just the two ends of the chain. And normally that's desirable. 63 | However, when the user wants to rename something, either manually 64 | or via some automatic command, it's necessary to consider the 65 | points in the chain where a new name is introduced. User renames 66 | must be limited to segments of an alias chain that share the same 67 | name. 68 | 69 | Assume a command given the location of a definition, and a new 70 | name; it should rename the definition as well as /relevant/ uses. 71 | The idea being the after the rename command finishes, there will 72 | not be any compilation error. That command needs to limit itself to 73 | replacing things that were /NOT/ renamed by a provide or require. 74 | Those provide/require renames "break the chain" -- nothing 75 | "downstream" of them should be renamed by the command. 76 | 77 | Such a command /could/ offer to work when given, not the location 78 | of a defintion, by instead the location of a renaming provide or 79 | require clause. The location could be treated much like a 80 | definition, as the start of a chain of uses. Note that 81 | drracket/check-syntax does draw arrows from identifiers to require 82 | and provide forms. However, it does /not/ draw an arrow from the 83 | "old" and "new" portions of a renaming sub-clause. We should 84 | consider adding that? 85 | 86 | Another wrinkle: #%require has ~prefix~ and ~prefix-all-except~ 87 | clauses. Ditto #%provide and its ~prefix-all-defined~ and 88 | ~prefix-all-defined-except~ clauses. syncheck:add-arrow gives us 89 | two arrows; for the prefix and the suffix. Each can be renamed or 90 | not, independently. 91 | 92 | Note that the "granularity" here is higher than 93 | syncheck:add-jump-to-defnition, which relies on identifier-binding. 94 | That gives you the "ends of the chain". What we need here needs to 95 | consider the full chain, or at least the ends of the chain after being 96 | "trimmed" to exclude provide/require renames. 97 | 98 | ISSUE: drracket/check-syntax syncheck:add-jump-to-definition tells us 99 | the defining modpath of a use. We add that to our db, /without/ 100 | needing to analyze that defining file immediately. If a command needs 101 | the location of the definition within the file, only then we do 102 | analyze it -- "lazily", on-demand. 103 | 104 | BUT in this case, we only know if the use of a name introduced 105 | locally, or, its /proximate/ importing file. 106 | 107 | 0. If use is of something defined locally, the definition site is 108 | also the name-introduction site. 109 | 110 | 1. If the use is of a name introduced by a renaming import, the 111 | rename-in id stx is the name-intro site. 112 | 113 | 2. Otherwise, we need to analyze the proximate importing file. With 114 | that file: 115 | 116 | - If the name is from a renaming export, the rename-out id stx is 117 | the name-intro site. 118 | 119 | - Otherwise go to step 0. Note this may recur indefinitely until 120 | we've found a name-intro site --- either some renaming 121 | import/export site or the ultimate definition site (which IIUC 122 | should always be the same as reported by identifier-binding). 123 | 124 | Note about mapping /from/ uses: 125 | 126 | Actual definitions: 1. When mapping uses to actual definitions, 127 | identifer-binding immediately tells us the ultimate defining 128 | modpath; all we lack is the location /within/ that file. So it's 129 | sufficient to record the modpath, and analyze the defining file 130 | later on-demand. 2. When doing the reverse -- given an actual 131 | definition, what are all its uses -- we already know the answer; no 132 | further analysis is necessary. [Sure, if we haven't analyzed 133 | file-using-foo.rkt, at all, then searching for uses of foo will 134 | miss that use. But we immediately know all uses of actual 135 | definitions, among any set of analyzed files.] 136 | 137 | But the situation with name introductions is trickier: 1. When we 138 | encounter a use, all we know is the /proximate/ file supplying the 139 | name. We might need to chase down N files before discovering the 140 | ultimate name introduction site. Either we do that chase eagerly, 141 | which is expensive, OR we have to record the proximate file as an 142 | incomplete/tentative answer, and do the chase later. 2. That 143 | tentative status makes the reverse -- given a name introduction, 144 | what are all its uses -- much worse. We can't find all the uses, 145 | not even among a set of files that we have analyzed, until we've 146 | fully resolved the uses from proximate to ultimate. 147 | 148 | Idea: 149 | 150 | 1. Continue to analyze files "lazily". 151 | 152 | 2. Have a "proximate?" flag to indicate a use isn't yet fully 153 | resolved to a name-introduction. This is set true intially (unless 154 | intro site is in the same file). 155 | 156 | 3. When analyzing each file, record its name-introduction sites. 157 | Then query for all uses showing that file as proximate. Update each 158 | to point instead to the newly-analyzed file. If that file has the 159 | intro site, change use status from proximate to ultimate. 160 | Otherwise, leave the new proximate file, for a subsequent file 161 | analysis to advance the resolution futher -- to yet another 162 | proximate file, and eventually resolved to the ultimate site. 163 | 164 | As mentioned above, even a plain old "find all uses of an actual 165 | definition" command is subject to not knowing about files that were 166 | not analyzed at all. A "find all uses of a name-introduction site" 167 | command has the further challenge that any use still in a proximate 168 | (not ultimate) state might belong to the set of correct answers, 169 | but we don't know that yet. To avoid that, a command could do a 170 | simple db query: Are there /any/ just-proximate uses at all? If so, 171 | the command can't run with guaranteed accuracy, yet. (Such a 172 | situation will probably correspond to a non-empty queue of files 173 | remaining to be analyzed -- but I'm not 100% sure about that, yet.) 174 | The command must do a full resolution across the entire db. 175 | 176 | TL;DR: Although uses of name-introduction sites seems to require an 177 | "eager", "depth-first" analysis of files, we can in fact handle it 178 | "lazily". Uses might remain in a proximate state, but each newly 179 | analyzed file may advance some of those one step closer to the 180 | ultimate state. In some sense the uses marked proximate are 181 | "thunks" or "promises". 182 | 183 | ===> Note that any newly analyzed file might have a new use of a 184 | name-introduction in a non-proximate file. That is, we need to 185 | traverse the chain. So I think we still need some "resolve all" 186 | function that does this. Furthermore, since it is only needed by 187 | rename commands, we /could/ do /none/ of that work up-front. Wait 188 | until some rename command actually needs to run. (Or maybe, wait 189 | until we've reached an idle quiescent state, and do it. Or, start 190 | doing it but be "interruptible".) 191 | -------------------------------------------------------------------------------- /span-map.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require data/skip-list 7 | racket/dict 8 | racket/match 9 | racket/set 10 | racket/serialize 11 | racket/struct) 12 | 13 | (provide max-position 14 | make-span-map 15 | span-map? 16 | span-map-set! 17 | span-map-update*! 18 | span-map-add! 19 | span-map-remove! 20 | span-map-ref/bounds 21 | span-map-ref 22 | span-map-refs 23 | span-map-values 24 | span-map->list 25 | span-map-count 26 | span-map-empty?) 27 | 28 | ;; Although this is not backed by an interval-map, it is backed by a 29 | ;; skip-list with (cons beg end) keys. Unlike an interval-map, it 30 | ;; allows storing items where beg=end. span-map-set! does /not/ do any 31 | ;; splitting when setting; as a result it is OK for spans to overlap. 32 | ;; (But span-map-update*! function will update an existing span with 33 | ;; exactly the same beg/end positions.) As a result, the primary 34 | ;; lookup functions is span-map-refs, plural. A span-map-ref/bounds 35 | ;; wrapper is supplied when a user wants to find for a position just 36 | ;; one span with (< beg end). 37 | ;; 38 | ;; Also this defines prop:serializable. 39 | 40 | (module+ test 41 | (require rackunit)) 42 | 43 | (define (make-span-map . inits) 44 | (define sm (span-map (make-skip-list))) 45 | (for ([init (in-list inits)]) 46 | (match-define (cons (cons beg end) val) init) 47 | (span-map-set! sm beg end val)) 48 | sm) 49 | 50 | (define (skip-list-update! s key updater default) 51 | (skip-list-set! s key (updater (skip-list-ref s key default)))) 52 | 53 | (define (span-map-update*! sm beg end updater default) 54 | (skip-list-update! (span-map-s sm) (cons beg end) updater default)) 55 | 56 | (define (span-map-set! sm beg end v) 57 | (span-map-update*! sm beg end (λ _ v) v)) 58 | 59 | (define (span-map-add! sm beg end v) 60 | (span-map-update*! sm beg end (λ (vs) (set-add vs v)) (set))) 61 | 62 | ;; span-map-remove! removes mappings created by either span-map-set! 63 | ;; (a single value) or span-map-add! (a set of valuess). 64 | (define not-found (gensym 'not-found)) 65 | (define (span-map-remove! sm beg end v) 66 | (define key (cons beg end)) 67 | (match (skip-list-ref (span-map-s sm) key not-found) 68 | [(== not-found) 69 | (error 'span-map-remove! "no mapping\n beg:~v\n end:~v" beg end)] 70 | [(? set? s) 71 | (unless (set-member? s v) 72 | (error 'span-map-remove! "value not in set\n beg:~v\n end:~v\n value:~v\n set:~v" 73 | beg end v s)) 74 | (if (set-empty? s) 75 | (skip-list-remove! (span-map-s sm) key) 76 | (span-map-set! sm beg end (set-remove s v)))] 77 | [old-v 78 | (unless (equal? v old-v) 79 | (error 'span-map-remove! "value not present\n beg:~v\n end:~v\n expected value:~v\n actual value:~v" 80 | beg end v old-v)) 81 | (skip-list-remove! (span-map-s sm) key)])) 82 | 83 | (define (span-map->list sm) 84 | (for/list ([(k v) (in-dict (span-map-s sm))]) 85 | (cons k (if (set? v) (set->list v) v)))) 86 | 87 | (define (span-map-values sm) 88 | (dict-values (span-map-s sm))) 89 | 90 | (define (span-map-count sm) 91 | (dict-count (span-map-s sm))) 92 | 93 | (define (span-map-empty? sm) 94 | (dict-empty? (span-map-s sm))) 95 | 96 | (define (span-map->vector sm) 97 | (for/vector ([(k v) (in-dict (span-map-s sm))]) 98 | (cons k v))) 99 | 100 | (require racket/runtime-path) 101 | (define-runtime-path here ".") 102 | (define span-map-deserialize-info (make-deserialize-info make-span-map void)) 103 | (provide span-map-deserialize-info) 104 | 105 | (struct span-map (s) 106 | #:property prop:custom-write 107 | (make-constructor-style-printer 108 | (lambda (_) 'make-span-map) 109 | span-map->list) 110 | #:property prop:serializable 111 | (make-serialize-info span-map->vector 112 | (cons 'span-map-deserialize-info 113 | (module-path-index-join (syntax-source #'here) #f)) 114 | #f 115 | here)) 116 | 117 | (module+ test 118 | (let ([sm (make-span-map)]) 119 | (span-map-add! sm 10 20 "foo") 120 | (span-map-add! sm 10 20 "bar") 121 | (span-map-add! sm 10 20 "baz") 122 | (span-map-add! sm 18 19 "not same span") 123 | (check-equal? (span-map-refs sm 10 20) 124 | (list (cons '(10 . 20) (set "foo" "bar" "baz")) 125 | (cons '(18 . 19) (set "not same span")))) 126 | (check-equal? (span-map-ref/bounds sm 15 #f) 127 | (cons (cons 10 20) (set "foo" "bar" "baz"))))) 128 | 129 | (define not-given (gensym 'not-given)) 130 | 131 | (define (span-map-ref/bounds sm pos [default not-given]) 132 | (define (not-found) 133 | (cond [(eq? default not-given) (error 'span-map-ref/bounds "not found\n pos: ~v" pos)] 134 | [(procedure? default) (default)] 135 | [else default])) 136 | (match (span-map-refs sm pos (add1 pos)) 137 | [(list) (not-found)] 138 | [(list (and v (cons (cons beg end) _val))) 139 | #:when (< beg end) 140 | v] 141 | [(list* many) 142 | (for/or ([v (in-list many)]) 143 | (match-define (cons (cons beg end) _val) v) 144 | (and (< beg end) v))] 145 | [_ (not-found)])) 146 | 147 | (define (span-map-ref sm pos #:try-zero-width? [try-zero-width? #f] [default not-given]) 148 | (define (not-found) 149 | (cond [(eq? default not-given) (error 'span-map-ref "not found\n pos: ~v" pos)] 150 | [(procedure? default) (default)] 151 | [else default])) 152 | (match (span-map-refs sm pos (add1 pos)) 153 | [(list) (not-found)] 154 | [(list (cons (cons beg end) val)) 155 | #:when (or try-zero-width? (< beg end)) 156 | val] 157 | [(list* many) 158 | (for/or ([v (in-list many)]) 159 | (match-define (cons (cons beg end) val) v) 160 | (and (or try-zero-width? (< beg end)) 161 | val))] 162 | [_ (not-found)])) 163 | 164 | (define max-position (expt 2 60)) 165 | (define (span-map-refs sm from upto) 166 | (define s (span-map-s sm)) 167 | (reverse 168 | (let loop ([result null] 169 | [iter (or (skip-list-iterate-greatest/<=? s (cons from max-position)) 170 | (skip-list-iterate-least s))]) 171 | (cond 172 | [iter 173 | ;; For zero-width beg=end items, treat end as (add1 end). 174 | (define key (skip-list-iterate-key s iter)) 175 | (match-define (cons beg ~end) key) 176 | (define end (if (= beg ~end) (add1 ~end) ~end)) 177 | (cond 178 | [(<= end from) (loop result 179 | (skip-list-iterate-next s iter))] 180 | [(<= upto beg) result] 181 | [else (loop (cons (cons key (skip-list-iterate-value s iter)) 182 | result) 183 | (skip-list-iterate-next s iter))])] 184 | [else result])))) 185 | 186 | #| 187 | [10 20] 188 | 10-----20 189 | 5-----15 190 | 15-----25 191 | |# 192 | 193 | (module+ test 194 | (define sm (make-span-map)) 195 | (span-map-set! sm 10 20 "10-20") 196 | (span-map-set! sm 30 40 "30-40") 197 | (span-map-set! sm 40 45 "40-45") 198 | (span-map-set! sm 50 50 "50-50") 199 | (span-map-set! sm 50 60 "50-60") 200 | (span-map-set! sm 70 70 "70-70") 201 | 202 | (check-equal? (span-map-refs sm 1 10) 203 | null) 204 | (check-equal? (span-map-refs sm 5 15) 205 | '(((10 . 20) . "10-20"))) 206 | (check-equal? (span-map-refs sm 10 20) 207 | '(((10 . 20) . "10-20"))) 208 | (check-equal? (span-map-refs sm 15 25) 209 | '(((10 . 20) . "10-20"))) 210 | (check-equal? (span-map-refs sm 25 26) 211 | null) 212 | (check-equal? (span-map-refs sm 30 40) 213 | '(((30 . 40) . "30-40"))) 214 | (check-equal? (span-map-refs sm 1 1000) 215 | '(((10 . 20) . "10-20") 216 | ((30 . 40) . "30-40") 217 | ((40 . 45) . "40-45") 218 | ((50 . 50) . "50-50") 219 | ((50 . 60) . "50-60") 220 | ((70 . 70) . "70-70"))) 221 | (check-equal? (span-map-refs sm 25 1000) 222 | '(((30 . 40) . "30-40") 223 | ((40 . 45) . "40-45") 224 | ((50 . 50) . "50-50") 225 | ((50 . 60) . "50-60") 226 | ((70 . 70) . "70-70"))) 227 | (check-equal? (span-map-refs sm 100 1000) 228 | null) 229 | 230 | (check-false (span-map-ref/bounds sm 1 #f)) 231 | (check-equal? (span-map-ref/bounds sm 10 #f) 232 | '((10 . 20) . "10-20")) 233 | (check-equal? (span-map-ref/bounds sm 15 #f) 234 | '((10 . 20) . "10-20")) 235 | (check-false (span-map-ref/bounds sm 20 #f) 236 | "end is treated as in half-open interval [beg end)") 237 | (check-equal? (span-map-ref/bounds sm 40 #f) 238 | '((40 . 45) . "40-45") 239 | "end is treated as in half-open interval [beg end)") 240 | (check-false (span-map-ref/bounds sm 25 #f)) 241 | (check-equal? (span-map-ref/bounds sm 30 #f) 242 | '((30 . 40) . "30-40")) 243 | (check-equal? (span-map-ref/bounds sm 50 #f) 244 | '((50 . 60) . "50-60") 245 | "span-map-ref/bounds ignores zero-width items") 246 | (check-equal? (span-map-ref sm 70 #:try-zero-width? #t) 247 | "70-70" 248 | "span-map-ref #:try-zero-width? works")) 249 | 250 | #; 251 | (define (lookup key) 252 | (define s (span-map-s sm)) 253 | (define iter (or (skip-list-iterate-greatest/<=? s key) 254 | (skip-list-iterate-least s))) 255 | (and iter (cons (skip-list-iterate-key s iter) 256 | (skip-list-iterate-value s iter)))) 257 | -------------------------------------------------------------------------------- /relations.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | ;;; Relations between definition and use sites; rename sites 7 | 8 | (module+ test) ;see example.rkt for many tests using actual example files 9 | 10 | (require racket/contract 11 | racket/match 12 | (only-in "analyze.rkt" get-file) 13 | "data-types.rkt" 14 | (prefix-in store: 15 | (only-in "store.rkt" 16 | uses-of-export))) 17 | 18 | (define-logger pdb-relations) 19 | 20 | (provide use->def 21 | nominal-use->def 22 | rename-sites) 23 | 24 | ;; Provide some things not necessarily intended to be part of public 25 | ;; API. One use: For exploring interactively in REPL when working with 26 | ;; tests in example.rkt, such as writing new tests or understanding 27 | ;; test failures. 28 | (module+ private 29 | (provide def->def/same-name 30 | use->def/same-name 31 | def->uses/same-name)) 32 | 33 | ;; Given a file position, see if it is a use of a definition. If so, 34 | ;; return the definition location, else #f. i.e. This is the basis for 35 | ;; "find definition". 36 | ;; 37 | ;; One wrinkle here is that we may already know about a use of a 38 | ;; definition in file A, and know it is defined in file B, but we 39 | ;; haven't yet analyzed that defining file. We may need to go analyze 40 | ;; file B first, so we can find locations within. 41 | ;; 42 | ;; Another consideration is "how far to jump". When #:nominal? is 43 | ;; false, we use the identifier-binding from-xxx fields to find the 44 | ;; definition, which elides any arbitrarily long chain of renaming 45 | ;; imports and exports (but see use->def wrapper function, below, wrt 46 | ;; more jumps for e.g. contracts). Otherwise, when #:nominal? is true, 47 | ;; we use the nominal-from-xxx fields, letting arrows trace each such 48 | ;; step. 49 | ;; 50 | ;; Another wrinkle is "sub range binders". Although 51 | ;; drracket/check-syntax handles this for lexical arrows, we need to 52 | ;; do extra work for import arrows, where the sub range binders are on 53 | ;; the export in the other analyzed file. 54 | (define (use->def* use-path pos #:nominal? nominal? #:same-name? same-name?) 55 | (log-pdb-relations-debug "~v" `(use->def* ,use-path ,pos #:nominal? ,nominal? #:same-name? ,same-name?)) 56 | (match (get-file use-path) 57 | [(? file? f) 58 | (define am (file-arrows f)) 59 | (match (span-map-ref (arrow-map-use->def am) pos #f) 60 | [(? lexical-arrow? a) 61 | (log-pdb-relations-debug " ~v" a) 62 | (and (or (not same-name?) 63 | (eq? (lexical-arrow-use-sym a) (lexical-arrow-def-sym a))) 64 | (list use-path (arrow-def-beg a) (arrow-def-end a) 0))] 65 | [(or (? export-rename-arrow? a) 66 | (? import-rename-arrow? a)) 67 | (log-pdb-relations-debug " ~v" a) 68 | (if same-name? 69 | (list use-path (arrow-use-beg a) (arrow-use-end a) 0) 70 | (list use-path (arrow-def-beg a) (arrow-def-end a) 0))] 71 | [(? import-arrow? a) 72 | (log-pdb-relations-debug " ~v" a) 73 | (match-define (cons def-path def-ibk) (if nominal? 74 | (import-arrow-nom a) 75 | (import-arrow-from a))) 76 | (let loop ([use-offset (- pos (arrow-use-beg a))] 77 | [def-path def-path] 78 | [def-ibk def-ibk]) 79 | (and (path? def-path) ;not symbol like '#%runtime or '#%core 80 | (match (get-file def-path) 81 | [(? file? f) 82 | (define ht (if nominal? 83 | (file-pdb-exports f) 84 | (file-pdb-definitions f))) 85 | (match (hash-ref ht def-ibk #f) 86 | [(? list? sub-ranges) 87 | (log-pdb-relations-debug " ~v ~v" def-ibk sub-ranges) 88 | (for/or ([v (in-list sub-ranges)]) 89 | (match-define (sub-range ofs span _sub-sym sub-pos) v) 90 | (cond 91 | [(and (<= ofs use-offset) 92 | (< use-offset (+ ofs span))) 93 | (match sub-pos 94 | [(? number? sub-pos) 95 | (log-pdb-relations-debug " use-offset ~v so chose ~v from ~v" 96 | use-offset v sub-ranges) 97 | (list def-path sub-pos (+ sub-pos span) (- use-offset ofs))] 98 | [(re-export p i) 99 | (log-pdb-relations-debug " use-offset ~v so chose ~v from ~v; adjusting use-offset to ~v" 100 | use-offset v sub-ranges (- use-offset ofs)) 101 | (loop (- use-offset ofs) p i)] 102 | [#f #f])] 103 | [else 104 | (log-pdb-relations-debug " ~v not found in subranges: false" 105 | `(hash-ref ,ht ,def-ibk #f)) 106 | #f]))] 107 | [#f 108 | (log-pdb-relations-debug " ~v not found in ~a hash-table:\n ~v" 109 | def-ibk 110 | (if nominal? "exports" "definitions") 111 | ht) 112 | #f])] 113 | [#f 114 | (log-pdb-relations-debug " (get-file ~v): false" def-path) 115 | #f])))] 116 | {#f 117 | (log-pdb-relations-debug " (span-map-ref file-arrows ~v): false" pos) 118 | #f})] 119 | [#f 120 | (log-pdb-relations-debug " (get-file ~v): false" use-path) 121 | #f])) 122 | 123 | ;; A wrapper for use-pos->def*, assuming #:nominal? #t and 124 | ;; #:same-name? #f. Single steps through the complete chain of name 125 | ;; introductions resulting from imports and exports, including through 126 | ;; renames. 127 | (define/contract (nominal-use->def path pos) 128 | (-> (and/c path? complete-path?) position? 129 | (or/c #f (list/c (and/c path? complete-path?) exact-integer? exact-integer?))) 130 | (match (use->def* path pos #:nominal? #t #:same-name? #f) 131 | [(list p b e _o) (list p b e)] 132 | [#f #f])) 133 | 134 | ;; A wrapper for use->def*: When the def site is a use of another def, 135 | ;; return that other def. 136 | ;; 137 | ;; This is to cover cases like contract-out, where identifier-binding 138 | ;; will take us to the contract _wrapper_, but we want the "full jump" 139 | ;; all the way to the definition wrapped by the contract. So we keep 140 | ;; calling use->def* until we arrive at a fix point. 141 | (define (use->def/fix-point path pos #:nominal-and-same-name? n&sn?) 142 | (let loop ([previous-answer #f] 143 | [use-path path] 144 | [pos pos]) 145 | (match (use->def* use-path pos #:nominal? n&sn? #:same-name? n&sn?) 146 | [(== previous-answer) previous-answer] 147 | [(and answer (list def-path def-beg _def-end ofs)) 148 | (loop answer def-path (+ def-beg ofs))] 149 | [#f previous-answer]))) 150 | 151 | ;; A wrapper for use->def/fix-point, using false for #:nominal? and 152 | ;; #:same-name? -- i.e. "jump all the way to actual definition". 153 | (define/contract (use->def path pos) 154 | (-> (and/c path? complete-path?) position? 155 | (or/c #f (list/c (and/c path? complete-path?) position? position?))) 156 | (match (use->def/fix-point path pos #:nominal-and-same-name? #f) 157 | [(list p b e _o) (list p b e)] 158 | [#f #f])) 159 | 160 | ;; A wrapper for use->def/fix-point, using true for #:nominal? and 161 | ;; #:same-name? -- i.e. "find the most distant same-named nominal 162 | ;; definition". 163 | (define/contract (use->def/same-name path pos) 164 | (-> (and/c path? complete-path?) position? 165 | (or/c #f (list/c (and/c path? complete-path?) position? position?))) 166 | (match (use->def/fix-point path pos #:nominal-and-same-name? #t) 167 | [(list p b e _o) (list p b e)] 168 | [#f #f])) 169 | 170 | ;; Used by `rename-sites` to handle the case where it is given a def 171 | ;; site as opposed to a use site -- so if use->def/same-name fails, 172 | ;; try this. 173 | (define (def->def/same-name path pos) 174 | (define f (get-file path)) 175 | (or (for/or ([a (in-set (span-map-ref (arrow-map-def->uses (file-arrows f)) pos (set)))]) 176 | (and (lexical-arrow? a) 177 | (eq? (lexical-arrow-use-sym a) (lexical-arrow-def-sym a)) 178 | (list path (arrow-def-beg a) (arrow-def-end a)))) 179 | ;; Currently we don't have arrows on prefix-out prefixes, so 180 | ;; also check whether the site is a sub-range of an export. 181 | (for/or ([sub-ranges (in-hash-values (file-pdb-exports f))]) 182 | (for/or ([v (in-list sub-ranges)]) 183 | (match-define (sub-range _ofs span _sub-sym sub-pos) v) 184 | (and (number? sub-pos) 185 | (<= sub-pos pos) 186 | (< pos (+ sub-pos span)) 187 | (list path sub-pos (+ sub-pos span))))))) 188 | 189 | ;; Same-named def->uses. Follows nominal chain, in reverse. 190 | (define/contract (def->uses/same-name path def-beg def-end) 191 | (-> (and/c path? complete-path?) position? position? 192 | any #;(hash/c (and/c path? complete-path?) (listof (cons/c position? position?)))) 193 | (unless (< def-beg def-end) 194 | (error 'def->uses/same-name 195 | "expected def-beg < def-end\n def-beg: ~v\n def-end: ~v\n" 196 | def-beg def-end)) 197 | 198 | (define ht (make-hash)) 199 | (define (add-use! path beg end) 200 | (hash-update! ht 201 | path 202 | (λ (s) (set-add s (cons beg end))) 203 | (set))) 204 | 205 | (add-use! path def-beg def-end) 206 | (define f (get-file path)) 207 | (define positions 208 | (for/fold ([positions (set def-beg)]) 209 | ([a (in-set (span-map-ref (arrow-map-def->uses (file-arrows f)) 210 | def-beg 211 | (set)))]) 212 | (cond 213 | [(and (lexical-arrow? a) 214 | (eq? (lexical-arrow-def-sym a) (lexical-arrow-use-sym a))) 215 | (add-use! path (arrow-use-beg a) (arrow-use-end a)) 216 | (set-add positions (arrow-use-beg a))] 217 | [else positions]))) 218 | 219 | ;; Note: This relies on use->def/same-name having already traversed 220 | ;; the import chain to the defining file, analyzing it (and each 221 | ;; other file along the way) if necessary, so that the db tables 222 | ;; will have the necessary informaton. 223 | (for ([pos (in-set positions)]) 224 | (store:uses-of-export path pos add-use!)) 225 | 226 | (for/hash ([(p s) (in-hash ht)]) 227 | (values p (sort (set->list s) < #:key car)))) 228 | 229 | ;; Given a path and position, which may be either a use or a def, 230 | ;; return the set of places that must be renamed (the def site as well 231 | ;; as all the use sites) if any of them are. 232 | ;; 233 | ;; Basically we follow the nominal same-name chain from the use to the 234 | ;; def (the "root"), then reverse and "fan out" to follow the tree 235 | ;; back out through all uses sharing a name. So, we can handle 236 | ;; scenarios like something named "foo", then imported/exported as 237 | ;; "bar", then imported/exported as "foo". Each of these three is 238 | ;; independent wrt renaming; changing the name for each subset has no 239 | ;; affect on the others (except maybe at the "ends", e.g. a rename-{in 240 | ;; out} where just the old or new name should change). 241 | ;; 242 | ;; TODO/IDEA: If we return the current/old name, or its beg/end, or 243 | ;; its span -- whatever -- then we need only return the beg of each 244 | ;; use site. The end will always be name-length positions after beg. 245 | ;; 246 | ;; TODO: Status quo we tell the client the sites to change, and let it 247 | ;; make the changes. Subsequently, the client will tell us to 248 | ;; re-analyze each changed file. But that's inefficient, compared to 249 | ;; us simply updating our db with the new name and positions; the 250 | ;; /relations/ don't change. So instead there could be some flow 251 | ;; where, asssuming the user proceeds and supplies the new name, it 252 | ;; gives us back the same list of sites, plus the new name, and we 253 | ;; proactively make the change on the db side. We would also need to 254 | ;; update the new digest for each file, somehow, to avoid unnecesary 255 | ;; re-analysis happening after all. 256 | (define/contract (rename-sites path pos) 257 | (-> (and/c path? complete-path?) position? 258 | any #;(hash/c (and/c path? complete-path?) (listof (cons/c position? position?)))) 259 | ;; Find the def site, which might already be at `pos`. 260 | (match (or (use->def/same-name path pos) 261 | (def->def/same-name path pos)) 262 | [(list def-path def-beg def-end) 263 | (def->uses/same-name def-path def-beg def-end)] 264 | [#f (make-hash)])) 265 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This is WIP exploring the idea of storing, for multiple source files, 2 | the result of running drracket/check-syntax, plus some more analysis. 3 | 4 | The main motivation is to support **multi-file** flavors of things 5 | like "find references" and "rename". 6 | 7 | The intent is this could enhance Racket Mode, as well as Dr Racket 8 | and other tools. 9 | 10 | # Database 11 | 12 | For each analyzed source file: 13 | 14 | 1. Fully expand, accumulating some information even if expansion 15 | fails (as used by e.g. Typed Racket): 16 | 17 | - direct calls to `error-display-handler` 18 | - `online-check-syntax` logger messages 19 | 20 | 2. Run [check-syntax], recording the values from various 21 | [`syncheck-annotations<%>`] methods. 22 | 23 | After accumulating information in various fields of a struct, finally 24 | the struct is serialized, compressed, and stored in a sqlite table. 25 | 26 | [check-syntax]: https://docs.racket-lang.org/drracket-tools/Accessing_Check_Syntax_Programmatically.html 27 | [`syncheck-annotations<%>`]: https://docs.racket-lang.org/drracket-tools/Accessing_Check_Syntax_Programmatically.html#%28def._%28%28lib._drracket%2Fcheck-syntax..rkt%29._syncheck-annotations~3c~25~3e%29%29 28 | 29 | We extend the check-syntax analysis in various ways: 30 | 31 | - In addition to `syncheck:add-definition-target`, which identifies 32 | definitions, we identify and record _exports_ from fully-expanded 33 | `#%provide` forms. 34 | 35 | - In addition to `syncheck:add-arrow/name-dup/pxpy`, which identifies 36 | lexical and import arrows, we identify and record some other flavors 37 | of arrows: 38 | 39 | - import-rename-arrows, as from `rename-in` etc. 40 | - export-rename-arrows, as from `rename-out`, etc. 41 | 42 | Also we enhance the check-syntax import-arrows to store the "from" 43 | and "nominal-from" information from [identifier-binding]. Following 44 | the nominal-from values to the exports in other files, and vice 45 | versa, is how we can identify rename-sites across multiple files. 46 | 47 | [identifier-binding]:https://docs.racket-lang.org/reference/stxcmp.html#%28def._%28%28quote._~23~25kernel%29._identifier-binding%29%29 48 | 49 | - We build a map from positions to submodule name paths (where `()` 50 | means no submodule, i.e. the outermost, file module) as well as 51 | whether the module sees its parent's bindings (as with `module+`). 52 | This map supports various functionality: 53 | 54 | - A tool can implement a "run/enter submodule at current position" 55 | command without assuming (as does "classic" Racket Mode) 56 | s-expression surface syntax to discover the submodule name path. 57 | 58 | - Knowing from which module(s) to itemize imported symbols for 59 | completion candidates (as described in the next bullet point). 60 | 61 | - For each module, we record each `#%require` in a normalized format 62 | (module path, whether it is the module language, any prefix, and any 63 | exceptions). Later this can be "cashed in" for a list of the 64 | imported symbols, to be used by a tool like a source code editor for 65 | completion candidates. In some cases we can obtain the export 66 | symbols from our own database; as a fallback we use 67 | `module->exports`. 68 | 69 | ## You want to jump where, in what size steps? 70 | 71 | In Racket a definition can be exported and imported an arbitrary 72 | number of times before it is used -- and can be renamed at each such 73 | step. 74 | 75 | In general, the definition graph elides that and expresses "big, 76 | direct jumps" among files. Which is wonderful when you want to e.g. 77 | "visit/find/jump to definition" in another file. 78 | 79 | By contrast the "name introduction and use" graph cares about the 80 | chain of exports and imports, and considers steps where a rename 81 | occurs. A motivation is to support multi-file rename commands. For 82 | that to work, every occurrence of the "same" name must be known, 83 | including uses in `provide` and `require` forms, and considering 84 | clauses like `rename-out`, `prefix-ix`, `rename-in`, `prefix-out`, and 85 | so on. 86 | 87 | For example, if user wants `foo` to be renamed `bar`, then sites like 88 | `(provide foo)` must be changed. Furthermore, sites like `(provide 89 | (rename-out [foo xxx]))` are inflection points where the graph ends. 90 | If some other file does `(require (rename-in mod [xxx foo]))`, _that_ 91 | "foo" is not the same and should not be in the same set of sites to be 92 | renamed as the "foo" in the exporting file. 93 | 94 | ## use->def vs. def->uses 95 | 96 | For either type of graph, it is simple to proceed from a use to its 97 | source. When the source is in some other file, we know _which_ other 98 | file: The `identifier-binding` "from" or "nominal-from" information 99 | always says in which other file to look. If that file isn't yet in the 100 | database (or is outdated), we analyze it, and so on transitively. 101 | Furthermore it is a 1:1 relation; even when there are multiple steps 102 | (such as hopping through a contract wrapper to the wrapped 103 | definition), each step is 1:1. 104 | 105 | On the other hand, proceeding from a definition to its uses is a 106 | 1:many relation, transitively (each of the many uses may in turn have 107 | many uses). Furthermore we can't discover absolutely all uses -- 108 | unless absolutely all using files have already been analyzed. There 109 | exists only a set of _known_ uses, which is limited by the set of 110 | already-analyzed files. 111 | 112 | This is another motivation to save analysis results for multiple files 113 | in a database. One or more directory trees, each for some project the 114 | user cares about, can be analyzed proactively. (Thereafter a digest 115 | mismatch can trigger an automatic re-analysis of a changed file.) This 116 | enables discovering all uses, at least within the scope of those 117 | projects. 118 | 119 | # Disposition 120 | 121 | ## Racket Mode 122 | 123 | Status quo, Racket Mode's back end runs check-syntax and returns to 124 | the front end `racket-xp-mode` the full results for each file. The 125 | entire Emacs buffer is re-propertized. For example mouse-overs become 126 | `help-echo` text properties. 127 | 128 | How exactly would Racket Mode's back end use this `pdb` project. 129 | 130 | ### Roadmap step 1: Still all results at once 131 | 132 | Initially, Racket Mode's back end could use this pdb project the same 133 | way: Get the full analysis results, and re-propertize the entire 134 | buffer. 135 | 136 | That alone is no improvement. But we could add new Racket Mode 137 | commands that query the db, such as multi-file xref-find-references or 138 | renaming. 139 | 140 | Furthermore, I think we could eliminate the back end's cache of fully 141 | expanded syntax. For example find-definition no longer needs to walk 142 | fully-expanded syntax looking for a site. We already did that, for all 143 | definitions, and saved the results; now it's just a db query. 144 | 145 | (I'm not sure about find-signature: Maybe we could add a pass to walk 146 | pre-expanded surface syntax, finding all signatures, as the status quo 147 | back end does one by one.) 148 | 149 | --- 150 | 151 | **Status**: Done as an initial sanity check, then discarded. I 152 | modified `racket-xp-mode` and the Racket Mode back end to use pdb when 153 | available, and use the same propertize-all-buffer approach. It 154 | performed about the same as before; having multi-file rneame was nice. 155 | Although that's still in the commit history, I wanted to move on past 156 | that to the next step. 157 | 158 | ### Step 2: Query results JIT for spans 159 | 160 | A bigger change: The front end would query just for various spans of 161 | the buffer, as-needed. 162 | 163 | This would improve how we handle larger files like 164 | [class-internal.rkt], not to mention eenormous files like the [example 165 | provided by samth]. 166 | 167 | [example provided by samth]: https://github.com/greghendershott/racket-mode/issues/522 168 | [class-internal.rkt]: https://github.com/racket/racket/blob/master/racket/collects/racket/private/class-internal.rkt 169 | 170 | Status quo, Emacs doesn't block while the analysis is underway, but 171 | after it completes, for a sufficiently large buffer and analysis 172 | results, it takes a very long time to marshal the results and to 173 | re-propertize the entire buffer; Emacs can noticeably freeze. 174 | 175 | Admittedly doing limited, JIT queries doesn't magically transform 176 | drracket/check-syntax itself to a "streaming" or incremental approach. 177 | The _entire_ analysis would still need to complete (still taking about 178 | 10 seconds for [class-internal.rkt], and 60 for the [example provided 179 | by samth]!) before _any_ new results were available. However the 180 | results could be retrieved in vastly smaller batches. IOW there would 181 | still be a large delay until any new results were available, but no 182 | update freezes. 183 | 184 | --- 185 | 186 | **Status:** Done. Still dog-fooding. I quickly realized that modifying 187 | `racket-xp-mode` to work in both the "classic" and new ways was going 188 | to be messy. Instead I made a fresh `racket-pdb-mode`. This works by 189 | doing a query to the db whenever point (Emacs jargon, a.k.a. the 190 | caret) moves. The back end and pdb return values only pertaining to 191 | point and the currently visible span (the window-start through 192 | window-end positions, in Emacs jargon). I'm still dog-fooding this, 193 | looking for problems or mis-features. 194 | 195 | ## Other tools 196 | 197 | Of course this could become a package to be used in various other 198 | ways. 199 | 200 | We could offer any of: 201 | 202 | - A CLI (e.g. a new `raco` tool). 203 | 204 | - A stable API for Racket programs. 205 | 206 | - An equivalent API via HTTP. 207 | 208 | One issue here is that some tools might prefer or need line:column 209 | coordinates instead of positions. [Effectively drracket/check-syntax 210 | and our own analysis use `syntax-position` and `syntax-span`, ignoring 211 | `syntax-line` and `syntax-column`.] Either we could try to store 212 | line:col-denominated spans, also, in the db when we analyze (at some 213 | cost in space). Or we could just synthesize these as/when needed by 214 | such an API, by running through the file using `port-count-lines!` (at 215 | some cost in time). 216 | 217 | # Known limitations and to-do 218 | 219 | - The `#%provide` clauses `all-defined`, `all-defined-except`, 220 | `prefix-all-defined`, and `prefix-all-defined-except` are not yet 221 | supported by our analysis that finds exports. (Note that `provide` 222 | clauses like `all-defined-out` do not actually expand into these, 223 | and _are_ supported. So this limitation isn't as big as it seems. 224 | But if some handwritten code or other macro expansion uses these 225 | specific `#%provide` clauses, the exports won't be identified.) 226 | 227 | - The `rename-sites` command currently returns a hash-table value with 228 | all results. For renames involving a huge number of files and sites, 229 | a for-each flavor might be preferable. 230 | 231 | # Tire kicking 232 | 233 | If you want to kick the tires on this in its current state, I 234 | recommend looking at the tests in `example.rkt`, as called from the 235 | `tests` submodule. 236 | 237 | As the functions work in terms of 1-based positions, just like Racket 238 | `syntax-position` and Emacs buffer positions, it's annoying to keep 239 | typing C-x = to see the position at point while in the 240 | example files. You might find it handy to add something like the 241 | following to your Emacs `mode-line-position` definition: 242 | 243 | ```elisp 244 | (:propertize (:eval (format "%s" (point))) 245 | face (:slant italic)) 246 | ``` 247 | 248 | Also remember that M-g c will let you jump to a position. 249 | 250 | --- 251 | 252 | You probably want to avoid, however, the `very-many-files-example` 253 | submodule -- unless you want to wait hours for very many files to be 254 | analyzed: 255 | 256 | ```racket 257 | (require pdb) 258 | (for ([d (in-list (list* (get-pkgs-dir 'installation) 259 | (get-pkgs-dir 'user) 260 | (current-library-collection-paths)))]) 261 | (when (directory-exists? d) 262 | (time (add-directory d #:import-depth 32767)))) 263 | (require (submod pdb/store maintenance)) 264 | (displayln (db-stats)) 265 | ``` 266 | 267 | On my system -- with the non-minimal Racket distribution installed, 268 | and about a dozen other packages: 269 | 270 | ``` 271 | -------------------------------------------------------------------------- 272 | Analysis data for 8124 source files: 183.5 MiB. 273 | 274 | 596394 nominal imports of 149866 exports: 3.2 MiB. 275 | 7667 interned paths: 0.6 MiB. 276 | 277 | Total: 187.2 MiB. 278 | Does not include space for integer key columns or indexes. 279 | 280 | /home/greg/.racket/pdb/pdb-main.sqlite: 219.4 MiB. 281 | Actual space on disk may be much larger due to deleted items: see VACUUM. 282 | ------------------------------------------------------------------------- 283 | ``` 284 | 285 | Also, if you use Emacs, you _could_ try the new `pdb` branch from the 286 | `racket-mode` repo. In this case you probably to change your 287 | `racket-mode-hook` to use `racket-pdb-mode` instead of 288 | `racket-xp-mode`. Be aware that sometimes you'll need to `git pull` 289 | from both this `pdb` repo as well as the `pdb` branch on the 290 | `racket-mode` repo -- in other words sometimes I'll make a breaking 291 | change that requires you to pull from both repos. At this stage things 292 | are still evolving, sometimes drastically, so unfortunately it's not 293 | yet worth preserving backward compatibility. 294 | -------------------------------------------------------------------------------- /analyze-more.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require racket/match 7 | racket/syntax 8 | racket/set 9 | racket/sequence 10 | "import-symbols.rkt") 11 | 12 | (provide analyze-more) 13 | 14 | ;; Extra analysis. After it settles down, some of this might end up as 15 | ;; a PR for drracket-tool-lib. 16 | ;; 17 | ;; Three purposes here: 18 | ;; 19 | ;; 1. Find completion candidates from imports. Similar to what 20 | ;; imports.rkt does in Racket Mode back end. 21 | ;; 22 | ;; 2. Add some arrows for renaming require and provide. 23 | ;; 24 | ;; 3. Provide information about definition targets with 25 | ;; sub-range-binders syntax properties. 26 | 27 | (define (analyze-more add-module 28 | add-definitions 29 | add-export 30 | add-imports 31 | add-import-rename 32 | path stx-obj) 33 | (define (symbolic-compare? x y) 34 | (eq? (syntax-e x) (syntax-e y))) 35 | 36 | (let level+mod-loop ([stx-obj stx-obj] 37 | [level 0] 38 | [level-of-enclosing-module 0] 39 | [mods #f] 40 | [lang #f]) 41 | (define (level-loop sexp level) 42 | (level+mod-loop sexp level level-of-enclosing-module mods lang)) 43 | (define (mod-loop sexp mod lang) 44 | (define (sub-mods mod) (if mods (cons mod mods) (list mod))) 45 | (level+mod-loop sexp 0 46 | (+ level level-of-enclosing-module) 47 | (if mod (sub-mods mod) mods) 48 | lang)) 49 | (define (loop sexp) 50 | (level+mod-loop sexp level level-of-enclosing-module mods lang)) 51 | 52 | (syntax-case* stx-obj 53 | (#%plain-lambda case-lambda if begin begin0 let-values letrec-values 54 | set! quote quote-syntax with-continuation-mark 55 | #%plain-app #%top 56 | define-values define-syntaxes begin-for-syntax 57 | module module* 58 | #%require #%provide #%declare #%expression) 59 | (λ (x y) (free-identifier=? x y level 0)) 60 | [(#%plain-lambda args bodies ...) 61 | (for-each loop (syntax->list #'(bodies ...)))] 62 | [(case-lambda [argss bodiess ...]...) 63 | (for-each loop (syntax->list #'((bodiess ...) ...)))] 64 | [(if test then else) 65 | (begin 66 | (loop #'test) 67 | (loop #'then) 68 | (loop #'else))] 69 | [(begin bodies ...) 70 | (for-each loop (syntax->list #'(bodies ...)))] 71 | [(begin0 bodies ...) 72 | (for-each loop (syntax->list #'(bodies ...)))] 73 | [(let-values (bindings ...) bodies ...) 74 | (for-each loop (syntax->list #'(bodies ...)))] 75 | [(letrec-values (bindings ...) bodies ...) 76 | (for-each loop (syntax->list #'(bodies ...)))] 77 | [(set! var e) 78 | (loop #'e)] 79 | [(with-continuation-mark a b c) 80 | (begin 81 | (loop #'a) 82 | (loop #'b) 83 | (loop #'c))] 84 | [(#%plain-app pieces ...) 85 | (for-each loop (syntax->list #'(pieces ...)))] 86 | [(define-values vars b) 87 | (begin 88 | (add-definitions stx-obj (submods mods) level #'vars) 89 | (loop #'b))] 90 | [(define-syntaxes names exp) 91 | (begin 92 | (add-definitions stx-obj (submods mods) level #'names) 93 | (level-loop #'exp (+ level 1)))] 94 | [(begin-for-syntax exp ...) 95 | (for ([e (in-list (syntax->list #'(exp ...)))]) 96 | (level-loop e (+ level 1)))] 97 | [(module m-name m-lang (mb bodies ...)) 98 | (begin 99 | (define module-name (syntax-e #'m-name)) 100 | (define submodules (if mods (submods (cons module-name mods)) null)) 101 | (add-module path submodules (site path stx-obj) #f) 102 | (add-imports path submodules 103 | (module-import-spec path submodules #'m-lang #'m-lang)) 104 | (for ([body (in-list (syntax->list #'(bodies ...)))]) 105 | (mod-loop body module-name #'m-lang)))] 106 | [(module* m-name m-lang (mb bodies ...)) 107 | (begin 108 | (define module-name (syntax-e #'m-name)) 109 | (define submodules (if mods (submods (cons module-name mods)) null)) 110 | ;; Wrinkle: module+ splicing means this module* form could 111 | ;; originate from multiple disjoint source spans. We need a 112 | ;; new syntax property added in racket/private/submodule.rkt 113 | ;; to handle this; see 114 | ;; https://github.com/racket/racket/pull/4646/files 115 | (match (syntax-property stx-obj 'origin-form-srcloc) 116 | [#f 117 | (add-module path submodules (site path stx-obj) (not (syntax-e #'m-lang)))] 118 | [prop 119 | (let loop ([prop prop]) 120 | (match prop 121 | [(cons this more) (loop this) (loop more)] 122 | [(srcloc src _line _col pos span) 123 | (when (and (equal? src path) pos span) 124 | (add-module path submodules (cons pos (+ pos span)) (not (syntax-e #'m-lang))))] 125 | [(list) (void)]))]) 126 | (when (syntax-e #'m-lang) 127 | (add-imports path submodules 128 | (module-import-spec path submodules #'m-lang #'m-lang))) 129 | (for ([body (in-list (syntax->list #'(bodies ...)))]) 130 | (if (syntax-e #'m-lang) 131 | (mod-loop body 132 | module-name 133 | #'m-lang) 134 | (mod-loop (syntax-shift-phase-level body (- level)) 135 | module-name 136 | lang))))] 137 | 138 | ; top level or module top level only: 139 | [(#%require raw-require-specs ...) 140 | (let () 141 | (define (handle-raw-require-spec spec) 142 | (let loop ([spec spec] 143 | [level level]) 144 | (define (add-to-level n) (and n level (+ n level))) 145 | (syntax-case* spec 146 | (for-meta for-syntax for-template for-label just-meta for-space just-space portal) 147 | symbolic-compare? 148 | [(for-meta phase specs ...) 149 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 150 | (loop spec (add-to-level (syntax-e #'phase))))] 151 | [(for-syntax specs ...) 152 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 153 | (loop spec (add-to-level 1)))] 154 | [(for-template specs ...) 155 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 156 | (loop spec (add-to-level -1)))] 157 | [(for-label specs ...) 158 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 159 | (loop spec #f))] 160 | [(just-meta phase specs ...) 161 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 162 | (loop spec level))] 163 | [(for-space #f specs ...) 164 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 165 | (loop spec level))] 166 | [(just-space #f specs ...) 167 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 168 | (loop spec level))] 169 | [(portal id content) 170 | (void)] 171 | [_ 172 | (handle-phaseless-spec spec level)]))) 173 | (define (handle-phaseless-spec spec level) 174 | (define adjusted-level (and level (+ level level-of-enclosing-module))) 175 | (syntax-case* spec (only prefix all-except prefix-all-except rename) 176 | symbolic-compare? 177 | [(only _raw-module-path . ids) 178 | (add-imports path (submods mods) (syntax->symbol-set #'ids))] 179 | [(prefix prefix-id raw-module-path) 180 | (let ([submodules (submods mods)]) 181 | (add-imports path submodules 182 | (module-import-spec path submodules lang 183 | #'raw-module-path 184 | #:prefix #'prefix-id)))] 185 | [(all-except raw-module-path . ids) 186 | (let ([submodules (submods mods)]) 187 | (add-imports path submodules 188 | (module-import-spec path submodules lang 189 | #'raw-module-path 190 | #:except (syntax->symbol-set #'ids))))] 191 | [(prefix-all-except prefix-id raw-module-path . ids) 192 | (let ([submodules (submods mods)]) 193 | (add-imports path submodules 194 | (module-import-spec path submodules lang 195 | #'raw-module-path 196 | #:prefix #'prefix-id 197 | #:except (syntax->symbol-set #'ids))))] 198 | ;; Not only does this result from obvious surface require 199 | ;; clauses like rename-in or only-in, in which case the 200 | ;; new local-id has full srcloc in original program, it 201 | ;; can arise from non-trivial prefix-in, in which case 202 | ;; local-id srcloc will have no syntax-position or -span 203 | ;; but will have a syntax property revealing the srcloc 204 | ;; of the one or more prefixes and of the suffix. 205 | [(rename raw-module-path local-id imported-id) 206 | (let ([submodules (submods mods)]) 207 | (when (eq? (syntax-e #'raw-module-path) (syntax-e lang)) 208 | (add-imports path submodules 209 | (seteq (syntax->datum #'imported-id)))) 210 | (add-imports path submodules 211 | (seteq (syntax->datum #'local-id))) 212 | (add-import-rename path submodules adjusted-level 213 | #'imported-id #'local-id #'raw-module-path))] 214 | [raw-module-path 215 | (module-path? (syntax->datum #'raw-module-path)) 216 | (let ([submodules (submods mods)]) 217 | (add-imports path submodules 218 | (module-import-spec path submodules lang 219 | #'raw-module-path)))] 220 | [_ (void)])) 221 | (for ([spec (in-list (syntax->list #'(raw-require-specs ...)))]) 222 | (handle-raw-require-spec spec)))] 223 | 224 | ; module top level only: 225 | [(#%provide raw-provide-specs ...) 226 | (let () 227 | (define (handle-raw-provide-spec spec) 228 | (let loop ([spec spec] 229 | [level level]) 230 | (syntax-case* spec (for-meta for-syntax for-label protect for-space) 231 | symbolic-compare? 232 | [(protect specs ...) 233 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 234 | (loop spec level))] 235 | [(for-meta n specs ...) 236 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 237 | (loop spec (+/f level (syntax-e #'n))))] 238 | [(for-syntax specs ...) 239 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 240 | (loop spec (and level (add1 level))))] 241 | [(for-label specs ...) 242 | (for ([spec (in-list (syntax->list #'(specs ...)))]) 243 | (loop spec #f))] 244 | [_ 245 | (handle-phaseless-spec spec level)]))) 246 | (define (handle-phaseless-spec spec level) 247 | (syntax-case* spec 248 | (rename struct all-from all-from-except 249 | all-defined all-defined-except 250 | prefix-all-defined prefix-all-defined-except 251 | protect 252 | expand) 253 | symbolic-compare? 254 | ;; Not only does this result from obvious surface 255 | ;; `provide` clauses like rename-out, in which case the 256 | ;; new export-id has full srcloc, it can arise from 257 | ;; prefix-out, in which case export-id srcloc will have 258 | ;; no syntax-position or -span but will have a syntax 259 | ;; property revealing the srcloc of the one or more 260 | ;; prefixes and of the suffix. 261 | ;; 262 | ;; Note that for contract-out, what's happening here is 263 | ;; exporting the _wrapper_ renamed as the same name as the 264 | ;; wrapee; and, both IDs share the same srcloc. 265 | [(rename local-id export-id) 266 | (add-export path (submods mods) level #'export-id #'local-id)] 267 | [(struct struct-id (field-id ...)) 268 | (begin 269 | (add-export path (submods mods) level #'struct-id) 270 | (add-export path (submods mods) level (format-id #f "make-~a" 271 | #'struct-id 272 | #:source #'struct-id)) 273 | (add-export path (submods mods) level (format-id #f "struct:~a" 274 | #'struct-id 275 | #:source #'struct-id)) 276 | (add-export path (submods mods) level (format-id #f "~a?" 277 | #'struct-id 278 | #:source #'struct-id)) 279 | (for ([field-id (in-syntax #'(field-id ...))]) 280 | (add-export path (submods mods) level (format-id #f "~a-~a" 281 | #'struct-id #'field-id 282 | #:source field-id)) 283 | (add-export path (submods mods) level (format-id #f "set-~a-~a!" 284 | #'struct-id #'field-id 285 | #:source field-id))))] 286 | ;; Although the surface macros `all-from-out` and 287 | ;; `all-from-except-out` seem to expand directly to a set 288 | ;; of raw module paths (handled by the default `id` case 289 | ;; below), not to uses of `all-from` and 290 | ;; `all-from-except`, these latter are documented and 291 | ;; could be used. For instance Racket's private/base.rkt 292 | ;; uses them in a handwritten #%provide. 293 | [(all-from raw-module-path) 294 | (handle-all-from #'raw-module-path (seteq))] 295 | [(all-from-except raw-module-path . exceptions) 296 | (handle-all-from #'raw-module-path (syntax->symbol-set #'exceptions))] 297 | ;; As with all-from, the clauses all-defined, 298 | ;; all-defined-except, prefix-all-defined, and 299 | ;; prefix-all-defined-except don't seem to be used by 300 | ;; surface macros like all-defined-out, including in 301 | ;; combination with prefix-out and except-out. 302 | ;; 303 | ;; As with all-from, these primitive clauses are 304 | ;; documented and might be used in handwritten code. 305 | ;; Someday we should try to support these, here. 306 | [(all-defined . _) (void)] 307 | [(all-defined-except . _) (void)] 308 | [(prefix-all-defined . _) (void)] ;and add-export-rename? 309 | [(prefix-all-defined-except . _) (void)] ;and add-export-rename? 310 | [id 311 | (identifier? #'id) 312 | (add-export path (submods mods) level #'id)] 313 | [_ (void)])) 314 | (define (handle-all-from raw-module-path exceptions) 315 | (define-values (vars stxs) 316 | (with-handlers ([exn:fail? (λ _ (values null null))]) 317 | (module->exports (syntax->datum raw-module-path)))) 318 | (for* ([vars+stxs (in-list (list vars stxs))] 319 | [phase+spaces (in-list vars+stxs)] 320 | [export (in-list (cdr phase+spaces))]) 321 | (define sym (car export)) 322 | (unless (set-member? exceptions sym) 323 | (define stx (datum->syntax raw-module-path sym #f)) ;no srcloc 324 | (add-export path (submods mods) level stx)))) 325 | (define (+/f x y) (and x y (+ x y))) 326 | (for ([spec (in-list (syntax->list #'(raw-provide-specs ...)))]) 327 | (handle-raw-provide-spec spec)))] 328 | [_ (void)]))) 329 | 330 | (define (submods rev-mods) 331 | (if (pair? rev-mods) 332 | (cdr (reverse rev-mods)) 333 | null)) 334 | 335 | (define (site path stx) 336 | (define pos (syntax-position stx)) 337 | (define span (syntax-span stx)) 338 | (and pos 339 | span 340 | (syntax-e stx) 341 | (equal? (syntax-source stx) path) 342 | (cons pos (+ pos span)))) 343 | 344 | (define (syntax->symbol-set stxs) 345 | (for/seteq ([stx (in-syntax stxs)]) 346 | (syntax->datum stx))) 347 | -------------------------------------------------------------------------------- /query.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang racket/base 5 | 6 | (require racket/contract 7 | racket/match 8 | (only-in "analyze.rkt" get-file) 9 | "data-types.rkt" 10 | "import-symbols.rkt" 11 | "span-map.rkt") 12 | 13 | (provide get-annotations 14 | max-position 15 | get-submodule-names 16 | get-completion-candidates 17 | get-errors 18 | get-point-info 19 | get-doc-link 20 | get-require-path) 21 | 22 | (module+ test 23 | (require (for-syntax racket/base) 24 | rackunit 25 | racket/path 26 | racket/runtime-path)) 27 | 28 | ;;; Simple queries 29 | 30 | ;; Most annotations pertain to specific spans. There are various 31 | ;; kinds. get-annotations returns most mixed and sorted by position. 32 | ;; (See get-errors and get-completion-candidates for two things that 33 | ;; get-annotations does /not/ return.) 34 | ;; 35 | ;; 1. This query supports the sort of access pattern that Racket Mode's 36 | ;; "classic" racket-xp-mode uses: Get values for everything and put as 37 | ;; text properties into the buffer. 38 | ;; 39 | ;; That access pattern is not great for large files with a lot of 40 | ;; annotation data. It takes space on the front end client (e.g. 41 | ;; emacs/vim/vscode). Just as bad is marshaling overhead (converting 42 | ;; to/from json or sexp or whatever format is used for the Racket back 43 | ;; end to talk to the non-Racket front end). 44 | ;; 45 | ;; 2. This query also supports getting only a subset for a certain 46 | ;; span. This supports better access patterns. See also 47 | ;; `get-point-info`, below, which is especially optimized for one such 48 | ;; access pattern. 49 | ;; 50 | ;; TODO: Now that we record zero-span items, notably for things like 51 | ;; #%app and #%datum, we should add a flag here to ignore these. Some 52 | ;; clients -- certainly Emacs -- can't use these, and they are 53 | ;; numerous, so in such cases best not to marshal them at all. 54 | (define/contract (get-annotations path [beg 1] [end max-position]) 55 | (->* ((and/c path? complete-path?)) (position? position?) any) ;returns pdb? 56 | (define f (get-file path)) 57 | (define (arrows) 58 | ;; FIXME: Iterating entire set is slow; consider storing 59 | ;; syncheck-arrows in a pair of span-maps (something like our 60 | ;; arrow-map but for syncheck-arrows). 61 | (set->list 62 | (for*/set ([a (in-set (file-syncheck-arrows f))] 63 | #:when (or (and (<= beg (syncheck-arrow-def-beg a)) 64 | (< (syncheck-arrow-def-end a) end)) 65 | (and (<= beg (syncheck-arrow-use-beg a)) 66 | (< (syncheck-arrow-use-end a) end)))) 67 | (match-define (syncheck-arrow def-beg def-end def-px def-py use-beg use-end use-px use-py actual? phase require-arrow _use-sym _def-sym _rb) a) 68 | (list 'arrow def-beg def-end def-px def-py use-beg use-end use-px use-py actual? phase require-arrow)))) 69 | (define (mouse-overs) 70 | (for/list ([v (in-list (span-map-refs (file-syncheck-mouse-overs f) beg end))]) 71 | (match-define (cons (cons beg end) texts) v) 72 | (list 'mouse-over beg end texts))) 73 | (define (doc-sites) 74 | (for/list ([v (in-list (span-map-refs (file-syncheck-docs-menus f) beg end))]) 75 | (match-define (cons (cons beg end) d) v) 76 | (list 'doc-link beg end (syncheck-docs-menu-path d) (syncheck-docs-menu-anchor-text d)))) 77 | (define (unused-requires) 78 | (for/list ([v (in-list (span-map-refs (file-syncheck-unused-requires f) beg end))]) 79 | (match-define (cons (cons beg end) _) v) 80 | (list 'unused-require beg end))) 81 | (define (require-opens) 82 | (for/list ([v (in-list (span-map-refs (file-syncheck-require-opens f) beg end))]) 83 | (match-define (cons (cons beg end) path) v) 84 | (list 'require beg end path))) 85 | (define (text-types) 86 | (for/list ([v (in-list (span-map-refs (file-syncheck-text-types f) beg end))]) 87 | (match-define (cons (cons beg end) type) v) 88 | (list 'type beg end type))) 89 | (sort (append (arrows) 90 | (mouse-overs) 91 | (doc-sites) 92 | (require-opens) 93 | (unused-requires) 94 | (text-types)) 95 | < #:key cadr)) 96 | 97 | ;; Private support function to get the (cons submodule-names 98 | ;; sees-enclosing?) value for a given point. 99 | (define (get-submodule f pos) 100 | (define im (file-pdb-modules f)) 101 | (match (interval-map-ref im pos #f) 102 | [(? pair? v) v] 103 | [#f 104 | ;; For files using "#lang", positions before the lang do not 105 | ;; correspond to any module. For those, just assume the first 106 | ;; module. Same for file using a (module __) form but with 107 | ;; leading whitespace. Deal with those, plus position past EOF, 108 | ;; by returning the first module. 109 | (define iter (dict-iterate-first im)) 110 | (and iter (dict-iterate-value im iter))])) 111 | 112 | ;; Public API which returns just the list of submodule names. 113 | (define (get-submodule-names path pos) 114 | (match (get-submodule (get-file path) pos) 115 | [(cons mods _sees-enclosing?) mods] 116 | [#f null])) 117 | 118 | (module+ test 119 | (define-runtime-path modules.rkt (build-path "example" "modules.rkt")) 120 | (require "analyze.rkt") 121 | (analyze-path modules.rkt #:always? #t) 122 | (check-equal? (get-submodule-names modules.rkt 1) 123 | '()) 124 | (check-equal? (get-submodule-names modules.rkt 52) 125 | '(m+)) 126 | (check-equal? (get-submodule-names modules.rkt 122) 127 | '(m+)) 128 | (check-equal? (get-submodule-names modules.rkt 201) 129 | '(m+)) 130 | (check-equal? (get-submodule-names modules.rkt 250) 131 | '(m+)) 132 | (check-equal? (get-submodule-names modules.rkt 253) 133 | '(m+)) 134 | (check-equal? (get-submodule-names modules.rkt 267) 135 | '(m+ n+)) 136 | (check-equal? (get-submodule-names modules.rkt 125) 137 | '(m)) 138 | (check-equal? (get-submodule-names modules.rkt 149) 139 | '(m n)) 140 | (check-equal? (get-submodule-names modules.rkt 175) 141 | '(m n o)) 142 | (check-equal? (get-submodule-names modules.rkt 314) 143 | '(a)) 144 | (check-equal? (get-submodule-names modules.rkt 371) 145 | '(a b))) 146 | 147 | ;; Return list of completion candidates from imports and module-level 148 | ;; definitions (not lexical bindings). 149 | ;; 150 | ;; When `maybe-pos` isn't false and we can determine the innermost 151 | ;; surrounding module, limit candidates to those for that module. When 152 | ;; a module can see its parent's bindings (i.e. module+), include 153 | ;; those, transitively. 154 | ;; 155 | ;; When there is no known module -- either because `maybe-pos` is 156 | ;; false, or because the file had errors -- return union of /all/ 157 | ;; imports and module-level definitions. (Although this errs on the 158 | ;; side of too many, it's more useful than supplying none. In the case 159 | ;; where the file had errors, then `analyze` will have copied the 160 | ;; file-pdb-imports and file-pdb-definitions values from the previous 161 | ;; successful analysis, if any. So we can give user candidates while 162 | ;; they are fixing the error.) 163 | (define (candidates-from-imports-and-module-level-definitions f maybe-pos) 164 | (match (and maybe-pos (get-submodule f maybe-pos)) 165 | [#f 166 | (apply set-union 167 | (for/seteq ([v (in-hash-keys (file-pdb-definitions f))]) 168 | (ibk-sym v)) 169 | (map resolve-import-set (hash-values (file-pdb-imports f))))] 170 | [innermost 171 | (define (syms s mods) 172 | (set-union s 173 | (for/seteq ([v (in-hash-keys (file-pdb-definitions f))] 174 | #:when (equal? mods (ibk-mods v))) 175 | (ibk-sym v)) 176 | (resolve-import-set (hash-ref (file-pdb-imports f) mods (seteq))))) 177 | (let loop ([s (seteq)] 178 | [v innermost]) 179 | (match v 180 | [(cons mods #f) (syms s mods)] 181 | [(cons mods #t) 182 | (define enclosing-mods (reverse (cdr (reverse mods)))) 183 | (loop (syms s mods) 184 | (for/or ([v (in-dict-values (file-pdb-modules f))]) 185 | (and (equal? enclosing-mods (car v)) v)))] 186 | [#f (seteq)]))])) 187 | 188 | (module+ test 189 | (define f (get-file modules.rkt)) 190 | (check-true (set-member? (candidates-from-imports-and-module-level-definitions f 37) 191 | 'get-pure-port) 192 | "get-pure-port is a completion candidate in the file module, because it requires net/url") 193 | (check-true (set-member? (candidates-from-imports-and-module-level-definitions f 109) 194 | 'get-pure-port) 195 | "get-pure-port is a completion candidate in the m+ submodule, because m+ is a module+ submodule of the file module") 196 | (check-false (set-member? (candidates-from-imports-and-module-level-definitions f 149) 197 | 'get-pure-port) 198 | "get-pure-port is NOT a completion candidate in the m submodule") 199 | (check-true (set-member? (candidates-from-imports-and-module-level-definitions f 283) 200 | 'get-pure-port) 201 | "get-pure-port is a completion candidate in the n+ submodule, because n+ is a module+ submodule of the m+ module+ submodule of the file module") 202 | (check-true (set-member? (candidates-from-imports-and-module-level-definitions f 1) 203 | 'foo) 204 | "foo (defined in outermost file module) is a completion 205 | candidate in the outermost file module") 206 | (check-true (set-member? (candidates-from-imports-and-module-level-definitions f 327) 207 | 'foo) 208 | "foo (defined in outermost file module) is a completion 209 | candidate in the outermost file module") 210 | (check-true (set-member? (candidates-from-imports-and-module-level-definitions f 327) 211 | 'bar) 212 | "bar (defined in module+ a) is a candidate in module+ a") 213 | (check-true (set-member? (candidates-from-imports-and-module-level-definitions f 371) 214 | 'baz) 215 | "baz (defined in module b) is a candidate in module b") 216 | (check-false (set-member? (candidates-from-imports-and-module-level-definitions f 327) 217 | 'baz) 218 | "baz (defined in module b) is a candidate in module+ a")) 219 | 220 | ;; Accepts an optional position to indicate a module, and limit 221 | ;; candidates to those valid within the module. 222 | (define (get-completion-candidates path [maybe-pos #f]) 223 | (define f (get-file path)) 224 | (set-union 225 | (candidates-from-imports-and-module-level-definitions f maybe-pos) 226 | ;; ~= to getting candidates from syncheck:add-mouse-over messages 227 | ;; about "bound occurrence(s)", which includes lexical arrows, plus 228 | ;; more from our rename-arrows. Note: Currently this does NOT try 229 | ;; to limit based on lexical scope; it errs on the side of 230 | ;; returning more candidates. 231 | (for*/fold ([s (seteq)]) 232 | ([uses (in-list (span-map-values (arrow-map-def->uses (file-arrows f))))] 233 | [use (in-set uses)]) 234 | (match use 235 | [(? lexical-arrow? a) 236 | (set-add s (lexical-arrow-use-sym a))] 237 | [(? rename-arrow? a) 238 | (set-add (set-add s (rename-arrow-old-sym a)) 239 | (rename-arrow-new-sym a))] 240 | [_ s])))) 241 | 242 | ;; Accepts no span or position. Justification: 243 | ;; 244 | ;; 0. There are unlikely to be very many. Most expansion errors result 245 | ;; in a single exn error message. Even things like Typed Racket 246 | ;; that call error-display-handler multiple times before rasing a 247 | ;; single exn, tend not to have more than (say) a dozen. 248 | ;; 249 | ;; 1. A user will want to see/visit all the error locations, 250 | ;; regardless of where they might be in the file. 251 | ;; 252 | ;; 2. The errors returned for `path` might be in another, imported 253 | ;; file, for which any span or position or span in `path` is N/A. 254 | (define (get-errors path) 255 | (for/list ([v (in-list (span-map->list (file-pdb-errors (get-file path))))]) 256 | (match-define (list (cons beg end) (cons maybe-path message)) v) 257 | (list beg end 258 | (or maybe-path (path->string path)) 259 | message))) 260 | 261 | ;; This is designed for a client that does not want to store any 262 | ;; persistent values on its end. For example, an Emacs mode that does 263 | ;; not store every annotation as a text property. Instead, upon 264 | ;; movement of window-point or window-{start end} (to use Emacs 265 | ;; terminology), it can call this to get only values pertaining to 266 | ;; that subset of the buffer. Presumably it can temporarily enhance 267 | ;; the presentation (e.g. add overlays in Emacs). 268 | ;; 269 | ;; In principle a client could write this itself by filtering 270 | ;; information from `get-annotations` Maybe this shouldn't even exist 271 | ;; as part of library, but just be example code? Anyway it's here for 272 | ;; now as I dog-food the use of pdb by Racket Mode for Emacs, and 273 | ;; learn more from some use in the real world. 274 | (define (get-point-info path pos beg end) 275 | (define f (get-file path)) 276 | (define (error-messages-here) 277 | (match (span-map-ref/bounds (file-pdb-errors f) pos #f) 278 | [(cons (cons beg end) a-set) 279 | (and (not (set-empty? a-set)) 280 | (list beg end 281 | (for*/set ([v (in-set a-set)] 282 | [err-path (in-value (car v))] 283 | [err-msg (in-value (cdr v))] 284 | #:when (or (not err-path) 285 | (equal? err-path (path->string path)))) 286 | err-msg)))] 287 | [#f #f])) 288 | ;; TODO: Should we return all mouse-overs for [beg end), in case the 289 | ;; client wants to support actual GUI tooltips? In that case if the 290 | ;; client wants to treat a mouse-over at point specially (e.g. 291 | ;; racket-show in Racket Mode), let it distinguish that itself? 292 | (define point-mouse-over 293 | (or (error-messages-here) 294 | (match (span-map-ref/bounds (file-syncheck-mouse-overs f) pos #f) 295 | [(cons (cons beg end) v) (list beg end v)] 296 | [#f #f]))) 297 | ;; TODO: Filter use-sites that aren't within [beg end)? In the case 298 | ;; where there are very many use sites (hundreds or thousands?), it 299 | ;; could start to matter that we return so many that aren't visible. 300 | ;; OTOH if we do limit these to [beg end) here, we'd need to export 301 | ;; a new function to support front end {next previous}-use commands. 302 | (define point-def-and-use-sites 303 | (match (span-map-ref (arrow-map-use->def (file-arrows f)) pos #f) 304 | [(? arrow? u->d) 305 | (list (cons (arrow-def-beg u->d) 306 | (arrow-def-end u->d)) 307 | (import-arrow? u->d) 308 | (let ([d->us (span-map-ref (arrow-map-def->uses (file-arrows f)) 309 | (arrow-def-beg u->d) 310 | (set))]) 311 | (for/list ([d->u (in-set d->us)] 312 | #:when (< (arrow-use-beg d->u) 313 | (arrow-use-end d->u))) 314 | (cons (arrow-use-beg d->u) 315 | (arrow-use-end d->u)))))] 316 | [_ 317 | (match (span-map-ref (arrow-map-def->uses (file-arrows f)) pos (set)) 318 | [(? set? d->us) 319 | #:when (not (set-empty? d->us)) 320 | (list (cons (arrow-def-beg (set-first d->us)) 321 | (arrow-def-end (set-first d->us))) 322 | (import-arrow? (set-first d->us)) 323 | (for/list ([d->u (in-set d->us)] 324 | #:when (< (arrow-use-beg d->u) 325 | (arrow-use-end d->u))) 326 | (cons (arrow-use-beg d->u) 327 | (arrow-use-end d->u))))] 328 | [_ (list #f #f #f)])])) 329 | (define unused-requires 330 | (map car (span-map-refs (file-syncheck-unused-requires f) beg end))) 331 | ;; Although you might think unused bindings, which get a "no bound 332 | ;; occurrences" mouse-over, would be handled by the 333 | ;; 'unused-identifier text-type, that seems to be used only for 334 | ;; unused requires. 335 | ;; 336 | ;; Although you might think lexical arrows would be a good way to 337 | ;; find all definition sites, naturally there is no arrow drawn for 338 | ;; unused definitions (what would the other end be). So here, too, 339 | ;; the most reliable source of information, as hacky as it might be, 340 | ;; seems to be looking for mouse-overs with "bound occurence(s)". 341 | (define-values (def-sites unused-def-sites) 342 | (for/fold ([defs null] 343 | [unused null]) 344 | ([v (in-list (span-map-refs (file-syncheck-mouse-overs f) beg end))]) 345 | (match (for/or ([str (in-set (cdr v))]) 346 | (cond [(equal? str "no bound occurrences") 347 | (cons (car v) #t)] 348 | [(regexp-match? #px"^\\d+ bound occurrences?$" str) 349 | (cons (car v) #f)] 350 | [else #f])) 351 | [(cons def unused?) (values (cons def defs) (if unused? 352 | (cons def unused) 353 | unused))] 354 | [#f (values defs unused)]))) 355 | (define doc-sites 356 | (for/list ([v (in-list (span-map-refs (file-syncheck-text-types f) beg end))] 357 | #:when (eq? (cdr v) 'document-identifier)) 358 | (car v))) 359 | (hash 360 | ;; This pertains only to point 361 | 'point-mouse-over point-mouse-over 362 | ;; This pertains to point and related sites, which may extend 363 | ;; beyond beg..end span. 364 | 'point-def-and-use-sites point-def-and-use-sites 365 | ;; These pertain to entire beg..end span 366 | 'def-sites def-sites 367 | 'unused-def-sites unused-def-sites 368 | 'unused-requires unused-requires 369 | 'doc-sites doc-sites)) 370 | 371 | (module+ ex 372 | (require racket/path) 373 | (get-annotations (simple-form-path "example/define.rkt") 1500 1530) 374 | (get-annotations (simple-form-path "example/typed-error.rkt")) 375 | (get-errors (simple-form-path "example/typed-error.rkt")) 376 | (get-errors (simple-form-path "example/require-error.rkt")) 377 | (get-point-info (simple-form-path "example/define.rkt") 1353 1170 1536) 378 | (get-point-info (simple-form-path "example/define.rkt") 1 1 100)) 379 | 380 | (define (get-doc-link path pos) 381 | (define d (span-map-ref (file-syncheck-docs-menus (get-file path)) 382 | pos 383 | #:try-zero-width? #t 384 | #f)) 385 | (and d (cons (syncheck-docs-menu-path d) (syncheck-docs-menu-anchor-text d)))) 386 | 387 | (module+ test 388 | (define-runtime-path typed.rkt (build-path "example" "typed.rkt")) 389 | (define (convert v) ;full doc paths not portable for tests 390 | (match v 391 | [(cons p a) (cons (file-name-from-path p) a)] 392 | [_ #f])) 393 | (check-equal? (convert (get-doc-link typed.rkt 54)) 394 | (cons (build-path "generic-numbers.html") 395 | "(def._((quote._~23~25kernel)._+))") 396 | "get-doc-linked returns expected file and anchor") 397 | (check-false (convert (get-doc-link typed.rkt 25)) 398 | "get-doc-linked returns false when no doc exists") 399 | (check-equal? (convert (get-doc-link typed.rkt 53)) 400 | (cons (build-path "application.html") 401 | "(form._((lib._racket/private/base..rkt)._~23~25app))") 402 | "get-doc-link finds docs for zero-width-items as a fallback") 403 | (check-equal? (convert (get-doc-link typed.rkt 58)) 404 | (cons (build-path "quote.html") 405 | "(form._((quote._~23~25kernel)._~23~25datum))") 406 | "get-doc-link finds docs for zero-width-items as a fallback")) 407 | 408 | (define (get-require-path path pos) 409 | (span-map-ref (file-syncheck-require-opens (get-file path)) pos #f)) 410 | 411 | (module+ test 412 | (define-runtime-path require.rkt (build-path "example" "require.rkt")) 413 | (require syntax/modresolve) 414 | (check-false (get-require-path require.rkt 1)) 415 | (define-runtime-path define.rkt (build-path "example" "define.rkt")) 416 | (check-equal? (get-require-path require.rkt 28) define.rkt) 417 | (define base.rkt (resolve-module-path 'racket/base)) 418 | (check-equal? (get-require-path require.rkt 7) base.rkt)) 419 | -------------------------------------------------------------------------------- /store.rkt: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021-2023 by Greg Hendershott. 2 | ;; SPDX-License-Identifier: GPL-3.0-or-later 3 | 4 | #lang at-exp racket/base 5 | 6 | (require db 7 | racket/format 8 | racket/match 9 | (only-in racket/path simple-form-path) 10 | racket/promise 11 | racket/serialize 12 | racket/set 13 | sql 14 | syntax/parse/define 15 | "common.rkt" 16 | "gzip.rkt" 17 | [only-in "data-types.rkt" 18 | file-before-serialize 19 | file-after-deserialize]) 20 | 21 | (provide (struct-out file+digest) 22 | get-file 23 | get-digest 24 | get-file+digest 25 | forget 26 | put 27 | uses-of-export 28 | put-resolved-module-path-exports 29 | get-resolved-module-path-exports) 30 | 31 | ;;; The store consists of a sqlite db. 32 | 33 | ;; Determine directory in which to store the sqlite db file, 34 | ;; creating the directory if necessary. 35 | (define (db-parent-dir) 36 | (define dir 37 | (match (getenv "PDB_DIR") 38 | [(? path-string? ps) 39 | (simple-form-path ps)] 40 | [_ 41 | (define parent (if (directory-exists? (find-system-path 'cache-dir)) 42 | (find-system-path 'cache-dir) 43 | (find-system-path 'home-dir))) 44 | (path->directory-path (build-path parent "pdb"))])) 45 | (unless (directory-exists? dir) 46 | (log-pdb-info "~v does not exist; creating" dir) 47 | (make-directory dir)) 48 | (log-pdb-info "Using ~v" dir) 49 | dir) 50 | 51 | ;; Determine complete path to the sqlite db file, creating the file if 52 | ;; necessary. 53 | (define (db-file) 54 | (define path (build-path (db-parent-dir) "pdb-main.sqlite")) 55 | (unless (file-exists? path) 56 | (log-pdb-info "~a does not exist; creating" path) 57 | (disconnect (sqlite3-connect #:database path 58 | #:mode 'create 59 | #:use-place #f))) 60 | path) 61 | 62 | (define-simple-macro (with-transaction dbc:expr e:expr ...+) 63 | (call-with-transaction dbc (λ () e ...))) 64 | 65 | (define (connect/add-flush) 66 | (define dbc (sqlite3-connect #:database (db-file) 67 | #:mode 'read/write 68 | #:use-place #f)) 69 | (plumber-add-flush! (current-plumber) 70 | (λ _ (disconnect dbc))) 71 | 72 | (define tables '(version 73 | files 74 | paths 75 | strings exports re_exports imports 76 | resolved_module_path_exports)) 77 | 78 | (define vacuum? 79 | (with-transaction dbc 80 | ;; Simple versioning: Store an expected version in a table named 81 | ;; "version". Unless found, re-create all the tables. 82 | (define expected-version 22) ;use INTEGER here, beware sqlite duck typing 83 | (define actual-version (with-handlers ([exn:fail? (λ _ #f)]) 84 | (query-maybe-value dbc (select version #:from version)))) 85 | (define upgrade? (not (equal? actual-version expected-version))) 86 | (when upgrade? 87 | (log-pdb-warning "Found db version ~v but need ~v; re-creating db tables" 88 | actual-version 89 | expected-version) 90 | (for ([table (in-list tables)]) 91 | (query-exec dbc (format "drop table if exists ~a" table))) 92 | (query-exec dbc (create-table version #:columns [version string])) 93 | (query-exec dbc (insert #:into version #:set [version ,expected-version]))) 94 | upgrade?)) 95 | 96 | (when vacuum? ;vacuum doesn't work inside a transaction 97 | (query-exec dbc "vacuum;")) 98 | 99 | (with-transaction dbc 100 | ;; This is the main table. Each row corresponds to an analyzed 101 | ;; file. The columns are the path; the digest; and the gzipped, 102 | ;; `write` bytes of a serialized value. (Although the value is a 103 | ;; `file` struct, store.rkt is written not to care about that, 104 | ;; apart from using the file-{before after}-{serialize 105 | ;; deserialize} functions.) 106 | ;; 107 | ;; Here we're really just using sqlite as an alternative to writing 108 | ;; individual .rktd files all over the user's file system. 109 | (query-exec dbc 110 | (create-table 111 | #:if-not-exists files 112 | #:columns 113 | [path string] 114 | [digest string] 115 | [data blob] 116 | #:constraints 117 | (primary-key path))) 118 | 119 | ;; This is effectively a cache of module->exports results, 120 | ;; used to obtain symbols for completion candidates. 121 | (query-exec dbc 122 | (create-table 123 | #:if-not-exists resolved_module_path_exports 124 | #:columns 125 | [rmp string] ;resolved module path 126 | [data blob] ;gzip of (seteq symbol?) 127 | #:constraints 128 | (primary-key rmp))) 129 | 130 | ;; Here we're using sqlite more in the spirit of a sql database 131 | ;; with normalized tables and relational queries. 132 | (query-exec dbc 133 | (create-table 134 | #:if-not-exists strings 135 | #:columns 136 | [str string #:not-null] 137 | #:constraints 138 | (unique str))) 139 | (query-exec dbc 140 | (create-table 141 | #:if-not-exists exports 142 | #:columns 143 | ;; An export with this path and ibk 144 | [path_id integer #:not-null] 145 | [ibk_id integer #:not-null] 146 | ;; And uses of this sub-span 147 | [ofs integer #:not-null] 148 | [span integer #:not-null] 149 | [sub_sym string #:not-null] ;(i.e. this sub-symbol) 150 | ;; Is maybe defined at this pos within path. 151 | [sub_pos integer] 152 | #:constraints 153 | (unique path_id ibk_id ofs span sub_sym sub_pos) 154 | (foreign-key path_id #:references (strings id)) 155 | (foreign-key ibk_id #:references (strings id)))) 156 | (query-exec dbc 157 | (create-table 158 | #:if-not-exists re_exports 159 | #:columns 160 | ;; An export with this path and ibk 161 | [path_id integer #:not-null] 162 | [ibk_id integer #:not-null] 163 | [ofs integer #:not-null] 164 | [span integer #:not-null] 165 | ;; Is re-exported as this other one 166 | [use_path_id integer #:not-null] 167 | [use_ibk_id integer #:not-null] 168 | #:constraints 169 | (unique path_id ibk_id ofs span use_path_id use_ibk_id) 170 | (foreign-key path_id #:references (strings id)) 171 | (foreign-key ibk_id #:references (strings id)) 172 | (foreign-key use_path_id #:references (strings id)) 173 | (foreign-key use_ibk_id #:references (strings id)))) 174 | (query-exec dbc 175 | (create-table 176 | #:if-not-exists imports 177 | #:columns 178 | ;; This source location 179 | [use_path_id integer #:not-null] 180 | [use_beg integer #:not-null] 181 | [use_end integer #:not-null] 182 | ;; Imports this export 183 | [path_id integer #:not-null] 184 | [ibk_id string #:not-null] 185 | #:constraints 186 | (unique use_path_id use_beg use_end path_id ibk_id) 187 | (foreign-key use_path_id #:references (strings id)) 188 | (foreign-key path_id #:references (strings id)) 189 | (foreign-key ibk_id #:references (strings id))))) 190 | dbc) 191 | 192 | (define dbc-promise (delay/thread (connect/add-flush))) 193 | (define (dbc) (force dbc-promise)) 194 | 195 | (define (forget path) 196 | (with-transaction (dbc) 197 | (remove-file-from-sqlite path) 198 | (forget-exports-imports path))) 199 | 200 | (define (put path file digest #:exports exports #:re-exports re-exports #:imports imports) 201 | (with-transaction (dbc) 202 | (write-file+digest-to-sqlite path file digest) 203 | (with-time/log "add-exports-imports" 204 | (add-exports-imports path exports re-exports imports)))) 205 | 206 | ;;; `files` table 207 | 208 | (define (write-file+digest-to-sqlite path data digest) 209 | (define path-str (path->string path)) 210 | (define compressed-data 211 | (gzip-bytes 212 | (write-to-bytes 213 | (serialize 214 | (file-before-serialize data))))) 215 | (with-transaction (dbc) ;"upsert" 216 | (query-exec (dbc) 217 | (delete #:from files #:where (= path ,path-str))) 218 | (query-exec (dbc) 219 | (insert #:into files #:set 220 | [path ,path-str] 221 | [digest ,digest] 222 | [data ,compressed-data])))) 223 | 224 | (struct file+digest (file digest)) 225 | 226 | (define (get-digest path) 227 | (query-maybe-value (dbc) 228 | (select digest 229 | #:from files 230 | #:where (= path ,(path->string path))))) 231 | 232 | ;; This is written so that when `desired-digest` is not false, and it 233 | ;; doesn't match the digest column, we can avoid all the work of 234 | ;; unzipping, reading, deserializing, and adjusting the data column. 235 | (define (get-file+digest path desired-digest) 236 | (define path-str (path->string path)) 237 | (match (query-maybe-row (dbc) 238 | (if desired-digest 239 | (select data digest 240 | #:from files 241 | #:where (and (= path ,path-str) 242 | (= digest ,desired-digest))) 243 | (select data digest 244 | #:from files 245 | #:where (= path ,path-str)))) 246 | [(vector compressed-data digest) 247 | (with-handlers ([exn:fail? 248 | (λ (e) 249 | (log-pdb-warning "Error deserializing ~v:\n~a" 250 | path 251 | (exn->string e)) 252 | #f)]) 253 | (file+digest (file-after-deserialize 254 | (deserialize 255 | (read-from-bytes 256 | (gunzip-bytes compressed-data)))) 257 | digest))] 258 | [#f #f])) 259 | 260 | (define (get-file path) 261 | (match (get-file+digest path #f) 262 | [(file+digest file _digest) file] 263 | [#f #f])) 264 | 265 | (define (write-to-bytes v) 266 | (define out (open-output-bytes)) 267 | (write v out) 268 | (get-output-bytes out)) 269 | 270 | (define (read-from-bytes bstr) 271 | (define in (open-input-bytes bstr)) 272 | (read in)) 273 | 274 | (define (remove-file-from-sqlite path) 275 | (define path-str (path->string path)) 276 | (query-exec (dbc) 277 | (delete #:from files #:where (= path ,path-str)))) 278 | 279 | ;;; Resolved module path exports 280 | 281 | (define (put-resolved-module-path-exports resolved-module-path set-of-symbols) 282 | (define rmp (~v resolved-module-path)) 283 | (define compressed-data (gzip-bytes (write-to-bytes (set->list set-of-symbols)))) 284 | (query-exec (dbc) 285 | (insert #:into resolved_module_path_exports #:set 286 | [rmp ,rmp] 287 | [data ,compressed-data] 288 | #:or-ignore))) 289 | 290 | (define (get-resolved-module-path-exports resolved-module-path) 291 | (define rmp (~v resolved-module-path)) 292 | (match (query-maybe-value (dbc) 293 | (select data 294 | #:from resolved_module_path_exports 295 | #:where (= rmp ,rmp))) 296 | [(? bytes? compressed-data) 297 | (apply seteq (read-from-bytes (gunzip-bytes compressed-data)))] 298 | [#f (seteq)])) 299 | 300 | ;;; Exports/imports 301 | 302 | 303 | ;;; Misc 304 | 305 | (define (intern v) 306 | (define str 307 | (cond [(path? v) (path->string v)] 308 | [(struct? v) (~a (cdr (vector->list (struct->vector v))))] 309 | [else (~a v)])) 310 | (query-exec (dbc) (insert #:into strings #:set [str ,str] #:or-ignore)) 311 | (query-value (dbc) (select rowid #:from strings #:where (= str ,str)))) 312 | 313 | ;; Assumes called within transaction. 314 | (define (add-exports-imports path exports re-exports imports) 315 | (with-transaction (dbc) 316 | (forget-exports-imports path)) 317 | 318 | (define path-id (intern path)) 319 | 320 | (for ([export (in-list exports)]) 321 | (match-define (list ibk offset span sub-sym sub-pos) export) 322 | (query-exec (dbc) 323 | (insert #:into exports #:set 324 | [path_id ,path-id] 325 | [ibk_id ,(intern ibk)] 326 | [ofs ,offset] 327 | [span ,span] 328 | [sub_sym ,(~a sub-sym)] 329 | [sub_pos ,(false->sql-null sub-pos)] 330 | #:or-ignore))) 331 | (for ([v (in-set re-exports)]) 332 | (match-define (list src-path src-ibk ofs span use-path use-ibk) v) 333 | (query-exec (dbc) 334 | (insert #:into re_exports #:set 335 | [path_id ,(intern src-path)] 336 | [ibk_id ,(intern src-ibk)] 337 | [ofs ,ofs] 338 | [span ,span] 339 | [use_path_id ,(intern use-path)] 340 | [use_ibk_id ,(intern use-ibk)] 341 | #:or-ignore))) 342 | 343 | (for ([import (in-list imports)]) 344 | (match-define (list import-path import-ibk beg end) import) 345 | (query-exec (dbc) 346 | (insert #:into imports #:set 347 | [path_id ,(intern import-path)] 348 | [ibk_id ,(intern import-ibk)] 349 | [use_path_id ,path-id] 350 | [use_beg ,beg] 351 | [use_end ,end] 352 | #:or-ignore)))) 353 | 354 | ;; Assumes called within transaction 355 | (define (forget-exports-imports path) 356 | (define path-id (intern path)) 357 | (query-exec (dbc) 358 | (delete #:from exports 359 | #:where (= path_id ,path-id))) 360 | (query-exec (dbc) 361 | (delete #:from re_exports 362 | #:where (= use_path_id ,path-id))) 363 | (query-exec (dbc) 364 | (delete #:from imports 365 | #:where (= use_path_id ,path-id)))) 366 | 367 | (define (uses-of-export path pos add-use!) 368 | #;(println (list 'uses-of-export path pos)) 369 | (define path-id (intern path)) 370 | (for ([(path-str beg end) 371 | (in-query 372 | (dbc) 373 | (sql 374 | (with #:recursive 375 | ([(rec path_id ibk_id ofs span) 376 | (union 377 | (select path_id ibk_id ofs span 378 | #:from (inner-join exports strings 379 | #:on (= exports.path_id strings.rowid)) 380 | #:where (and (= path_id ,path-id) 381 | (<= sub_pos ,pos) 382 | (< ,pos (+ sub_pos span)))) 383 | (select re.use_path_id re.use_ibk_id (+ rec.ofs re.ofs) rec.span 384 | #:from (inner-join 385 | rec (as re_exports re) 386 | #:using path_id ibk_id)))]) 387 | (select #:distinct 388 | (as (select str #:from strings 389 | #:where (= imports.use_path_id strings.rowid)) 390 | use_path) 391 | (as (+ imports.use_beg ofs) use_beg) 392 | (as (+ imports.use_beg ofs span) use_end) 393 | #:from (inner-join 394 | rec imports 395 | #:on (and (= rec.path_id imports.path_id) 396 | (= rec.ibk_id imports.ibk_id)))))))]) 397 | (add-use! (string->path path-str) beg end))) 398 | 399 | ;; Stats 400 | 401 | (module+ stats 402 | (require racket/string 403 | "data-types.rkt" 404 | "span-map.rkt") 405 | (provide db-stats 406 | file-stats) 407 | 408 | (define (db-stats) 409 | (with-transaction (dbc) 410 | (define file-count (query-value (dbc) (select (count-all) #:from files))) 411 | (define file-data-size 412 | (query-value (dbc) (select (+ (sum (length digest)) (sum (length data))) 413 | #:from files))) 414 | (define exports-count (query-value (dbc) (select (count-all) #:from exports))) 415 | (define exports-size (query-value (dbc) (select (sum (+ 20 (length sub_sym))) #:from exports))) 416 | (define re-exports-count (query-value (dbc) (select (count-all) #:from re_exports))) 417 | (define re-exports-size (* 6 4 re-exports-count)) ;6 32-bit ints (?) 418 | (define imports-count (query-value (dbc) (select (count-all) #:from imports))) 419 | (define imports-size (* 5 4 imports-count )) ;5 32-bit ints (?) 420 | (define rmp-export-syms-count (query-value (dbc) (select (count-all) #:from resolved_module_path_exports))) 421 | (define rmp-export-syms-size (query-value (dbc) (select (sum (length data)) #:from resolved_module_path_exports))) 422 | (define strings-count (query-value (dbc) (select (count-all) #:from strings))) 423 | (define strings-size (query-value (dbc) (select (sum (length str)) #:from strings))) 424 | (define sqlite-file (db-file)) 425 | (define (N n) 426 | (~a (~r n #:precision 0 #:group-sep "," #:min-width 10))) 427 | (define (MB n) 428 | (let ([n (if (sql-null? n) 0 n)]) 429 | (~a (~r (/ n 1024.0 1024.0) #:precision 2 #:min-width 4) " MiB"))) 430 | @~a{-------------------------------------------------------------------------- 431 | Estimated sizes 432 | 433 | @(N file-count) source files analysis data: @(MB file-data-size). 434 | 435 | @(N rmp-export-syms-count) resolved module path export symbol sets: @(MB rmp-export-syms-size). 436 | 437 | @(N exports-count) exports: @(MB exports-size). 438 | @(N re-exports-count) re-exports: @(MB re-exports-size). 439 | @(N imports-count) imports: @(MB imports-size). 440 | @(N strings-count) strings: @(MB strings-size). 441 | 442 | @|sqlite-file| file size: @(MB (file-size sqlite-file)). 443 | Might include space from deleted items that could be vacuumed. 444 | -------------------------------------------------------------------------})) 445 | 446 | (define (file-stats path) 447 | (match (get-file+digest path #f) 448 | [(file+digest f _d) 449 | (define size (or (query-maybe-value 450 | (dbc) 451 | (select (length data) 452 | #:from files 453 | #:where (= path ,(path->string path)))) 454 | 0)) 455 | (define (count v) 456 | (cond [(set? v) (set-count v)] 457 | [(set-mutable? v) (set-count v)] 458 | [(hash? v) (hash-count v)] 459 | [(span-map? v) (span-map-count v)] 460 | [(interval-map? v) (length (dict-values v))] 461 | [else "???"])) 462 | (define labels+counts 463 | (cons 464 | (cons "KiB compressed in db" 465 | @(~r ( / size 1024.0) #:precision 1)) 466 | (for/list ([accessor (in-list (list file-syncheck-arrows 467 | file-syncheck-definition-targets 468 | file-syncheck-tail-arrows 469 | file-syncheck-jumps 470 | file-syncheck-prefixed-requires 471 | file-syncheck-mouse-overs 472 | file-syncheck-docs-menus 473 | file-syncheck-unused-requires 474 | file-syncheck-require-opens 475 | file-syncheck-text-types 476 | file-pdb-errors 477 | file-pdb-modules 478 | file-pdb-definitions 479 | file-pdb-exports 480 | file-pdb-imports 481 | file-pdb-import-renames 482 | file-pdb-export-renames))]) 483 | (cons (substring (~a (object-name accessor)) 5) 484 | (~a (count (accessor f))))))) 485 | (define width (for/fold ([n 0]) 486 | ([count (in-list (map cdr labels+counts))]) 487 | (max n (string-length count)))) 488 | (string-join (cons 489 | (~v path) 490 | (for/list ([v (in-list labels+counts)]) 491 | (match-define (cons label count) v) 492 | (~a " " (~a count #:width width #:align 'right) " " label))) 493 | "\n")] 494 | [_ (~a path "\nNo analysis in db.")])) 495 | 496 | (module+ ex-1 497 | (require racket/path) 498 | (displayln (file-stats (simple-form-path "example/define.rkt")))) 499 | 500 | (module+ ex-2 501 | (require syntax/modresolve) 502 | (displayln (file-stats (resolve-module-path 'racket/private/class-internal))))) 503 | 504 | (module+ debug 505 | (define (create-temp-views) 506 | (query-exec (dbc) "drop view if exists exports_view") 507 | (query-exec 508 | (dbc) 509 | (create-view 510 | #:temporary 511 | exports_view 512 | (select 513 | (as (select str #:from strings #:where (= path_id rowid)) path) 514 | (as (select str #:from strings #:where (= ibk_id rowid)) ibk) 515 | ofs 516 | span 517 | sub_sym 518 | sub_pos 519 | #:from exports))) 520 | (query-exec (dbc) "drop view if exists re_exports_view") 521 | (query-exec 522 | (dbc) 523 | (create-view 524 | #:temporary 525 | re_exports_view 526 | (select 527 | (as (select str #:from strings #:where (= path_id rowid)) path) 528 | (as (select str #:from strings #:where (= ibk_id rowid)) ibk) 529 | ofs 530 | span 531 | (as (select str #:from strings #:where (= use_path_id rowid)) use_path) 532 | (as (select str #:from strings #:where (= use_ibk_id rowid)) use_ibk) 533 | #:from re_exports))) 534 | (query-exec (dbc) "drop view if exists imports_view") 535 | (query-exec 536 | (dbc) 537 | (create-view 538 | #:temporary 539 | imports_view 540 | (select 541 | (as (select str #:from strings #:where (= use_path_id rowid)) use_path) 542 | use_beg 543 | use_end 544 | (as (select str #:from strings #:where (= path_id rowid)) path) 545 | (as (select str #:from strings #:where (= ibk_id rowid)) ibk) 546 | #:from imports)))) 547 | 548 | (define prefix-define.rkt "/home/greg/src/racket/pdb/example/prefix-define.rkt") 549 | (define prefix-require.rkt "/home/greg/src/racket/pdb/example/prefix-require.rkt") 550 | (create-temp-views) 551 | #; 552 | (query (dbc) (select * #:from exports_view 553 | #:where (= path ,prefix-define.rkt))) 554 | #; 555 | (query (dbc) (select * #:from re_exports_view 556 | #:where (= path ,prefix-define.rkt))) 557 | #; 558 | (query (dbc) (select * #:from imports_view 559 | #:where (= use_path ,prefix-require.rkt)))) 560 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | --------------------------------------------------------------------------------