Changeset 9959 in project


Ignore:
Timestamp:
03/20/08 19:20:37 (12 years ago)
Author:
Kon Lovett
Message:

Explict use of SRFI 69.

Location:
release/3/source-xref/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/source-xref/trunk/source-xref-single.scm

    r8021 r9959  
    22;;;; Kon Lovett, Aug '07
    33
     4(declare
     5  (usual-integrations)
     6  (fixnum)
     7  (inline)
     8  (import
     9    #;##compiler#export-list
     10    ##compiler#block-globals
     11    user-preprocessor-pass
     12    user-pass
     13    user-post-analysis-pass )
     14  (always-bound
     15    #;##compiler#export-list
     16    ##compiler#block-globals )
     17  (bound-to-procedure
     18    user-preprocessor-pass
     19    user-pass
     20    user-post-analysis-pass
     21    ##sys#hash-table-for-each ) )
     22
    423(use srfi-1 srfi-69 utils)
    5 
    6 (eval-when (compile)
    7   (declare
    8     (fixnum)
    9     (inline)
    10     (import
    11       #;##compiler#export-list
    12       ##compiler#block-globals
    13       user-preprocessor-pass
    14       user-pass
    15       user-post-analysis-pass
    16       ##sys#hash-table-for-each)
    17     (always-bound
    18       #;##compiler#export-list
    19       ##compiler#block-globals)
    20     (bound-to-procedure
    21       user-preprocessor-pass
    22       user-pass
    23       user-post-analysis-pass
    24       ##sys#hash-table-for-each) ) )
    2524
    2625;;;
     
    4342;;; Syntax forms
    4443
     44;;
     45
    4546(define XREF-LIBRARY-FORMS-PATHNAME (make-pathname (chicken-home) "xref-library-forms"))
    4647
    4748(define *library-forms* (load-sexpr-file XREF-LIBRARY-FORMS-PATHNAME))
     49
     50;;
    4851
    4952(define (library-form? sym)
     
    5255(define (known-form? sym)
    5356  (library-form? sym) )
     57
     58;;
    5459
    5560(define (syntax-define-expression-symbol name args)
     
    6772(define *frm-sym-tab* (make-hash-table eq? hash-by-identity))
    6873
    69 ;Cannot handle 'identifier' macros
     74;XXX Cannot handle 'identifier' macros
    7075
    7176(define (store-form-names expr)
     
    99104  (newline) )
    100105
    101 ;;; Analysis database ignore set
     106;;; Analysis database ignore sets
    102107
    103108(define XREF-LIBRARY-BINDINGS-PATHNAME (make-pathname (chicken-home) "xref-library-bindings"))
    104 
    105 (define *library-bindings* (load-sexpr-file XREF-LIBRARY-BINDINGS-PATHNAME))
    106109
    107110(define XREF-OTHER-BINDINGS-PATHNAME (make-pathname (chicken-home) "xref-other-bindings"))
     
    109112(define *other-bindings* (load-sexpr-file XREF-OTHER-BINDINGS-PATHNAME))
    110113
    111 ;;; Analysis database item test
     114(define *library-bindings* (load-sexpr-file XREF-LIBRARY-BINDINGS-PATHNAME))
     115
     116;; Analysis database item test
    112117
    113118(define (other-binding? k v)
     
    141146                           [else                         'unknown])))
    142147         '())
    143     (if (alist-ref 'references v eq?)
     148    (if (and (not (known-binding? k v))
     149             (alist-ref 'references v eq?) )
    144150        `((referenced ,(cond [(alist-ref 'call-sites v eq?)  'called]
    145151                             [else                           'valued])))
     
    172178      (dump-macro-names)
    173179      (##sys#hash-table-for-each
    174         (lambda (k v)
    175           (when (global-binding? k v)
    176             (unless (known-binding? k v)
    177               (process-binding k v)) ) )
    178         db) ) ) )
     180       (lambda (k v)
     181         (when (global-binding? k v)
     182           (process-binding k v) ) )
     183       db) ) ) )
  • release/3/source-xref/trunk/source-xref.scm

    r8613 r9959  
    77(use sqlite3 sql-null)
    88(use misc-extn-directory misc-extn-dsssl)
    9 (use  lookup-table miscmacros)
     9(use lookup-table miscmacros)
    1010(use #;fmt tabular-list)
    1111(use utf8 utf8-srfi-13)
     
    1616(eval-when (compile)
    1717  (declare
     18    (usual-integrations)
    1819    (fixnum)
    1920    (inline) ) )
     
    3233              val ) ) ) )
    3334
    34 ;; Works for <string> (SQL source) & <statement>
     35;; Works for <string> (SQL source) & <statement> (SQLite prepared statement)
    3536
    3637(define (sqlite3:exec/transaction db #!rest queries #!key (lock 'exclusive))
     
    3839   db
    3940   (lambda ()
    40      (for-each (cut sqlite3:exec db <>)
    41                (fixup-extended-lambda-list-rest '(#:lock) queries))
     41     (for-each
     42      (lambda (query)
     43        (apply sqlite3:exec db query) )
     44      (fixup-extended-lambda-list-rest '(#:lock) queries))
    4245     #t )
    4346   lock) )
     
    5053  (unless (null? args)
    5154    (display ": " port)
    52     (for-each (cut display <> port) (intersperse args ", ")) )
     55    (for-each (cute display <> port) (intersperse args ", ")) )
    5356  (newline port) )
    5457
     
    101104(pp tags)
    102105(pp queries)
    103   (for-each (cut sqlite3:prepare-statement db <> <>) tags queries) )
     106  (for-each (cute sqlite3:prepare-statement db <> <>) tags queries) )
    104107
    105108(define (sqlite3:drop-statements db #!optional (tags (%sqlite3:statement-tags db)))
    106   (for-each (cut sqlite3:drop-statement db <>) tags) )
     109  (for-each (cute sqlite3:drop-statement db <>) tags) )
    107110
    108111;; Statement Specifications Operations
     
    138141;; upd- UPDATE ...
    139142
    140 ; Note - sqlite3 extn doesn't expose the full sqlite3_exec functionality,
     143; Note - sqlite3- doesn't expose the full sqlite3_exec functionality,
    141144; so only one sql stmt at a time.
    142145
     
    144147#<<EOS
    145148CREATE TABLE IF NOT EXISTS source (
    146   oid INTEGER PRIMARY KEY AUTOINCREMENT UNIQUE NOT NULL,
    147   dir TEXT,
    148   fil TEXT NOT NULL,
    149   ext TEXT,
     149  id INTEGER PRIMARY KEY AUTOINCREMENT UNIQUE NOT NULL,
     150  dir VARCHAR,
     151  fil VARCHAR NOT NULL,
     152  ext VARCHAR,
    150153  UNIQUE (dir, fil, ext) ON CONFLICT ROLLBACK
    151154);
     
    156159#<<EOS
    157160CREATE TABLE IF NOT EXISTS symbol (
    158   oid INTEGER PRIMARY KEY AUTOINCREMENT UNIQUE NOT NULL,
    159   name TEXT NOT NULL UNIQUE ON CONFLICT ROLLBACK
     161  id INTEGER PRIMARY KEY AUTOINCREMENT UNIQUE NOT NULL,
     162  name VARCHAR NOT NULL UNIQUE ON CONFLICT ROLLBACK
    160163);
    161164EOS
     
    167170  source_id INTEGER NOT NULL,
    168171  symbol_id INTEGER NOT NULL,
    169   what TEXT NOT NULL,
     172  what VARCHAR NOT NULL,
    170173  PRIMARY KEY (source_id, symbol_id, what)
    171174);
     
    178181  source_id INTEGER NOT NULL,
    179182  symbol_id INTEGER NOT NULL,
    180   what TEXT NOT NULL,
     183  what VARCHAR NOT NULL,
    181184  PRIMARY KEY (source_id, symbol_id, what)
    182185);
     
    186189(define *ins-source-entry-sql*
    187190#<<EOS
    188 INSERT INTO source (oid, dir, fil, ext)
     191INSERT INTO source (id, dir, fil, ext)
    189192  VALUES (NULL, ?001, ?002, ?003);
    190193EOS
     
    193196(define *ins-symbol-entry-sql*
    194197#<<EOS
    195 INSERT INTO symbol (oid, name)
     198INSERT INTO symbol (id, name)
    196199  VALUES (NULL, ?001);
    197200EOS
     
    212215)
    213216
    214 (define *sel-source-oid-entry-sql*
    215 #<<EOS
    216 SELECT source.oid FROM source
     217(define *sel-source-id-entry-sql*
     218#<<EOS
     219SELECT source.id FROM source
    217220  WHERE source.dir = ?001 AND source.fil = ?002 AND source.ext = ?003;
    218221EOS
    219222)
    220223
    221 (define *sel-symbol-oid-entry-sql*
    222 #<<EOS
    223 SELECT symbol.oid FROM symbol
     224(define *sel-symbol-id-entry-sql*
     225#<<EOS
     226SELECT symbol.id FROM symbol
    224227  WHERE symbol.name = ?001;
    225228EOS
     
    228231(define *sel-all-source-entries-sql*
    229232#<<EOS
    230 SELECT oid, dir, fil, ext FROM source;
     233SELECT id, dir, fil, ext FROM source;
    231234EOS
    232235)
     
    235238#<<EOS
    236239SELECT symbol.name, assign.what
    237   FROM symbol JOIN assign ON symbol.oid = assign.symbol_id
     240  FROM symbol JOIN assign ON symbol.id = assign.symbol_id
    238241  WHERE assign.source_id = ?001
    239242  GROUP BY symbol.name;
     
    245248SELECT symbol.name, reference.what, source.dir, source.fil, source.ext
    246249  FROM symbol LEFT JOIN reference
    247        ON symbol.oid = reference.symbol_id LEFT OUTER JOIN assign
     250       ON symbol.id = reference.symbol_id LEFT OUTER JOIN assign
    248251       ON reference.symbol_id = assign.symbol_id LEFT JOIN source
    249        ON assign.source_id = source.oid
     252       ON assign.source_id = source.id
    250253  WHERE reference.source_id = ?001
    251254  GROUP BY symbol.name;
     
    255258(define *sel-duplicate-source-file-entries-sql*
    256259#<<EOS
    257 SELECT DISTINCT source.oid, source.dir, source.fil, source.ext
     260SELECT DISTINCT source.id, source.dir, source.fil, source.ext
    258261  FROM source JOIN (SELECT fil, ext FROM source) AS sourceX
    259262       ON source.fil = sourceX.fil
     
    299302
    300303(define *xref-report-mode-sql*
    301   `((sel-source-oid-entry                     ,*sel-source-oid-entry-sql*)
     304  `((sel-source-id-entry                      ,*sel-source-id-entry-sql*)
    302305    (sel-all-source-entries                   ,*sel-all-source-entries-sql*)
    303306    (sel-source-assign-entries                ,*sel-source-assign-entries-sql*)
     
    311314    (ins-assign-entry       ,*rpl-assign-entry-sql*)
    312315    (ins-reference-entry    ,*rpl-reference-entry-sql*)
    313     (sel-source-oid-entry   ,*sel-source-oid-entry-sql*)
    314     (sel-symbol-oid-entry   ,*sel-symbol-oid-entry-sql*) ) )
     316    (sel-source-id-entry    ,*sel-source-id-entry-sql*)
     317    (sel-symbol-id-entry    ,*sel-symbol-id-entry-sql*) ) )
    315318
    316319;;; Tool Globals
     
    386389;;; Internal Procedures
    387390
     391(define-constant XREF-SINGLE "source-xref-single")
     392
    388393;; Get xref of a single source file
    389394
    390395(define (source-xref-list srcpn opts)
     396  ; CD to source directory since could have local includes
    391397  (push-directory (pathname-directory srcpn))
    392   (receive [in out pid err]
    393            (process* "chicken"
    394                      `(,srcpn
    395                        "-quiet" "-analyze-only" "-extend" "source-xref-single"
    396                        ,@opts))
     398  (let-values ([(in out pid err)
     399                 (process* "chicken"
     400                           `(,srcpn
     401                             "-quiet" "-analyze-only" "-extend" XREF-SINGLE
     402                             ,@opts))
     403    ; 'process*' shouldn't "throw" so this is ok w/o a "try".
    397404    (pop-directory)
    398     (let ([lst (port-map identity (cut read in))]
     405    (let ([lyst (port-map identity (cute read in))]
    399406          [errs (read-all err)])
    400       (receive [epid enorm ecode] (process-wait pid)
     407      (let-values ([(epid enorm ecode) (process-wait pid)])
    401408        (if (and enorm (zero? ecode))
    402             lst
     409            lyst
    403410            (let ([port (current-error-port)])
    404               (display "Chicken Compiler Error: " port) (display ecode port) (newline port)
     411              (display "Error: Chicken Compiler: " port) (display ecode port) (newline port)
    405412              (display errs port) (newline port)
    406413              #f ) ) ) ) ) )
     
    432439;; Atomic Results
    433440
    434 (define (get-source-oid dir fil ext)
    435   (sqlite3:atomic-result (xref-statement sel-source-oid-entry) dir fil ext) )
    436 
    437 (define (get-symbol-oid str)
    438   (sqlite3:atomic-result (xref-statement sel-symbol-oid-entry) str) )
     441(define (get-source-id dir fil ext)
     442  (sqlite3:atomic-result (xref-statement sel-source-id-entry) dir fil ext) )
     443
     444(define (get-symbol-id str)
     445  (sqlite3:atomic-result (xref-statement sel-symbol-id-entry) str) )
    439446
    440447(define (get-maximum-symbol-length)
     
    495502;; Report Body
    496503
    497 (define (report-assigned-xref source-oid)
     504(define (report-assigned-xref source-id)
    498505  (let ([1st #t])
    499506    (sqlite3:for-each-row
     
    504511        (print-columns *assigned-xref-widths* sym knd) )
    505512      (xref-statement sel-source-assign-entries)
    506       source-oid) ) )
     513      source-id) ) )
    507514
    508515#;
    509 (define (report-assigned-xref source-oid)
     516(define (report-assigned-xref source-id)
    510517  (print-define-header)
    511518  (sqlite3:for-each-row
     
    514521      (columnar (with-width *assigned-xref-widths* (dsp sym)) (dsp knd)) nl) )
    515522   (xref-statement sel-source-assign-entries)
    516    source-oid) )
    517 
    518 (define (report-referenced-xref source-oid)
     523   source-id) )
     524
     525(define (report-referenced-xref source-id)
    519526  (let ([1st #t])
    520527    (sqlite3:for-each-row
     
    527534          (display "    in ") (display-file-name dir fil ext) (newline) ) )
    528535      (xref-statement sel-source-reference-assigned-entries)
    529       source-oid) ) )
     536      source-id) ) )
    530537
    531538#;
    532 (define (report-referenced-xref source-oid)
     539(define (report-referenced-xref source-id)
    533540  (print-reference-header)
    534541  (sqlite3:for-each-row
     
    539546       (display "    in ") (display-file-name dir fil ext) (newline) ) )
    540547   (xref-statement sel-source-reference-assigned-entries)
    541    source-oid) )
    542 
    543 (define (report-body-xref source-oid)
    544   (report-assigned-xref source-oid)
    545   (report-referenced-xref source-oid) )
    546 
    547 (define (report-source-xref source-oid dir fil ext)
     548   source-id) )
     549
     550(define (report-body-xref source-id)
     551  (report-assigned-xref source-id)
     552  (report-referenced-xref source-id) )
     553
     554(define (report-source-xref source-id dir fil ext)
    548555  (print-file-header dir fil ext)
    549   (report-body-xref source-oid) )
     556  (report-body-xref source-id) )
    550557
    551558;; Report tables
     
    558565(define (report-xref srcpn)
    559566  (receive [dir fil ext] (decompose-pathname srcpn)
    560     (let ([source-oid (get-source-oid dir fil ext)])
    561       (if source-oid
    562           (report-source-xref source-oid dir fil ext)
     567    (let ([source-id (get-source-id dir fil ext)])
     568      (if source-id
     569          (report-source-xref source-id dir fil ext)
    563570          (print-file-not-found dir fil ext) ) ) ) )
    564571
     
    572579(define (ensure-entry-source srcpn)
    573580  (receive [dir fil ext] (decompose-pathname srcpn)
    574     (or (get-source-oid dir fil ext)
     581    (or (get-source-id dir fil ext)
    575582        (begin
    576583          (sqlite3:exec (xref-statement ins-source-entry) dir fil ext)
     
    579586(define (ensure-entry-symbol sym)
    580587  (let ([str (symbol->string sym)])
    581     (or (get-symbol-oid str)
     588    (or (get-symbol-id str)
    582589        (begin
    583590          (sqlite3:exec (xref-statement ins-symbol-entry) str)
    584591          (sqlite3:last-insert-rowid *xref-db*) ) ) ) )
    585592
    586 (define (update-xref-use source-oid symbol-oid xref-use)
     593(define (update-xref-use source-id symbol-id xref-use)
    587594  (let ([how (xref-usage-how xref-use)]
    588595        [what (xref-usage-what xref-use)])
     
    590597      [(assigned)
    591598        (sqlite3:exec (xref-statement ins-assign-entry)
    592                       source-oid symbol-oid (symbol->string what))]
     599                      source-id symbol-id (symbol->string what))]
    593600      [(referenced)
    594601        (sqlite3:exec (xref-statement ins-reference-entry)
    595                       source-oid symbol-oid (symbol->string what))]
     602                      source-id symbol-id (symbol->string what))]
    596603      [else
    597604        (error-exit 'update-xref-use "unknown xref-usage label" xref-use)]) ) )
    598605
    599 (define (update-xref-macro-use source-oid symbol-oid deff usef)
     606(define (update-xref-macro-use source-id symbol-id deff usef)
    600607  ; Macro definition
    601608  (when deff
    602609    (sqlite3:exec (xref-statement ins-assign-entry)
    603                   source-oid symbol-oid "syntax") )
     610                  source-id symbol-id "syntax") )
    604611  ; Macro reference
    605612  (when usef
    606613    (sqlite3:exec (xref-statement ins-reference-entry)
    607                   source-oid symbol-oid "expanded") ) )
     614                  source-id symbol-id "expanded") ) )
    608615
    609616;; Update tables for single source file
     
    612619  (sqlite3:with-transaction *xref-db*
    613620    (lambda ()
    614       (let ([source-oid (ensure-entry-source srcpn)])
     621      (let ([source-id (ensure-entry-source srcpn)])
    615622        ; Macro symbols
    616623        (for-each (lambda (macuse)
    617                     (let ([symbol-oid (ensure-entry-symbol (car macuse))])
    618                       (update-xref-macro-use source-oid symbol-oid
     624                    (let ([symbol-id (ensure-entry-symbol (car macuse))])
     625                      (update-xref-macro-use source-id symbol-id
    619626                                             (cadr macuse) (caddr macuse)) ) )
    620627                  (car xrefs))
    621628        ; Variable symbols
    622629        (for-each (lambda (xref)
    623                     (let ([symbol-oid (ensure-entry-symbol (xref-symbol xref))])
    624                       (for-each (cut update-xref-use source-oid symbol-oid <>)
     630                    (let ([symbol-id (ensure-entry-symbol (xref-symbol xref))])
     631                      (for-each (cute update-xref-use source-id symbol-id <>)
    625632                                (xref-usage-list xref)) ) )
    626633                  (cdr xrefs)) )
  • release/3/source-xref/trunk/source-xref.setup

    r8021 r9959  
    22
    33(required-chicken-version "2.621")
    4 (required-extension-version 'sqlite3 "2.0.1" 'tool "0.702")
     4(required-extension-version 'tinyclos "1.5" 'sqlite3 "2.0.5" 'misc-extn "3.003")
    55
    6 #|
    76(compile -s #;-O3 #;-d0 -block -check-imports source-xref-single.scm)
    87(install-extension 'source-xref-single
    98  `("source-xref-single.so")
    109        `((version ,*version*)) )
    11 |#
    1210
    1311(compile #;-O3 #;-d0 -block -check-imports source-xref.scm -o chicken-xref)
Note: See TracChangeset for help on using the changeset viewer.