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 inspector debugger io io.styles
   5 hashtables sorting prettyprint source-files
   6 arrays combinators strings system math.parser compiler.errors
   7 splitting init ;
   8 IN: vocabs.loader
   9
  10 SYMBOL: vocab-roots
  11
  12 V{
  13     "resource:core"
  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 ] keep
  59     [ vocab-source-path [ bootstrap-file ] when* ] keep
  60     source-was-loaded ;
  61
  62 : docs-were-loaded ( vocab -- ) t swap set-vocab-docs-loaded? ;
  63
  64 : docs-weren't-loaded ( vocab -- ) f swap set-vocab-docs-loaded? ;
  65
  66 : load-docs ( vocab -- )
  67     load-help? get [
  68         [ docs-weren't-loaded ] keep
  69         [ vocab-docs-path [ ?run-file ] when* ] keep
  70         docs-were-loaded
  71     ] [ drop ] if ;
  72
  73 : reload ( name -- )
  74     [
  75         dup vocab [ dup load-source load-docs ] [ no-vocab ] ?if
  76     ] with-compiler-errors ;
  77
  78 : require ( vocab -- )
  79     load-vocab drop ;
  80
  81 : run ( vocab -- )
  82     dup load-vocab vocab-main [
  83         execute
  84     ] [
  85         "The " write vocab-name write
  86         " vocabulary does not define an entry point." print
  87         "To define one, refer to \\ MAIN: help" print
  88     ] ?if ;
  89
  90 SYMBOL: blacklist
  91
  92 : add-to-blacklist ( error vocab -- )
  93     vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
  94
  95 GENERIC: (load-vocab) ( name -- )
  96
  97 M: vocab (load-vocab)
  98     [
  99         dup vocab-source-loaded? [ dup load-source ] unless
 100         dup vocab-docs-loaded? [ dup load-docs ] unless
 101         drop
 102     ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
 103
 104 M: vocab-link (load-vocab)
 105     vocab-name create-vocab (load-vocab) ;
 106
 107 M: string (load-vocab)
 108     create-vocab (load-vocab) ;
 109
 110 [
 111     [
 112         dup vocab-name blacklist get at* [
 113             rethrow
 114         ] [
 115             drop
 116             dup find-vocab-root [
 117                 [ (load-vocab) ] with-compiler-errors
 118             ] [
 119                 dup vocab [ drop ] [ no-vocab ] if
 120             ] if
 121         ] if
 122     ] with-compiler-errors
 123 ] load-vocab-hook set-global
 124
 125 : vocab-where ( vocab -- loc )
 126     vocab-source-path dup [ 1 2array ] when ;
 127
 128 M: vocab where vocab-where ;
 129
 130 M: vocab-link where vocab-where ;