library/syntax/parse-stream.factor

   1 ! Copyright (C) 2004, 2006 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 IN: parser\r
   4 USING: arrays errors generic hashtables io kernel math\r
   5 namespaces sequences words ;\r
   6 \r
   7 SYMBOL: source-files\r
   8 \r
   9 TUPLE: source-file path modified definitions ;\r
  10 \r
  11 : source-file-modified* ( source-file -- n )\r
  12     source-file-path ?resource-path\r
  13     file-modified [ 0 ] unless* ;\r
  14 \r
  15 : record-modified ( file -- )\r
  16     dup source-file-modified* swap set-source-file-modified ;\r
  17 \r
  18 : reset-modified ( -- )\r
  19     source-files get hash-values [ record-modified ] each ;\r
  20 \r
  21 C: source-file ( path -- source-file )\r
  22     [ set-source-file-path ] keep\r
  23     V{ } clone over set-source-file-definitions\r
  24     dup record-modified ;\r
  25 \r
  26 : source-modified? ( file -- ? )\r
  27     source-files get hash [\r
  28         dup source-file-modified swap source-file-modified*\r
  29         [ < ] [ drop f ] if*\r
  30     ] [\r
  31         t\r
  32     ] if* ;\r
  33 \r
  34 : file-vocabs ( -- )\r
  35     "scratchpad" set-in { "syntax" "scratchpad" } set-use ;\r
  36 \r
  37 : with-parser ( quot -- )\r
  38     [\r
  39         [\r
  40             dup [ parse-error? ] is? [ <parse-error> ] unless\r
  41             rethrow\r
  42         ] recover\r
  43     ] with-scope ;\r
  44 \r
  45 : parse-lines ( lines -- quot )\r
  46     [\r
  47         dup length f [ 1+ line-number set (parse) ] 2reduce\r
  48         >quotation\r
  49     ] with-parser ;\r
  50 \r
  51 : parse ( str -- quot ) <string-reader> lines parse-lines ;\r
  52 \r
  53 : eval ( str -- ) parse call ;\r
  54 \r
  55 SYMBOL: parse-hook\r
  56 \r
  57 : do-parse-hook ( -- ) parse-hook get call ;\r
  58 \r
  59 : parse-stream ( stream name -- quot )\r
  60     [\r
  61         file set file-vocabs\r
  62         lines parse-lines\r
  63         do-parse-hook\r
  64     ] with-scope ;\r
  65 \r
  66 : parsing-file ( file -- )\r
  67     "Loading " write write-pathname terpri flush ;\r
  68 \r
  69 : record-file ( file -- )\r
  70     [ <source-file> ] keep source-files get set-hash ;\r
  71 \r
  72 : parse-file-restarts ( file -- restarts )\r
  73     "Load " swap " again" append3 t 2array 1array ;\r
  74 \r
  75 : parse-file ( file -- quot )\r
  76     [\r
  77         dup parsing-file dup record-file\r
  78         [ ?resource-path <file-reader> ] keep parse-stream\r
  79     ] [\r
  80         over parse-file-restarts condition drop parse-file\r
  81     ] recover ;\r
  82 \r
  83 : run-file ( file -- ) parse-file call ;\r
  84 \r
  85 : run-files ( seq -- )\r
  86     [\r
  87         bootstrapping? get\r
  88         [ parse-file % ] [ run-file ] ? each\r
  89     ] no-parse-hook ;\r
  90 \r
  91 : no-parse-hook ( quot -- )\r
  92     [ parse-hook off call ] with-scope ; inline\r
  93 \r
  94 : ?run-file ( file -- )\r
  95     dup exists? [ [ [ run-file ] keep ] try ] when drop ;\r
  96 \r
  97 : eval>string ( str -- str )\r
  98     [ [ [ eval ] keep ] try drop ] string-out ;\r