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 sequences io.files kernel assocs words vocabs
   4 definitions parser continuations io io.styles hashtables sorting
   5 source-files arrays combinators strings system math.parser
   6 compiler.errors splitting init ;
   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 : vocab-dir ( vocab -- dir )
  19     vocab-name { { CHAR: . CHAR: / } } substitute ;
  20
  21 : vocab-dir+ ( vocab str/f -- path )
  22     >r vocab-name "." split r>
  23     [ >r dup peek r> append suffix ] when*
  24     "/" join ;
  25
  26 : vocab-dir? ( root name -- ? )
  27     over [
  28         ".factor" vocab-dir+ append-path exists?
  29     ] [
  30         2drop f
  31     ] if ;
  32
  33 SYMBOL: root-cache
  34
  35 H{ } clone root-cache set-global
  36
  37 : find-vocab-root ( vocab -- path/f )
  38     vocab-name root-cache get [
  39         vocab-roots get swap [ vocab-dir? ] curry find nip
  40     ] cache ;
  41
  42 : vocab-append-path ( vocab path -- newpath )
  43     swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
  44
  45 : vocab-source-path ( vocab -- path/f )
  46     dup ".factor" vocab-dir+ vocab-append-path ;
  47
  48 : vocab-docs-path ( vocab -- path/f )
  49     dup "-docs.factor" vocab-dir+ vocab-append-path ;
  50
  51 SYMBOL: load-help?
  52
  53 : source-was-loaded ( vocab -- ) t swap set-vocab-source-loaded? ;
  54
  55 : source-wasn't-loaded ( vocab -- ) f swap set-vocab-source-loaded? ;
  56
  57 : load-source ( vocab -- )
  58     [ source-wasn't-loaded ]
  59     [ vocab-source-path [ parse-file ] [ [ ] ] if* ]
  60     [ source-was-loaded ]
  61     tri
  62     [ % ] [ call ] if-bootstrapping ;
  63
  64 : docs-were-loaded ( vocab -- ) t swap set-vocab-docs-loaded? ;
  65
  66 : docs-weren't-loaded ( vocab -- ) f swap set-vocab-docs-loaded? ;
  67
  68 : load-docs ( vocab -- )
  69     load-help? get [
  70         [ docs-weren't-loaded ]
  71         [ vocab-docs-path [ ?run-file ] when* ]
  72         [ docs-were-loaded ]
  73         tri
  74     ] [ drop ] if ;
  75
  76 : reload ( name -- )
  77     [
  78         dup vocab [ dup load-source load-docs ] [ no-vocab ] ?if
  79     ] with-compiler-errors ;
  80
  81 : require ( vocab -- )
  82     load-vocab drop ;
  83
  84 : run ( vocab -- )
  85     dup load-vocab vocab-main [
  86         execute
  87     ] [
  88         "The " write vocab-name write
  89         " vocabulary does not define an entry point." print
  90         "To define one, refer to \\ MAIN: help" print
  91     ] ?if ;
  92
  93 SYMBOL: blacklist
  94
  95 : add-to-blacklist ( error vocab -- )
  96     vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
  97
  98 GENERIC: (load-vocab) ( name -- )
  99
 100 M: vocab (load-vocab)
 101     [
 102         dup vocab-source-loaded? [ dup load-source ] unless
 103         dup vocab-docs-loaded? [ dup load-docs ] unless
 104         drop
 105     ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
 106
 107 M: vocab-link (load-vocab)
 108     vocab-name create-vocab (load-vocab) ;
 109
 110 M: string (load-vocab)
 111     create-vocab (load-vocab) ;
 112
 113 [
 114     [
 115         dup vocab-name blacklist get at* [
 116             rethrow
 117         ] [
 118             drop
 119             dup find-vocab-root [
 120                 [ (load-vocab) ] with-compiler-errors
 121             ] [
 122                 dup vocab [ drop ] [ no-vocab ] if
 123             ] if
 124         ] if
 125     ] with-compiler-errors
 126 ] load-vocab-hook set-global
 127
 128 : vocab-where ( vocab -- loc )
 129     vocab-source-path dup [ 1 2array ] when ;
 130
 131 M: vocab where vocab-where ;
 132
 133 M: vocab-link where vocab-where ;