library/modules.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: modules
   4 USING: hashtables io kernel namespaces parser sequences
   5 test words strings arrays math ;
   6
   7 SYMBOL: modules
   8
   9 TUPLE: module name files tests ;
  10
  11 : module-def ( name -- path )
  12     "resource:" over ".factor" append3
  13     dup ?resource-path exists? [
  14         nip
  15     ] [
  16         drop "resource:" swap "/load.factor" append3
  17     ] if ;
  18
  19 : prefix-paths ( name seq -- newseq )
  20     [ path+ "resource:" swap append ] map-with ;
  21
  22 C: module ( name files tests -- module )
  23     [ >r >r over r> prefix-paths r> set-module-tests ] keep
  24     [ >r dupd prefix-paths r> set-module-files ] keep
  25     [ set-module-name ] keep ;
  26
  27 : module modules get assoc ;
  28
  29 : load-module ( name -- )
  30     [
  31         "Loading module " write dup write "..." print
  32         [ dup module-def run-file ] assert-depth drop
  33     ] no-parse-hook ;
  34
  35 : require ( name -- )
  36     dup module [ drop ] [ load-module ] if do-parse-hook ;
  37
  38 : process-files ( seq -- newseq )
  39     [ dup string? [ [ t ] 2array ] when ] map
  40     [ second call ] subset
  41     [ first ] map ;
  42
  43 : add-module ( module -- )
  44     dup module-name swap 2array modules get push ;
  45
  46 : remove-module ( name -- )
  47     modules get [ first = ] find-with nip
  48     [ modules get delete ] when* ;
  49
  50 : provide ( name files tests -- )
  51     pick remove-module
  52     [ process-files ] 2apply <module>
  53     [ module-files run-files ] keep
  54     add-module ;
  55
  56 : test-module ( name -- ) module module-tests run-tests ;
  57
  58 : all-modules ( -- seq ) modules get [ second ] map ;
  59
  60 : all-module-names ( -- seq ) modules get [ first ] map ;
  61
  62 : test-modules ( -- )
  63     all-modules [ module-tests ] map concat run-tests ;
  64
  65 : modules. ( -- )
  66     all-module-names natural-sort [ print ] each ;
  67
  68 : reload-module ( module -- )
  69     dup module-name module-def source-modified? [
  70         module-name load-module
  71     ] [
  72         module-files [ source-modified? ] subset run-files
  73     ] if ;
  74
  75 : reload-modules ( -- )
  76     all-modules [ reload-module ] each do-parse-hook ;