core/vocabs/loader/loader.factor

   1 ! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces make sequences io.files kernel assocs words
   4 vocabs definitions parser continuations io hashtables sorting
   5 source-files arrays combinators strings system math.parser
   6 compiler.errors splitting init accessors sets ;
   7 IN: vocabs.loader
   8
   9 SYMBOL: vocab-roots
  10
  11 V{
  12     "resource:core"
  13     "resource:basis"
  14     "resource:extra"
  15     "resource:work"
  16 } clone vocab-roots set-global
  17
  18 : add-vocab-root ( root -- )
  19     vocab-roots get adjoin ;
  20
  21 : vocab-dir ( vocab -- dir )
  22     vocab-name { { CHAR: . CHAR: / } } substitute ;
  23
  24 : vocab-dir+ ( vocab str/f -- path )
  25     [ vocab-name "." split ] dip
  26     [ [ dup peek ] dip append suffix ] when*
  27     "/" join ;
  28
  29 : vocab-dir? ( root name -- ? )
  30     over
  31     [ ".factor" vocab-dir+ append-path exists? ]
  32     [ 2drop f ]
  33     if ;
  34
  35 SYMBOL: root-cache
  36
  37 H{ } clone root-cache set-global
  38
  39 <PRIVATE
  40
  41 : (find-vocab-root) ( name -- path/f )
  42     vocab-roots get swap [ vocab-dir? ] curry find nip ;
  43
  44 PRIVATE>
  45
  46 : find-vocab-root ( vocab -- path/f )
  47     vocab-name dup root-cache get at [ ] [ (find-vocab-root) ] ?if ;
  48
  49 : vocab-append-path ( vocab path -- newpath )
  50     swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
  51
  52 : vocab-source-path ( vocab -- path/f )
  53     dup ".factor" vocab-dir+ vocab-append-path ;
  54
  55 : vocab-docs-path ( vocab -- path/f )
  56     dup "-docs.factor" vocab-dir+ vocab-append-path ;
  57
  58 SYMBOL: load-help?
  59
  60 ERROR: circular-dependency name ;
  61
  62 <PRIVATE
  63
  64 : load-source ( vocab -- )
  65     [
  66         +parsing+ >>source-loaded?
  67         dup vocab-source-path [ parse-file ] [ [ ] ] if*
  68         [ +parsing+ >>source-loaded? ] dip
  69         [ % ] [ assert-depth ] if-bootstrapping
  70         +done+ >>source-loaded? drop
  71     ] [ ] [ f >>source-loaded? ] cleanup ;
  72
  73 : load-docs ( vocab -- )
  74     load-help? get [
  75         [
  76             +parsing+ >>docs-loaded?
  77             [ vocab-docs-path [ ?run-file ] when* ] keep
  78             +done+ >>docs-loaded?
  79         ] [ ] [ f >>docs-loaded? ] cleanup
  80     ] when drop ;
  81
  82 PRIVATE>
  83
  84 : require ( vocab -- )
  85     [ load-vocab drop ] with-compiler-errors ;
  86
  87 : reload ( name -- )
  88     dup vocab
  89     [ [ [ load-source ] [ load-docs ] bi ] with-compiler-errors ]
  90     [ require ]
  91     ?if ;
  92
  93 : run ( vocab -- )
  94     dup load-vocab vocab-main [
  95         execute
  96     ] [
  97         "The " write vocab-name write
  98         " vocabulary does not define an entry point." print
  99         "To define one, refer to \\ MAIN: help" print
 100     ] ?if ;
 101
 102 SYMBOL: blacklist
 103
 104 <PRIVATE
 105
 106 : add-to-blacklist ( error vocab -- )
 107     vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
 108
 109 GENERIC: (load-vocab) ( name -- )
 110
 111 M: vocab (load-vocab)
 112     [
 113         dup source-loaded?>> +parsing+ eq? [
 114             dup source-loaded?>> [ dup load-source ] unless
 115             dup docs-loaded?>> [ dup load-docs ] unless
 116         ] unless drop
 117     ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
 118
 119 M: vocab-link (load-vocab)
 120     vocab-name create-vocab (load-vocab) ;
 121
 122 M: string (load-vocab)
 123     create-vocab (load-vocab) ;
 124
 125 [
 126     [
 127         dup vocab-name blacklist get at* [ rethrow ] [
 128             drop dup find-vocab-root
 129             [ [ (load-vocab) ] with-compiler-errors ]
 130             [ dup vocab [ drop ] [ no-vocab ] if ]
 131             if
 132         ] if
 133     ] with-compiler-errors
 134 ] load-vocab-hook set-global
 135
 136 PRIVATE>
 137
 138 : vocab-where ( vocab -- loc )
 139     vocab-source-path dup [ 1 2array ] when ;
 140
 141 M: vocab where vocab-where ;
 142
 143 M: vocab-link where vocab-where ;