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 : run-files ( seq -- )
  39     [
  40         bootstrapping? get
  41         [ parse-file % ] [ run-file ] ? each
  42     ] no-parse-hook ;
  43
  44 : process-files ( seq -- newseq )
  45     [ dup string? [ [ t ] 2array ] when ] map
  46     [ second call ] subset
  47     [ first ] map ;
  48
  49 : add-module ( module -- )
  50     dup module-name swap 2array modules get push ;
  51
  52 : remove-module ( name -- )
  53     modules get [ first = ] find-with nip
  54     [ modules get delete ] when* ;
  55
  56 : provide ( name files tests -- )
  57     pick remove-module
  58     [ process-files ] 2apply <module>
  59     [ module-files run-files ] keep
  60     add-module ;
  61
  62 : test-module ( name -- ) module module-tests run-tests ;
  63
  64 : all-modules ( -- seq ) modules get [ second ] map ;
  65
  66 : all-module-names ( -- seq ) modules get [ first ] map ;
  67
  68 : test-modules ( -- )
  69     all-modules [ module-tests ] map concat run-tests ;
  70
  71 : modules. ( -- )
  72     all-module-names natural-sort [ print ] each ;
  73
  74 : reload-module ( module -- )
  75     dup module-name module-def source-modified? [
  76         module-name load-module
  77     ] [
  78         module-files [ source-modified? ] subset run-files
  79     ] if ;
  80
  81 : reload-modules ( -- )
  82     all-modules [ reload-module ] each do-parse-hook ;