basis/tools/deprecation/deprecation.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs combinators.short-circuit
   4 compiler.units debugger init io io.streams.null kernel
   5 namespaces prettyprint sequences sets source-files.errors
   6 summary tools.crossref tools.crossref.private tools.errors
   7 words ;
   8 IN: tools.deprecation
   9
  10 SYMBOL: +deprecation-note+
  11 SYMBOL: deprecation-notes
  12
  13 deprecation-notes [ H{ } clone ] initialize
  14
  15 TUPLE: deprecation-note < source-file-error ;
  16
  17 M: deprecation-note error-type drop +deprecation-note+ ;
  18
  19 TUPLE: deprecated-usages asset usages ;
  20
  21 : :deprecations ( -- )
  22     deprecation-notes get-global values errors. ;
  23
  24 T{ error-type-holder
  25     { type +deprecation-note+ }
  26     { word ":deprecations" }
  27     { plural "deprecated word usages" }
  28     { icon "vocab:ui/tools/error-list/icons/deprecation-note.png" }
  29     { quot [ deprecation-notes get values ] }
  30     { forget-quot [ deprecation-notes get delete-at ] }
  31     { fatal? f }
  32 } define-error-type
  33
  34 : <deprecation-note> ( error word -- deprecation-note )
  35     deprecation-note new-source-file-error ;
  36
  37 : store-deprecation-note ( word usages -- )
  38     over [ deprecated-usages boa ] dip
  39     [ <deprecation-note> ]
  40     [ deprecation-notes get-global set-at ] bi ;
  41
  42 : clear-deprecation-note ( word -- )
  43     deprecation-notes get-global delete-at ;
  44
  45 : check-deprecations ( usage -- )
  46     dup word? [
  47         dup { [ "forgotten" word-prop ] [ deprecated? ] } 1||
  48         [ clear-deprecation-note ] [
  49             dup def>> uses [ deprecated? ] filter
  50             [ clear-deprecation-note ]
  51             [ store-deprecation-note ] if-empty
  52         ] if
  53     ] [ drop ] if ;
  54
  55 M: deprecated-usages summary
  56     drop "Deprecated words used" ;
  57
  58 M: deprecated-usages error.
  59     "The definition of " write
  60     dup asset>> pprint
  61     " uses these deprecated words:" write nl
  62     usages>> [ "    " write pprint nl ] each ;
  63
  64 SINGLETON: deprecation-observer
  65
  66 : initialize-deprecation-notes ( -- )
  67     [
  68         get-crossref [ drop deprecated? ] assoc-filter
  69         values [ members [ check-deprecations ] each ] each
  70     ] with-null-writer ;
  71
  72 M: deprecation-observer definitions-changed
  73     drop filter-word-defs
  74     dup [ deprecated? ] none?
  75     [ [ check-deprecations ] each ]
  76     [ drop initialize-deprecation-notes ] if ;
  77
  78 [ deprecation-observer add-definition-observer ]
  79 "tools.deprecation" add-startup-hook
  80
  81 initialize-deprecation-notes