From 839933664880165f6f9f5354ada42e72616992ac Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 12 Mar 2008 19:55:06 -0500
Subject: [PATCH 01/38] tools.vocabs absorbs some words from tools.browser and
vocabs.loader
---
core/vocabs/loader/loader-docs.factor | 14 +-
core/vocabs/loader/loader.factor | 61 ---
extra/benchmark/benchmark.factor | 2 +-
extra/bootstrap/tools/tools.factor | 1 +
extra/editors/editors.factor | 2 +-
extra/help/handbook/handbook.factor | 1 +
extra/help/lint/lint.factor | 2 +-
extra/help/topics/topics.factor | 4 +
extra/io/unix/unix.factor | 2 +-
extra/io/windows/nt/nt.factor | 2 +-
extra/tools/browser/browser-tests.factor | 4 -
extra/tools/browser/browser.factor | 364 ------------------
extra/tools/{ => vocabs}/browser/authors.txt | 0
.../tools/vocabs/browser/browser-docs.factor | 7 +
.../tools/vocabs/browser/browser-tests.factor | 4 +
extra/tools/vocabs/browser/browser.factor | 207 ++++++++++
extra/tools/{ => vocabs}/browser/tags.txt | 0
extra/{ => tools}/vocabs/monitor/authors.txt | 0
.../{ => tools}/vocabs/monitor/monitor.factor | 6 +-
extra/{ => tools}/vocabs/monitor/summary.txt | 0
.../vocabs-docs.factor} | 115 +++---
extra/tools/vocabs/vocabs.factor | 232 +++++++++++
extra/ui/tools/operations/operations.factor | 8 +-
extra/ui/tools/search/search.factor | 2 +-
24 files changed, 531 insertions(+), 509 deletions(-)
mode change 100644 => 100755 extra/help/lint/lint.factor
mode change 100644 => 100755 extra/help/topics/topics.factor
delete mode 100755 extra/tools/browser/browser-tests.factor
delete mode 100755 extra/tools/browser/browser.factor
rename extra/tools/{ => vocabs}/browser/authors.txt (100%)
create mode 100755 extra/tools/vocabs/browser/browser-docs.factor
create mode 100755 extra/tools/vocabs/browser/browser-tests.factor
create mode 100755 extra/tools/vocabs/browser/browser.factor
rename extra/tools/{ => vocabs}/browser/tags.txt (100%)
rename extra/{ => tools}/vocabs/monitor/authors.txt (100%)
rename extra/{ => tools}/vocabs/monitor/monitor.factor (79%)
rename extra/{ => tools}/vocabs/monitor/summary.txt (100%)
rename extra/tools/{browser/browser-docs.factor => vocabs/vocabs-docs.factor} (73%)
create mode 100755 extra/tools/vocabs/vocabs.factor
diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor
index 9f7b2b5b9f..886e678330 100755
--- a/core/vocabs/loader/loader-docs.factor
+++ b/core/vocabs/loader/loader-docs.factor
@@ -23,9 +23,6 @@ $nl
"Application vocabularies can define a main entry point, giving the user a convenient way to run the application:"
{ $subsection POSTPONE: MAIN: }
{ $subsection run }
-"Reloading source files changed on disk:"
-{ $subsection refresh }
-{ $subsection refresh-all }
{ $see-also "vocabularies" "parser-files" "source-files" } ;
ABOUT: "vocabs.loader"
@@ -80,7 +77,7 @@ HELP: reload
HELP: require
{ $values { "vocab" "a vocabulary specifier" } }
{ $description "Loads a vocabulary if it has not already been loaded." }
-{ $notes "To unconditionally reload a vocabulary, use " { $link reload } ". To reload changed source files, use " { $link refresh } " or " { $link refresh-all } "." } ;
+{ $notes "To unconditionally reload a vocabulary, use " { $link reload } ". To reload changed source files only, use the words in " { $link "tools.vocabs" } "." } ;
HELP: run
{ $values { "vocab" "a vocabulary specifier" } }
@@ -93,12 +90,3 @@ HELP: vocab-source-path
HELP: vocab-docs-path
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string or " { $link f } } }
{ $description "Outputs a pathname where the documentation for " { $snippet "vocab" } " might be found. Outputs " { $link f } " if the vocabulary does not have a directory on disk." } ;
-
-HELP: refresh
-{ $values { "prefix" string } }
-{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
-
-HELP: refresh-all
-{ $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
-
-{ refresh refresh-all } related-words
diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 885bccddd1..430aa066a8 100755
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -119,68 +119,7 @@ SYMBOL: load-help?
"To define one, refer to \\ MAIN: help" print
] ?if ;
-: modified ( seq quot -- seq )
- [ dup ] swap compose { } map>assoc
- [ nip ] assoc-subset
- [ nip source-modified? ] assoc-subset keys ; inline
-
-: modified-sources ( vocabs -- seq )
- [ vocab-source-path ] modified ;
-
-: modified-docs ( vocabs -- seq )
- [ vocab-docs-path ] modified ;
-
-: update-roots ( vocabs -- )
- [ dup find-vocab-root swap vocab set-vocab-root ] each ;
-
-: to-refresh ( prefix -- modified-sources modified-docs )
- child-vocabs
- dup update-roots
- dup modified-sources swap modified-docs ;
-
-: vocab-heading. ( vocab -- )
- nl
- "==== " write
- dup vocab-name swap vocab write-object ":" print
- nl ;
-
-: load-error. ( triple -- )
- dup first vocab-heading.
- dup second print-error
- drop ;
-
-: load-failures. ( failures -- )
- [ load-error. nl ] each ;
-
SYMBOL: blacklist
-SYMBOL: failures
-
-: require-all ( vocabs -- failures )
- [
- V{ } clone blacklist set
- V{ } clone failures set
- [
- [ require ]
- [ swap vocab-name failures get set-at ]
- recover
- ] each
- failures get
- ] with-compiler-errors ;
-
-: do-refresh ( modified-sources modified-docs -- )
- 2dup
- [ f swap set-vocab-docs-loaded? ] each
- [ f swap set-vocab-source-loaded? ] each
- append prune require-all load-failures. ;
-
-: refresh ( prefix -- ) to-refresh do-refresh ;
-
-SYMBOL: sources-changed?
-
-[ t sources-changed? set-global ] "vocabs.loader" add-init-hook
-
-: refresh-all ( -- )
- "" refresh f sources-changed? set-global ;
GENERIC: (load-vocab) ( name -- vocab )
diff --git a/extra/benchmark/benchmark.factor b/extra/benchmark/benchmark.factor
index 231c6edf50..7eb5f10276 100755
--- a/extra/benchmark/benchmark.factor
+++ b/extra/benchmark/benchmark.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel vocabs vocabs.loader tools.time tools.browser
+USING: kernel vocabs vocabs.loader tools.time tools.vocabs
arrays assocs io.styles io help.markup prettyprint sequences
continuations debugger ;
IN: benchmark
diff --git a/extra/bootstrap/tools/tools.factor b/extra/bootstrap/tools/tools.factor
index 718f73308c..f395a903c3 100755
--- a/extra/bootstrap/tools/tools.factor
+++ b/extra/bootstrap/tools/tools.factor
@@ -11,5 +11,6 @@ USING: vocabs.loader sequences ;
"tools.test"
"tools.time"
"tools.threads"
+ "tools.vocabs"
"editors"
} [ require ] each
diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor
index 3b65466225..bb3fd05400 100755
--- a/extra/editors/editors.factor
+++ b/extra/editors/editors.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel namespaces sequences definitions io.files
-inspector continuations tuples tools.crossref tools.browser
+inspector continuations tuples tools.crossref tools.vocabs
io prettyprint source-files assocs vocabs vocabs.loader ;
IN: editors
diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor
index d77cc9268d..1310b58133 100755
--- a/extra/help/handbook/handbook.factor
+++ b/extra/help/handbook/handbook.factor
@@ -196,6 +196,7 @@ ARTICLE: "io" "Input and output"
{ $subsection "io.timeouts" } ;
ARTICLE: "tools" "Developer tools"
+{ $subsection "tools.vocabs" }
"Exploratory tools:"
{ $subsection "editor" }
{ $subsection "tools.crossref" }
diff --git a/extra/help/lint/lint.factor b/extra/help/lint/lint.factor
old mode 100644
new mode 100755
index 22a1945b24..d8a4f83169
--- a/extra/help/lint/lint.factor
+++ b/extra/help/lint/lint.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences parser kernel help help.markup help.topics
-words strings classes tools.browser namespaces io
+words strings classes tools.vocabs namespaces io
io.streams.string prettyprint definitions arrays vectors
combinators splitting debugger hashtables sorting effects vocabs
vocabs.loader assocs editors continuations classes.predicate
diff --git a/extra/help/topics/topics.factor b/extra/help/topics/topics.factor
old mode 100644
new mode 100755
index c5abc195cf..4a86d49a28
--- a/extra/help/topics/topics.factor
+++ b/extra/help/topics/topics.factor
@@ -7,6 +7,10 @@ IN: help.topics
TUPLE: link name ;
+MIXIN: topic
+INSTANCE: link topic
+INSTANCE: word topic
+
GENERIC: >link ( obj -- obj )
M: link >link ;
M: vocab-spec >link ;
diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor
index 64e2cc3c3d..01e29866eb 100755
--- a/extra/io/unix/unix.factor
+++ b/extra/io/unix/unix.factor
@@ -4,4 +4,4 @@ combinators namespaces system vocabs.loader sequences ;
"io.unix." os append require
-"vocabs.monitor" require
+"tools.vocabs.monitor" require
diff --git a/extra/io/windows/nt/nt.factor b/extra/io/windows/nt/nt.factor
index 9bc587e00e..319acc35f8 100755
--- a/extra/io/windows/nt/nt.factor
+++ b/extra/io/windows/nt/nt.factor
@@ -14,4 +14,4 @@ USE: io.backend
T{ windows-nt-io } set-io-backend
-"vocabs.monitor" require
+"tools.vocabs.monitor" require
diff --git a/extra/tools/browser/browser-tests.factor b/extra/tools/browser/browser-tests.factor
deleted file mode 100755
index 38d9ae65e2..0000000000
--- a/extra/tools/browser/browser-tests.factor
+++ /dev/null
@@ -1,4 +0,0 @@
-IN: tools.browser.tests
-USING: tools.browser tools.test help.markup ;
-
-[ ] [ { $describe-vocab "scratchpad" } print-content ] unit-test
diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor
deleted file mode 100755
index c189a6f9de..0000000000
--- a/extra/tools/browser/browser.factor
+++ /dev/null
@@ -1,364 +0,0 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces splitting sequences io.files kernel assocs
-words vocabs vocabs.loader definitions parser continuations
-inspector debugger io io.styles hashtables
-sorting prettyprint source-files arrays combinators strings
-system math.parser help.markup help.topics help.syntax
-help.stylesheet memoize io.encodings.utf8 ;
-IN: tools.browser
-
-MEMO: (vocab-file-contents) ( path -- lines )
- ?resource-path dup exists?
- [ utf8 file-lines ] [ drop f ] if ;
-
-: vocab-file-contents ( vocab name -- seq )
- vocab-path+ dup [ (vocab-file-contents) ] when ;
-
-: set-vocab-file-contents ( seq vocab name -- )
- dupd vocab-path+ [
- ?resource-path utf8 set-file-lines
- ] [
- "The " swap vocab-name
- " vocabulary was not loaded from the file system"
- 3append throw
- ] ?if ;
-
-: vocab-summary-path ( vocab -- string )
- vocab-dir "summary.txt" path+ ;
-
-: vocab-summary ( vocab -- summary )
- dup dup vocab-summary-path vocab-file-contents
- dup empty? [
- drop vocab-name " vocabulary" append
- ] [
- nip first
- ] if ;
-
-M: vocab summary
- [
- dup vocab-summary %
- " (" %
- vocab-words assoc-size #
- " words)" %
- ] "" make ;
-
-M: vocab-link summary vocab-summary ;
-
-: set-vocab-summary ( string vocab -- )
- >r 1array r>
- dup vocab-summary-path
- set-vocab-file-contents ;
-
-: vocab-tags-path ( vocab -- string )
- vocab-dir "tags.txt" path+ ;
-
-: vocab-tags ( vocab -- tags )
- dup vocab-tags-path vocab-file-contents ;
-
-: set-vocab-tags ( tags vocab -- )
- dup vocab-tags-path set-vocab-file-contents ;
-
-: add-vocab-tags ( tags vocab -- )
- [ vocab-tags append prune ] keep set-vocab-tags ;
-
-: vocab-authors-path ( vocab -- string )
- vocab-dir "authors.txt" path+ ;
-
-: vocab-authors ( vocab -- authors )
- dup vocab-authors-path vocab-file-contents ;
-
-: set-vocab-authors ( authors vocab -- )
- dup vocab-authors-path set-vocab-file-contents ;
-
-: subdirs ( dir -- dirs )
- directory [ second ] subset keys natural-sort ;
-
-: (all-child-vocabs) ( root name -- vocabs )
- [ vocab-dir path+ ?resource-path subdirs ] keep
- dup empty? [
- drop
- ] [
- swap [ "." swap 3append ] with map
- ] if ;
-
-: vocabs-in-dir ( root name -- )
- dupd (all-child-vocabs) [
- 2dup vocab-dir? [ 2dup swap >vocab-link , ] when
- vocabs-in-dir
- ] with each ;
-
-: all-vocabs ( -- assoc )
- vocab-roots get [
- dup [ "" vocabs-in-dir ] { } make
- ] { } map>assoc ;
-
-MEMO: all-vocabs-seq ( -- seq )
- all-vocabs values concat ;
-
-: dangerous? ( name -- ? )
- #! Hack
- {
- { [ "cpu." ?head ] [ t ] }
- { [ "io.unix" ?head ] [ t ] }
- { [ "io.windows" ?head ] [ t ] }
- { [ "ui.x11" ?head ] [ t ] }
- { [ "ui.windows" ?head ] [ t ] }
- { [ "ui.cocoa" ?head ] [ t ] }
- { [ "cocoa" ?head ] [ t ] }
- { [ "core-foundation" ?head ] [ t ] }
- { [ "vocabs.loader.test" ?head ] [ t ] }
- { [ "editors." ?head ] [ t ] }
- { [ ".windows" ?tail ] [ t ] }
- { [ ".unix" ?tail ] [ t ] }
- { [ "unix." ?head ] [ t ] }
- { [ ".linux" ?tail ] [ t ] }
- { [ ".bsd" ?tail ] [ t ] }
- { [ ".macosx" ?tail ] [ t ] }
- { [ "windows." ?head ] [ t ] }
- { [ "cocoa" ?head ] [ t ] }
- { [ ".test" ?tail ] [ t ] }
- { [ "raptor" ?head ] [ t ] }
- { [ dup "tools.deploy.app" = ] [ t ] }
- { [ t ] [ f ] }
- } cond nip ;
-
-: filter-dangerous ( seq -- seq' )
- [ vocab-name dangerous? not ] subset ;
-
-: try-everything ( -- failures )
- all-vocabs-seq
- filter-dangerous
- require-all ;
-
-: load-everything ( -- )
- try-everything load-failures. ;
-
-: unrooted-child-vocabs ( prefix -- seq )
- dup empty? [ CHAR: . add ] unless
- vocabs
- [ vocab-root not ] subset
- [
- vocab-name swap ?head CHAR: . rot member? not and
- ] with subset
- [ vocab ] map ;
-
-: all-child-vocabs ( prefix -- assoc )
- vocab-roots get [
- over dupd dupd (all-child-vocabs)
- swap [ >vocab-link ] curry map
- ] { } map>assoc
- f rot unrooted-child-vocabs 2array add ;
-
-: load-children ( prefix -- )
- all-child-vocabs values concat
- filter-dangerous
- require-all
- load-failures. ;
-
-: vocab-status-string ( vocab -- string )
- {
- { [ dup not ] [ drop "" ] }
- { [ dup vocab-main ] [ drop "[Runnable]" ] }
- { [ t ] [ drop "[Loaded]" ] }
- } cond ;
-
-: write-status ( vocab -- )
- vocab vocab-status-string write ;
-
-: vocab. ( vocab -- )
- [
- dup [ write-status ] with-cell
- dup [ ($link) ] with-cell
- [ vocab-summary write ] with-cell
- ] with-row ;
-
-: vocab-headings. ( -- )
- [
- [ "State" write ] with-cell
- [ "Vocabulary" write ] with-cell
- [ "Summary" write ] with-cell
- ] with-row ;
-
-: root-heading. ( root -- )
- [ "Children from " swap append ] [ "Children" ] if*
- $heading ;
-
-: vocabs. ( assoc -- )
- [
- dup empty? [
- 2drop
- ] [
- swap root-heading.
- standard-table-style [
- vocab-headings. [ vocab. ] each
- ] ($grid)
- ] if
- ] assoc-each ;
-
-: describe-summary ( vocab -- )
- vocab-summary [
- "Summary" $heading print-element
- ] when* ;
-
-TUPLE: vocab-tag name ;
-
-C: <vocab-tag> vocab-tag
-
-: tags. ( seq -- ) [ <vocab-tag> ] map $links ;
-
-: describe-tags ( vocab -- )
- vocab-tags f like [
- "Tags" $heading tags.
- ] when* ;
-
-TUPLE: vocab-author name ;
-
-C: <vocab-author> vocab-author
-
-: authors. ( seq -- ) [ <vocab-author> ] map $links ;
-
-: describe-authors ( vocab -- )
- vocab-authors f like [
- "Authors" $heading authors.
- ] when* ;
-
-: describe-help ( vocab -- )
- vocab-help [
- "Documentation" $heading nl ($link)
- ] when* ;
-
-: describe-children ( vocab -- )
- vocab-name all-child-vocabs vocabs. ;
-
-: describe-files ( vocab -- )
- vocab-files [ <pathname> ] map [
- "Files" $heading
- [
- snippet-style get [
- code-style get [
- stack.
- ] with-nesting
- ] with-style
- ] ($block)
- ] when* ;
-
-: describe-words ( vocab -- )
- words dup empty? [
- "Words" $heading
- dup natural-sort $links
- ] unless drop ;
-
-: map>set ( seq quot -- )
- map concat prune natural-sort ; inline
-
-: vocab-xref ( vocab quot -- vocabs )
- >r dup vocab-name swap words r> map
- [ [ word? ] subset [ word-vocabulary ] map ] map>set
- remove [ ] subset [ vocab ] map ; inline
-
-: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
-
-: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
-
-: describe-uses ( vocab -- )
- vocab-uses dup empty? [
- "Uses" $heading
- dup $links
- ] unless drop ;
-
-: describe-usage ( vocab -- )
- vocab-usage dup empty? [
- "Used by" $heading
- dup $links
- ] unless drop ;
-
-: $describe-vocab ( element -- )
- first
- dup describe-children
- dup vocab-root over vocab-dir? [
- dup describe-summary
- dup describe-tags
- dup describe-authors
- dup describe-files
- ] when
- dup vocab [
- dup describe-help
- dup describe-words
- dup describe-uses
- dup describe-usage
- ] when drop ;
-
-: keyed-vocabs ( str quot -- seq )
- all-vocabs [
- swap >r
- [ >r 2dup r> swap call member? ] subset
- r> swap
- ] assoc-map 2nip ; inline
-
-: tagged ( tag -- assoc )
- [ vocab-tags ] keyed-vocabs ;
-
-: authored ( author -- assoc )
- [ vocab-authors ] keyed-vocabs ;
-
-: $tagged-vocabs ( element -- )
- first tagged vocabs. ;
-
-MEMO: all-tags ( -- seq )
- all-vocabs-seq [ vocab-tags ] map>set ;
-
-: $authored-vocabs ( element -- )
- first authored vocabs. ;
-
-MEMO: all-authors ( -- seq )
- all-vocabs-seq [ vocab-authors ] map>set ;
-
-: $tags ( element -- )
- drop "Tags" $heading all-tags tags. ;
-
-: $authors ( element -- )
- drop "Authors" $heading all-authors authors. ;
-
-M: vocab-spec article-title vocab-name " vocabulary" append ;
-
-M: vocab-spec article-name vocab-name ;
-
-M: vocab-spec article-content
- vocab-name \ $describe-vocab swap 2array ;
-
-M: vocab-spec article-parent drop "vocab-index" ;
-
-M: vocab-tag >link ;
-
-M: vocab-tag article-title
- vocab-tag-name "Vocabularies tagged ``" swap "''" 3append ;
-
-M: vocab-tag article-name vocab-tag-name ;
-
-M: vocab-tag article-content
- \ $tagged-vocabs swap vocab-tag-name 2array ;
-
-M: vocab-tag article-parent drop "vocab-index" ;
-
-M: vocab-tag summary article-title ;
-
-M: vocab-author >link ;
-
-M: vocab-author article-title
- vocab-author-name "Vocabularies by " swap append ;
-
-M: vocab-author article-name vocab-author-name ;
-
-M: vocab-author article-content
- \ $authored-vocabs swap vocab-author-name 2array ;
-
-M: vocab-author article-parent drop "vocab-index" ;
-
-M: vocab-author summary article-title ;
-
-: reset-cache ( -- )
- \ (vocab-file-contents) reset-memoized
- \ all-vocabs-seq reset-memoized
- \ all-authors reset-memoized
- \ all-tags reset-memoized ;
diff --git a/extra/tools/browser/authors.txt b/extra/tools/vocabs/browser/authors.txt
similarity index 100%
rename from extra/tools/browser/authors.txt
rename to extra/tools/vocabs/browser/authors.txt
diff --git a/extra/tools/vocabs/browser/browser-docs.factor b/extra/tools/vocabs/browser/browser-docs.factor
new file mode 100755
index 0000000000..3765efb863
--- /dev/null
+++ b/extra/tools/vocabs/browser/browser-docs.factor
@@ -0,0 +1,7 @@
+USING: help.markup help.syntax io strings ;
+IN: tools.vocabs.browser
+
+ARTICLE: "vocab-index" "Vocabulary index"
+{ $tags }
+{ $authors }
+{ $describe-vocab "" } ;
diff --git a/extra/tools/vocabs/browser/browser-tests.factor b/extra/tools/vocabs/browser/browser-tests.factor
new file mode 100755
index 0000000000..7e12a56cf2
--- /dev/null
+++ b/extra/tools/vocabs/browser/browser-tests.factor
@@ -0,0 +1,4 @@
+IN: tools.vocabs.browser.tests
+USING: tools.vocabs.browser tools.test help.markup ;
+
+[ ] [ { $describe-vocab "scratchpad" } print-content ] unit-test
diff --git a/extra/tools/vocabs/browser/browser.factor b/extra/tools/vocabs/browser/browser.factor
new file mode 100755
index 0000000000..2c66305d47
--- /dev/null
+++ b/extra/tools/vocabs/browser/browser.factor
@@ -0,0 +1,207 @@
+! Copyright (C) 2007, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel combinators vocabs vocabs.loader tools.vocabs io
+io.files io.styles help.markup help.stylesheet sequences assocs
+help.topics namespaces prettyprint words sorting definitions
+arrays inspector ;
+IN: tools.vocabs.browser
+
+: vocab-status-string ( vocab -- string )
+ {
+ { [ dup not ] [ drop "" ] }
+ { [ dup vocab-main ] [ drop "[Runnable]" ] }
+ { [ t ] [ drop "[Loaded]" ] }
+ } cond ;
+
+: write-status ( vocab -- )
+ vocab vocab-status-string write ;
+
+: vocab. ( vocab -- )
+ [
+ dup [ write-status ] with-cell
+ dup [ ($link) ] with-cell
+ [ vocab-summary write ] with-cell
+ ] with-row ;
+
+: vocab-headings. ( -- )
+ [
+ [ "State" write ] with-cell
+ [ "Vocabulary" write ] with-cell
+ [ "Summary" write ] with-cell
+ ] with-row ;
+
+: root-heading. ( root -- )
+ [ "Children from " swap append ] [ "Children" ] if*
+ $heading ;
+
+: vocabs. ( assoc -- )
+ [
+ dup empty? [
+ 2drop
+ ] [
+ swap root-heading.
+ standard-table-style [
+ vocab-headings. [ vocab. ] each
+ ] ($grid)
+ ] if
+ ] assoc-each ;
+
+: describe-summary ( vocab -- )
+ vocab-summary [
+ "Summary" $heading print-element
+ ] when* ;
+
+TUPLE: vocab-tag name ;
+
+INSTANCE: vocab-tag topic
+
+C: <vocab-tag> vocab-tag
+
+: tags. ( seq -- ) [ <vocab-tag> ] map $links ;
+
+: describe-tags ( vocab -- )
+ vocab-tags f like [
+ "Tags" $heading tags.
+ ] when* ;
+
+TUPLE: vocab-author name ;
+
+INSTANCE: vocab-author topic
+
+C: <vocab-author> vocab-author
+
+: authors. ( seq -- ) [ <vocab-author> ] map $links ;
+
+: describe-authors ( vocab -- )
+ vocab-authors f like [
+ "Authors" $heading authors.
+ ] when* ;
+
+: describe-help ( vocab -- )
+ vocab-help [
+ "Documentation" $heading nl ($link)
+ ] when* ;
+
+: describe-children ( vocab -- )
+ vocab-name all-child-vocabs vocabs. ;
+
+: describe-files ( vocab -- )
+ vocab-files [ <pathname> ] map [
+ "Files" $heading
+ [
+ snippet-style get [
+ code-style get [
+ stack.
+ ] with-nesting
+ ] with-style
+ ] ($block)
+ ] when* ;
+
+: describe-words ( vocab -- )
+ words dup empty? [
+ "Words" $heading
+ dup natural-sort $links
+ ] unless drop ;
+
+: vocab-xref ( vocab quot -- vocabs )
+ >r dup vocab-name swap words r> map
+ [ [ word? ] subset [ word-vocabulary ] map ] map>set
+ remove [ ] subset [ vocab ] map ; inline
+
+: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
+
+: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
+
+: describe-uses ( vocab -- )
+ vocab-uses dup empty? [
+ "Uses" $heading
+ dup $links
+ ] unless drop ;
+
+: describe-usage ( vocab -- )
+ vocab-usage dup empty? [
+ "Used by" $heading
+ dup $links
+ ] unless drop ;
+
+: $describe-vocab ( element -- )
+ first
+ dup describe-children
+ dup vocab-root over vocab-dir? [
+ dup describe-summary
+ dup describe-tags
+ dup describe-authors
+ dup describe-files
+ ] when
+ dup vocab [
+ dup describe-help
+ dup describe-words
+ dup describe-uses
+ dup describe-usage
+ ] when drop ;
+
+: keyed-vocabs ( str quot -- seq )
+ all-vocabs [
+ swap >r
+ [ >r 2dup r> swap call member? ] subset
+ r> swap
+ ] assoc-map 2nip ; inline
+
+: tagged ( tag -- assoc )
+ [ vocab-tags ] keyed-vocabs ;
+
+: authored ( author -- assoc )
+ [ vocab-authors ] keyed-vocabs ;
+
+: $tagged-vocabs ( element -- )
+ first tagged vocabs. ;
+
+: $authored-vocabs ( element -- )
+ first authored vocabs. ;
+
+: $tags ( element -- )
+ drop "Tags" $heading all-tags tags. ;
+
+: $authors ( element -- )
+ drop "Authors" $heading all-authors authors. ;
+
+INSTANCE: vocab topic
+
+INSTANCE: vocab-link topic
+
+M: vocab-spec article-title vocab-name " vocabulary" append ;
+
+M: vocab-spec article-name vocab-name ;
+
+M: vocab-spec article-content
+ vocab-name \ $describe-vocab swap 2array ;
+
+M: vocab-spec article-parent drop "vocab-index" ;
+
+M: vocab-tag >link ;
+
+M: vocab-tag article-title
+ vocab-tag-name "Vocabularies tagged ``" swap "''" 3append ;
+
+M: vocab-tag article-name vocab-tag-name ;
+
+M: vocab-tag article-content
+ \ $tagged-vocabs swap vocab-tag-name 2array ;
+
+M: vocab-tag article-parent drop "vocab-index" ;
+
+M: vocab-tag summary article-title ;
+
+M: vocab-author >link ;
+
+M: vocab-author article-title
+ vocab-author-name "Vocabularies by " swap append ;
+
+M: vocab-author article-name vocab-author-name ;
+
+M: vocab-author article-content
+ \ $authored-vocabs swap vocab-author-name 2array ;
+
+M: vocab-author article-parent drop "vocab-index" ;
+
+M: vocab-author summary article-title ;
diff --git a/extra/tools/browser/tags.txt b/extra/tools/vocabs/browser/tags.txt
similarity index 100%
rename from extra/tools/browser/tags.txt
rename to extra/tools/vocabs/browser/tags.txt
diff --git a/extra/vocabs/monitor/authors.txt b/extra/tools/vocabs/monitor/authors.txt
similarity index 100%
rename from extra/vocabs/monitor/authors.txt
rename to extra/tools/vocabs/monitor/authors.txt
diff --git a/extra/vocabs/monitor/monitor.factor b/extra/tools/vocabs/monitor/monitor.factor
similarity index 79%
rename from extra/vocabs/monitor/monitor.factor
rename to extra/tools/vocabs/monitor/monitor.factor
index 78e2339764..071f179676 100755
--- a/extra/vocabs/monitor/monitor.factor
+++ b/extra/tools/vocabs/monitor/monitor.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: threads io.files io.monitors init kernel
-tools.browser namespaces continuations vocabs.loader ;
-IN: vocabs.monitor
+vocabs.loader tools.vocabs namespaces continuations ;
+IN: tools.vocabs.monitor
! Use file system change monitoring to flush the tags/authors
! cache
@@ -21,4 +21,4 @@ SYMBOL: vocab-monitor
[ monitor-thread t ] "Vocabulary monitor" spawn-server drop
] ignore-errors ;
-[ start-monitor-thread ] "vocabs.monitor" add-init-hook
+[ start-monitor-thread ] "tools.vocabs.monitor" add-init-hook
diff --git a/extra/vocabs/monitor/summary.txt b/extra/tools/vocabs/monitor/summary.txt
similarity index 100%
rename from extra/vocabs/monitor/summary.txt
rename to extra/tools/vocabs/monitor/summary.txt
diff --git a/extra/tools/browser/browser-docs.factor b/extra/tools/vocabs/vocabs-docs.factor
similarity index 73%
rename from extra/tools/browser/browser-docs.factor
rename to extra/tools/vocabs/vocabs-docs.factor
index 28bef58a8a..bdc3954e2e 100755
--- a/extra/tools/browser/browser-docs.factor
+++ b/extra/tools/vocabs/vocabs-docs.factor
@@ -1,52 +1,63 @@
-USING: help.markup help.syntax io strings ;
-IN: tools.browser
-
-ARTICLE: "vocab-index" "Vocabulary index"
-{ $tags }
-{ $authors }
-{ $describe-vocab "" } ;
-
-ARTICLE: "tools.browser" "Vocabulary browser"
-"Getting and setting vocabulary meta-data:"
-{ $subsection vocab-file-contents }
-{ $subsection set-vocab-file-contents }
-{ $subsection vocab-summary }
-{ $subsection set-vocab-summary }
-{ $subsection vocab-tags }
-{ $subsection set-vocab-tags }
-{ $subsection add-vocab-tags }
-"Global meta-data:"
-{ $subsection all-vocabs }
-{ $subsection all-vocabs-seq }
-{ $subsection all-tags }
-{ $subsection all-authors }
-"Because loading the above data is expensive, it is cached. The cache is flushed by the " { $vocab-link "vocabs.monitor" } " vocabulary. It can also be flushed manually when file system change monitors are not available:"
-{ $subsection reset-cache } ;
-
-HELP: vocab-file-contents
-{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
-{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
-
-HELP: set-vocab-file-contents
-{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
-{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;
-
-HELP: vocab-summary
-{ $values { "vocab" "a vocabulary specifier" } { "summary" "a string or " { $link f } } }
-{ $description "Outputs a one-line string description of the vocabulary's intended purpose from the " { $snippet "summary.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
-
-HELP: set-vocab-summary
-{ $values { "string" "a string or " { $link f } } { "vocab" "a vocabulary specifier" } }
-{ $description "Stores a one-line string description of the vocabulary to the " { $snippet "summary.txt" } " file in the vocabulary's directory." } ;
-
-HELP: vocab-tags
-{ $values { "vocab" "a vocabulary specifier" } { "tags" "a sequence of strings" } }
-{ $description "Outputs a list of short tags classifying the vocabulary from the " { $snippet "tags.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
-
-HELP: set-vocab-tags
-{ $values { "tags" "a sequence of strings" } { "vocab" "a vocabulary specifier" } }
-{ $description "Stores a list of short tags classifying the vocabulary to the " { $snippet "tags.txt" } " file in the vocabulary's directory." } ;
-
-HELP: all-vocabs
-{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
-{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;
+USING: help.markup help.syntax strings ;
+IN: tools.vocabs
+
+ARTICLE: "tools.vocabs" "Vocabulary tools"
+"Reloading source files changed on disk:"
+{ $subsection refresh }
+{ $subsection refresh-all }
+"Vocabulary summaries:"
+{ $subsection vocab-summary }
+{ $subsection set-vocab-summary }
+"Vocabulary tags:"
+{ $subsection vocab-tags }
+{ $subsection set-vocab-tags }
+{ $subsection add-vocab-tags }
+"Getting and setting vocabulary meta-data:"
+{ $subsection vocab-file-contents }
+{ $subsection set-vocab-file-contents }
+"Global meta-data:"
+{ $subsection all-vocabs }
+{ $subsection all-vocabs-seq }
+{ $subsection all-tags }
+{ $subsection all-authors }
+"Because loading the above data is expensive, it is cached. The cache is flushed by the " { $vocab-link "tools.vocabs.monitor" } " vocabulary. It can also be flushed manually when file system change monitors are not available:"
+{ $subsection reset-cache } ;
+
+ABOUT: "tools.vocabs"
+
+HELP: refresh
+{ $values { "prefix" string } }
+{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
+
+HELP: refresh-all
+{ $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
+
+{ refresh refresh-all } related-words
+
+HELP: vocab-file-contents
+{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
+{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
+
+HELP: set-vocab-file-contents
+{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
+{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;
+
+HELP: vocab-summary
+{ $values { "vocab" "a vocabulary specifier" } { "summary" "a string or " { $link f } } }
+{ $description "Outputs a one-line string description of the vocabulary's intended purpose from the " { $snippet "summary.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
+
+HELP: set-vocab-summary
+{ $values { "string" "a string or " { $link f } } { "vocab" "a vocabulary specifier" } }
+{ $description "Stores a one-line string description of the vocabulary to the " { $snippet "summary.txt" } " file in the vocabulary's directory." } ;
+
+HELP: vocab-tags
+{ $values { "vocab" "a vocabulary specifier" } { "tags" "a sequence of strings" } }
+{ $description "Outputs a list of short tags classifying the vocabulary from the " { $snippet "tags.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
+
+HELP: set-vocab-tags
+{ $values { "tags" "a sequence of strings" } { "vocab" "a vocabulary specifier" } }
+{ $description "Stores a list of short tags classifying the vocabulary to the " { $snippet "tags.txt" } " file in the vocabulary's directory." } ;
+
+HELP: all-vocabs
+{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
+{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;
diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor
new file mode 100755
index 0000000000..ba6baa543f
--- /dev/null
+++ b/extra/tools/vocabs/vocabs.factor
@@ -0,0 +1,232 @@
+! Copyright (C) 2007, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.files kernel io.encodings.utf8 vocabs.loader vocabs
+sequences namespaces math.parser arrays hashtables assocs
+memoize inspector sorting splitting combinators source-files
+io debugger continuations compiler.errors init ;
+IN: tools.vocabs
+
+: modified ( seq quot -- seq )
+ [ dup ] swap compose { } map>assoc
+ [ nip ] assoc-subset
+ [ nip source-modified? ] assoc-subset keys ; inline
+
+: modified-sources ( vocabs -- seq )
+ [ vocab-source-path ] modified ;
+
+: modified-docs ( vocabs -- seq )
+ [ vocab-docs-path ] modified ;
+
+: update-roots ( vocabs -- )
+ [ dup find-vocab-root swap vocab set-vocab-root ] each ;
+
+: to-refresh ( prefix -- modified-sources modified-docs )
+ child-vocabs
+ dup update-roots
+ dup modified-sources swap modified-docs ;
+
+: vocab-heading. ( vocab -- )
+ nl
+ "==== " write
+ dup vocab-name swap vocab write-object ":" print
+ nl ;
+
+: load-error. ( triple -- )
+ dup first vocab-heading.
+ dup second print-error
+ drop ;
+
+: load-failures. ( failures -- )
+ [ load-error. nl ] each ;
+
+SYMBOL: failures
+
+: require-all ( vocabs -- failures )
+ [
+ V{ } clone blacklist set
+ V{ } clone failures set
+ [
+ [ require ]
+ [ swap vocab-name failures get set-at ]
+ recover
+ ] each
+ failures get
+ ] with-compiler-errors ;
+
+: do-refresh ( modified-sources modified-docs -- )
+ 2dup
+ [ f swap set-vocab-docs-loaded? ] each
+ [ f swap set-vocab-source-loaded? ] each
+ append prune require-all load-failures. ;
+
+: refresh ( prefix -- ) to-refresh do-refresh ;
+
+SYMBOL: sources-changed?
+
+[ t sources-changed? set-global ] "tools.vocabs" add-init-hook
+
+: refresh-all ( -- )
+ "" refresh f sources-changed? set-global ;
+
+MEMO: (vocab-file-contents) ( path -- lines )
+ ?resource-path dup exists?
+ [ utf8 file-lines ] [ drop f ] if ;
+
+: vocab-file-contents ( vocab name -- seq )
+ vocab-path+ dup [ (vocab-file-contents) ] when ;
+
+: set-vocab-file-contents ( seq vocab name -- )
+ dupd vocab-path+ [
+ ?resource-path utf8 set-file-lines
+ ] [
+ "The " swap vocab-name
+ " vocabulary was not loaded from the file system"
+ 3append throw
+ ] ?if ;
+
+: vocab-summary-path ( vocab -- string )
+ vocab-dir "summary.txt" path+ ;
+
+: vocab-summary ( vocab -- summary )
+ dup dup vocab-summary-path vocab-file-contents
+ dup empty? [
+ drop vocab-name " vocabulary" append
+ ] [
+ nip first
+ ] if ;
+
+M: vocab summary
+ [
+ dup vocab-summary %
+ " (" %
+ vocab-words assoc-size #
+ " words)" %
+ ] "" make ;
+
+M: vocab-link summary vocab-summary ;
+
+: set-vocab-summary ( string vocab -- )
+ >r 1array r>
+ dup vocab-summary-path
+ set-vocab-file-contents ;
+
+: vocab-tags-path ( vocab -- string )
+ vocab-dir "tags.txt" path+ ;
+
+: vocab-tags ( vocab -- tags )
+ dup vocab-tags-path vocab-file-contents ;
+
+: set-vocab-tags ( tags vocab -- )
+ dup vocab-tags-path set-vocab-file-contents ;
+
+: add-vocab-tags ( tags vocab -- )
+ [ vocab-tags append prune ] keep set-vocab-tags ;
+
+: vocab-authors-path ( vocab -- string )
+ vocab-dir "authors.txt" path+ ;
+
+: vocab-authors ( vocab -- authors )
+ dup vocab-authors-path vocab-file-contents ;
+
+: set-vocab-authors ( authors vocab -- )
+ dup vocab-authors-path set-vocab-file-contents ;
+
+: subdirs ( dir -- dirs )
+ directory [ second ] subset keys natural-sort ;
+
+: (all-child-vocabs) ( root name -- vocabs )
+ [ vocab-dir path+ ?resource-path subdirs ] keep
+ dup empty? [
+ drop
+ ] [
+ swap [ "." swap 3append ] with map
+ ] if ;
+
+: vocabs-in-dir ( root name -- )
+ dupd (all-child-vocabs) [
+ 2dup vocab-dir? [ 2dup swap >vocab-link , ] when
+ vocabs-in-dir
+ ] with each ;
+
+: all-vocabs ( -- assoc )
+ vocab-roots get [
+ dup [ "" vocabs-in-dir ] { } make
+ ] { } map>assoc ;
+
+MEMO: all-vocabs-seq ( -- seq )
+ all-vocabs values concat ;
+
+: dangerous? ( name -- ? )
+ #! Hack
+ {
+ { [ "cpu." ?head ] [ t ] }
+ { [ "io.unix" ?head ] [ t ] }
+ { [ "io.windows" ?head ] [ t ] }
+ { [ "ui.x11" ?head ] [ t ] }
+ { [ "ui.windows" ?head ] [ t ] }
+ { [ "ui.cocoa" ?head ] [ t ] }
+ { [ "cocoa" ?head ] [ t ] }
+ { [ "core-foundation" ?head ] [ t ] }
+ { [ "vocabs.loader.test" ?head ] [ t ] }
+ { [ "editors." ?head ] [ t ] }
+ { [ ".windows" ?tail ] [ t ] }
+ { [ ".unix" ?tail ] [ t ] }
+ { [ "unix." ?head ] [ t ] }
+ { [ ".linux" ?tail ] [ t ] }
+ { [ ".bsd" ?tail ] [ t ] }
+ { [ ".macosx" ?tail ] [ t ] }
+ { [ "windows." ?head ] [ t ] }
+ { [ "cocoa" ?head ] [ t ] }
+ { [ ".test" ?tail ] [ t ] }
+ { [ "raptor" ?head ] [ t ] }
+ { [ dup "tools.deploy.app" = ] [ t ] }
+ { [ t ] [ f ] }
+ } cond nip ;
+
+: filter-dangerous ( seq -- seq' )
+ [ vocab-name dangerous? not ] subset ;
+
+: try-everything ( -- failures )
+ all-vocabs-seq
+ filter-dangerous
+ require-all ;
+
+: load-everything ( -- )
+ try-everything load-failures. ;
+
+: unrooted-child-vocabs ( prefix -- seq )
+ dup empty? [ CHAR: . add ] unless
+ vocabs
+ [ vocab-root not ] subset
+ [
+ vocab-name swap ?head CHAR: . rot member? not and
+ ] with subset
+ [ vocab ] map ;
+
+: all-child-vocabs ( prefix -- assoc )
+ vocab-roots get [
+ over dupd dupd (all-child-vocabs)
+ swap [ >vocab-link ] curry map
+ ] { } map>assoc
+ f rot unrooted-child-vocabs 2array add ;
+
+: load-children ( prefix -- )
+ all-child-vocabs values concat
+ filter-dangerous
+ require-all
+ load-failures. ;
+
+: map>set ( seq quot -- )
+ map concat prune natural-sort ; inline
+
+MEMO: all-tags ( -- seq )
+ all-vocabs-seq [ vocab-tags ] map>set ;
+
+MEMO: all-authors ( -- seq )
+ all-vocabs-seq [ vocab-authors ] map>set ;
+
+: reset-cache ( -- )
+ \ (vocab-file-contents) reset-memoized
+ \ all-vocabs-seq reset-memoized
+ \ all-authors reset-memoized
+ \ all-tags reset-memoized ;
diff --git a/extra/ui/tools/operations/operations.factor b/extra/ui/tools/operations/operations.factor
index 093222f17b..51a545db47 100755
--- a/extra/ui/tools/operations/operations.factor
+++ b/extra/ui/tools/operations/operations.factor
@@ -8,7 +8,7 @@ namespaces parser prettyprint quotations tools.annotations
editors tools.profiler tools.test tools.time tools.walker
ui.commands ui.gadgets.editors ui.gestures ui.operations
ui.tools.deploy vocabs vocabs.loader words sequences
-tools.browser classes compiler.units ;
+tools.vocabs classes compiler.units ;
IN: ui.tools.operations
V{ } clone operations set-global
@@ -84,11 +84,7 @@ UNION: definition word method-spec link vocab vocab-link ;
{ +secondary+ t }
} define-operation
-[
- class
- { link word vocab vocab-link vocab-tag vocab-author }
- memq?
-] \ com-follow H{
+[ topic? ] \ com-follow H{
{ +keyboard+ T{ key-down f { C+ } "H" } }
{ +primary+ t }
} define-operation
diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor
index b37b4ca707..45ac645392 100755
--- a/extra/ui/tools/search/search.factor
+++ b/extra/ui/tools/search/search.factor
@@ -7,7 +7,7 @@ source-files definitions strings tools.completion tools.crossref
tuples ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.operations vocabs words vocabs.loader
-tools.browser unicode.case calendar ui ;
+tools.vocabs unicode.case calendar ui ;
IN: ui.tools.search
TUPLE: live-search field list ;
From 208423471913dd638920fb07f67e49f35050ecd4 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Thu, 13 Mar 2008 15:20:05 +1100
Subject: [PATCH 02/38] improved and updated the vim syntax file, and fixed the
syntax generator
---
.../generate-syntax/generate-syntax.factor | 10 ++
extra/editors/vim/generate-vim-syntax.factor | 10 --
misc/factor.vim | 97 +++++++++++++------
misc/factor.vim.fgen | 85 +++++++++++-----
4 files changed, 134 insertions(+), 68 deletions(-)
create mode 100644 extra/editors/vim/generate-syntax/generate-syntax.factor
delete mode 100644 extra/editors/vim/generate-vim-syntax.factor
diff --git a/extra/editors/vim/generate-syntax/generate-syntax.factor b/extra/editors/vim/generate-syntax/generate-syntax.factor
new file mode 100644
index 0000000000..178a1b3b8b
--- /dev/null
+++ b/extra/editors/vim/generate-syntax/generate-syntax.factor
@@ -0,0 +1,10 @@
+! Generate a new factor.vim file for syntax highlighting
+USING: http.server.templating.fhtml io.files ;
+IN: editors.vim.generate-syntax
+
+: generate-vim-syntax ( -- )
+ "misc/factor.vim.fgen" resource-path
+ "misc/factor.vim" resource-path
+ template-convert ;
+
+MAIN: generate-vim-syntax
diff --git a/extra/editors/vim/generate-vim-syntax.factor b/extra/editors/vim/generate-vim-syntax.factor
deleted file mode 100644
index 23bd49cdb8..0000000000
--- a/extra/editors/vim/generate-vim-syntax.factor
+++ /dev/null
@@ -1,10 +0,0 @@
-! Generate a new factor.vim file for syntax highlighting
-REQUIRES: apps/http-server ;
-
-IN: vim
-
-USING: embedded io ;
-
-"extras/factor.vim.fgen" resource-path
-"extras/factor.vim" resource-path
-embedded-convert
diff --git a/misc/factor.vim b/misc/factor.vim
index 4d15245da8..93ce3d6bd5 100644
--- a/misc/factor.vim
+++ b/misc/factor.vim
@@ -21,15 +21,26 @@ else
set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255
endif
-syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple
+syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple
syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained
syn match factorComment /\<#! .*/ contains=factorTodo
syn match factorComment /\<! .*/ contains=factorTodo
-syn region None matchgroup=factorDefinition start=/\<\(C\|M\|G\|UNION\|PREDICATE\)\?:\>/ end=/\<;\>/ contains=@factorCluster,factorStackEffect,factorStackEffectErr,factorArray0,factorQuotation0
+syn cluster factorDefnContents contains=@factorCluster,factorStackEffect,factorArray0,factorQuotation0
+
+syn region factorDefn matchgroup=factorDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents
+syn region factorMethod matchgroup=factorMethodDelims start=/\<M:\s\+\S\+\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents
+syn region factorGeneric matchgroup=factorGenericDelims start=/\<GENERIC:\s\+\S\+\>/ end=/$/ contains=factorStackEffect
+syn region factorGenericN matchgroup=factorGenericNDelims start=/\<GENERIC#\s\+\S\+\s\+\d\+\>/ end=/$/ contains=factorStackEffect
+
+syn region factorPrivateDefn matchgroup=factorPrivateDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained
+syn region factorPrivateMethod matchgroup=factorPrivateMethodDelims start=/\<M:\s\+\S\+\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained
+syn region factorPGeneric matchgroup=factorPGenericDelims start=/\<GENERIC:\s\+\S\+\>/ end=/$/ contains=factorStackEffect contained
+syn region factorPGenericN matchgroup=factorPGenericNDelims start=/\<GENERIC#\s\+\S\+\s\+\d\+\>/ end=/$/ contains=factorStackEffect
+
+syn region None matchgroup=factorPrivate start=/\<<PRIVATE\>/ end=/\<PRIVATE>\>/ contains=@factorDefnContents,factorPrivateDefn,factorPrivateMethod,factorPGeneric,factorPGenericN
-syn region None matchgroup=factorGeneric start=/\<GENERIC:\>/ end=/$/ contains=factorStackEffect,factorStackEffectErr
syn keyword factorBoolean boolean f general-t t
syn keyword factorCompileDirective inline foldable parsing
@@ -37,15 +48,17 @@ syn keyword factorCompileDirective inline foldable parsing
" kernel vocab keywords
-syn keyword factorKeyword continuation-name set-datastack wrapper continuation-catch set-continuation-name slip pick 2slip 2nip tuple set-boot clone with-datastack cpu -roll tuck -rot (continue) set-continuation-retain swapd <continuation> >boolean wrapper? dupd 3dup dup ifcc callstack windows? os-env = over continuation alist>quot ? <wrapper> 2dup cond win64? <quotation> continue 3drop hashcode quotation xor when curry millis set-callstack unless >r die version callcc0 or os callcc1 get-walker-hook depth equal? 3keep no-cond? continue-with if exit tuple? set-retainstack unix? (continue-with) general-t continuation? 3slip <no-cond> macosx? r> rot win32? retainstack 2apply >quotation >continuation< type continuation-call clear call drop continuation-data set-continuation-call 2drop no-cond unit set-continuation-data keep-datastack and when* quotation? ?if literalize datastack swap unless* 2swap set-continuation-catch eq? not roll set-walker-hook continuation-retain with make-dip wrapped keep 2keep <=> if* nip
-syn keyword factorKeyword sin integer? log2 cot oct> number>string integer first-bignum sech abs repeat tanh real? vmin norm-sq neg between? asech >rect bignum? atanh -i * + fp-nan? - small / sqrt infimum fix-float cosech even? v*n < bits>double > most-positive-fixnum ^theta numerator digit+ >base (random-int) acosech cosh min pi number vmax zero? sum digit> rem bitor supremum string>integer most-negative-fixnum >polar >fraction ceiling acos acot ^ asin acosh /f ratio e fixnum? /i ^n cis coth 1+ 1- conjugate sinh acosec i number= number? double>bits epsilon float product string>number n/v norm max tan acoth absq float? asinh denominator rational? fixnum rect> >fixnum imaginary recip exp sec bitxor w>h/h >bin align base> times log <= [-] init-random sq odd? (repeat) [v-] ^mag bitnot ratio? random-int >digit (next-power-of-2) v* v+ v- v. v/ >float [-1,1]? arg small? bitand set-axis >oct v/n complex rational shift (^) polar> (gcd) cosec next-power-of-2 >float-rect atan sgn >= float>bits normalize real bin> complex? gcd d>w/w hex> mod string>ratio asec floor n*v >hex truncate bits>float vneg >bignum bignum power-of-2? integer, /mod (string>integer) cos
-syn keyword factorKeyword second sort-values all-eq? pop* find slice-error-reason inject-with prune remove (group) split1-slice slice-error (slice*) split* head-slice* find* split, first remove-nth hash-prune push-if ?push reverse subseq split1 diff subset split new padding column? copy-into-check column@ <column> peek last/first add find-last ?nth add* slice-from cache-nth subseq? <reversed> <slice-error> (3append) replace-slice reversed-seq find-last-with empty? ((append)) reversed? reversed@ map-with find-last-with* set-slice-error-reason set-column-col natural-sort (subst) set-slice-seq index* concat push binsearch slice-seq 3append nsort length tail-slice* reversed ?head sequence= ?tail sequence? memq? join split-next, delete set-nth subst monotonic? group map flip unclip set-reversed-seq find-last* start* max-length assoc min-length all-equal? all? pad-left contains? inject slice <slice> first2 first3 first4 exchange bounds-check? column-seq check-slice pad-right each subset-with unpair tail head interleave (delete) copy-into sort sequence reduce set-slice-from set-slice-to 2map (cut) member? cut rassoc (append) last-index* sort-keys change-nth 2each >sequence nth tail* head* third tail-slice set-length collapse-slice column (mismatch) contains-with? push-new pop tail? head? slice? slice@ delete-all binsearch* move find-with* 2reduce slice-to find-with like slice-error? set-column-seq nappend column-col cut* (split) index each-with last-index fourth append accumulate drop-prefix mismatch head-slice all-with? start
-syn keyword factorKeyword namespace-error-object inc dec make off bind get-global init-namespaces set-global namespace on ndrop namespace-error? namestack namespace-error +@ # % make-hash global , set-namestack with-scope building <namespace-error> change nest set-namespace-error-object get set counter
-syn keyword factorKeyword array <array> pair byte-array pair? 1array 2array resize-array 4array 3array byte-array? <byte-array> array? >array
-syn keyword factorKeyword cwd duplex-stream pathname? set-pathname-string with-log-file directory duplex-stream-out format <nested-style-stream> (readln) duplex-stream? read1 with-stream-style c-stream-error? <file-reader> stream-write1 with-stream line-reader? set-duplex-stream-out server? cr> <check-closed> directory? log-message flush format-column stream-readln nested-style-stream? <line-reader> <file-r/w> set-timeout write-pathname file-modified duplex-stream-closed? print set-duplex-stream-closed? pathname line-reader ?resource-path terpri write-object le> string-out stream-terpri log-client do-nested-style path+ <c-stream-error> set-client-stream-host plain-writer? server-stream resource-path >be parent-dir with-stream* <file-writer> server-loop string-in nested-style-stream stream-close stream-copy c-stream-error <client-stream> with-style client-stream-host stat plain-writer file-length contents <string-reader> stream-read stream-format check-closed? set-client-stream-port <duplex-stream> <server> write1 bl write-outliner map-last (with-stream-style) set-line-reader-cr tabular-output (lines) stream-write log-stream server-client (stream-copy) with-nested-stream lines readln cd client-stream nth-byte with-logging stream-read1 nested-style-stream-style accept check-closed client-stream-port do-nested-quot pathname-string set-nested-style-stream-style read home close with-stream-table stdio be> log-error duplex-stream-out+ server stream-flush set-duplex-stream-in line-reader-cr >le with-client <client> <pathname> <string-writer> (directory) set-server-client stream-print with-server exists? <plain-writer> with-nesting string-lines write duplex-stream-in client-stream? duplex-stream-in+
-syn keyword factorKeyword sbuf ch>upper string? LETTER? >sbuf >lower quotable? string>sbuf blank? string sbuf? printable? >string letter? resize-string control? alpha? <string> >upper Letter? ch>lower digit? <sbuf> ch>string
-syn keyword factorKeyword <vector> >vector array>vector vector? vector
-syn keyword factorKeyword set-restart-continuation cleanup error-hook restart-name restarts. stack-underflow. expired-error. restart restart? word-xt. (:help-none) set-catchstack c-string-error. condition <assert> debug-help :get datastack-overflow. set-condition-restarts condition? error. objc-error. print-error assert :res catchstack rethrow assert= kernel-error restart-obj assert? undefined-symbol-error. retainstack-overflow. restarts error-help divide-by-zero-error. ffi-error. signal-error. (:help-multi) set-restart-obj xt. memory-error. retainstack-underflow. set-condition-continuation datastack-underflow. try assert-depth error-continuation error-stack-trace assert-expect recover :edit kernel-error? error callstack-overflow. stack-overflow. callstack-underflow. set-assert-got set-restart-name restart-continuation condition-restarts heap-scan-error. :help type-check-error. <condition> assert-got throw negative-array-size-error. :c condition-continuation :trace undefined-word-error. io-error. parse-dump <restart> set-assert-expect :r :s compute-restarts catch restart.
+syn keyword factorKeyword or construct-delegate set-slots tuck while wrapper nip hashcode wrapper? both? callstack>array die dupd set-delegate callstack callstack? 3dup pick curry build >boolean ?if clone eq? = ? swapd call-clear 2over 2keep 3keep construct general-t clear 2dup when not tuple? 3compose dup call object wrapped unless* if* 2apply >r curry-quot drop when* retainstack -rot delegate with 3slip construct-boa slip compose-first compose-second 3drop construct-empty either? curry? datastack compare curry-obj over 3curry roll throw swap and 2nip set-retainstack (clone) hashcode* get-slots compose spin if <=> unless compose? tuple keep 2curry object? equal? set-datastack 2slip 2drop most <wrapper> null r> set-callstack dip xor rot -roll
+syn keyword factorKeyword assoc? assoc-clone-like delete-any assoc= delete-at* new-assoc subassoc? assoc-size map>assoc union search-alist assoc-like key? update at* assoc-empty? at+ set-at assoc-all? assoc-hashcode intersect change-at assoc-each assoc-subset values rename-at value-at (assoc-stack) at cache assoc>map assoc-contains? assoc assoc-map assoc-pusher diff (assoc>map) assoc-push-if remove-all >alist (substitute) substitute-here clear-assoc assoc-stack substitute delete-at assoc-find keys
+syn keyword factorKeyword case dispatch-case-quot with-datastack alist>quot dispatch-case hash-case-table <buckets> hash-case-quot no-cond no-case? cond distribute-buckets (distribute-buckets) contiguous-range? cond>quot no-cond? no-case recursive-hashcode linear-case-quot hash-dispatch-quot case>quot
+syn keyword factorKeyword byte-array>bignum sgn >bignum number= each-integer next-power-of-2 before? imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? after? fixnum before=? bignum sq neg denominator [-] (all-integers?) times find-last-integer (each-integer) bit? * + - / >= bitand find-integer complex < real > log2 integer? max number bits>double double>bits bitor 2/ zero? rem all-integers? (find-integer) real-part align bits>float float? shift between? float 1+ 1- min fp-nan? ratio? bitxor even? ratio <= /mod >integer odd? rational? bitnot real? >fixnum complex? (next-power-of-2) /i numerator after=? /f
+syn keyword factorKeyword slice-to append left-trim clone-like 3sequence set-column-seq map-as reversed pad-left cut* nth sequence slice? <slice> tail-slice empty? tail* member? unclip virtual-sequence? set-length last-index* <column> drop-prefix bounds-error? set-slice-seq set-column-col seq-diff map start open-slice midpoint@ add* set-immutable-seq move-forward fourth delete set-slice-to all-eq? monotonic? set-reversed-seq like delete-nth first4 repetition-len (open-slice) column? reverse slice padding virtual@ repetition? index 4sequence max-length set-second first2 first3 (3append) supremum unclip-slice index* move-backward tail 3append sequence-hashcode-step right-trim reversed-seq pad-right concat find* set-slice-from flip sum find-last* immutable? 2sequence delete-all start* immutable-sequence? (append) check-slice column-seq sequence? head set-slice-error-reason reduce set-bounds-error-index reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check immutable find column remove ((append)) set-fourth peek contains? reversed? shorter? push-new find-last head-slice pop* immutable-seq tail-slice* accumulate each pusher all-equal? new-resizable cut-slice head-slice* 2reverse-each pop memq? set-nth ?nth <flat-slice> second change-each join set-repetition-len <reversed> all? virtual-sequence set-repetition-elt subseq? immutable-sequence slice-error-reason new-like length last-index seq-intersect push-if 2all? lengthen column-col joined-length copy set-bounds-error-seq cache-nth move third first slice-from repetition-elt tail? set-first bounds-error add bounds-error-seq bounds-error-index <repetition> unfold exchange slice-seq cut 2reduce change-nth min-length set-third (delete) push-all head? delete-slice sum-lengths new 2each head* infimum subset slice-error subseq replace-slice repetition push trim sequence-hashcode mismatch
+syn keyword factorKeyword global +@ set-namestack with-variable on set bind dec namestack get get-global change init-namespaces with-scope off set-global namespace % make , inc counter building make-assoc
+syn keyword factorKeyword <array> 3array >array 4array pair? array pair 2array 1array resize-array array?
+syn keyword factorKeyword readln stream-read-until stream-read-partial stderr with-stream read with-stream* print contents make-span-stream write1 stream-write1 stream-format make-block-stream stream-copy with-cell stream-write format with-row stream-print stream-read with-nesting (stream-copy) bl write-object nl stream-nl write stdio flush read-until tabular-output make-cell-stream write-cell stream-flush read1 lines stream-read1 stream-write-table with-style stream-readln
+syn keyword factorKeyword resize-string >string <string> 1string string string?
+syn keyword factorKeyword vector? <vector> ?push vector >vector 1vector
+syn keyword factorKeyword rethrow-restarts restarts recover set-restart-name set-continuation-name condition-continuation <restart> ifcc continuation-name set-restart-continuation ignore-errors continuation-retain continue <continuation> restart-continuation with-disposal set-continuation-catch restart-obj error thread-error-hook set-continuation-retain continuation rethrow callcc1 callcc0 condition continuation? continuation-call continuation-data set-condition-restarts set-catchstack >continuation< error-continuation cleanup restart? compute-restarts condition? error-thread set-continuation-call set-condition-continuation <condition> set-restart-obj dispose set-continuation-data throw-restarts catchstack continue-with attempt-all restart restart-name continuation-catch condition-restarts
syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
@@ -73,11 +86,16 @@ syn match factorBackslash /\<\\\>\s\+\S\+\>/
syn region factorUsing start=/\<USING:\>/ end=/;/
syn region factorRequires start=/\<REQUIRES:\>/ end=/;/
-syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget
+syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
syn match factorSymbol /\<SYMBOL:\s\+\S\+\>/
syn match factorPostpone /\<POSTPONE:\s\+\S\+\>/
syn match factorDefer /\<DEFER:\s\+\S\+\>/
syn match factorForget /\<FORGET:\s\+\S\+\>/
+syn match factorMixin /\<MIXIN:\s\+\S\+\>/
+syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
+syn match factorHook /\<HOOK:\s\+\S\+\s\+\S\+\>/
+syn match factorMain /\<MAIN:\s\+\S\+\>/
+syn match factorConstructor /\<C:\s\+\S\+\s\+\S\+\>/
syn match factorAlien /\<ALIEN:\s\+\d\+\>/
@@ -87,8 +105,6 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
"misc:
" HELP:
" ARTICLE:
-" PROVIDE:
-" MAIN:
"literals:
" PRIMITIVE:
@@ -106,8 +122,11 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline
-syn match factorStackEffectErr /\<)\>/
-syn region factorStackEffectErr start=/\<(\>/ end=/\<)\>/
+syn region factorMultiString matchgroup=factorMultiStringDelims start=/\<STRING:\s\+\S\+\>/ end=/^;$/ contains=factorMultiStringContents
+syn match factorMultiStringContents /.*/ contained
+
+"syn match factorStackEffectErr /\<)\>/
+"syn region factorStackEffectErr start=/\<(\>/ end=/\<)\>/
syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained
"adapted from lisp.vim
@@ -127,18 +146,18 @@ else
endif
if exists("g:factor_norainbow")
- syn region factorArray matchgroup=factorDelimiter start=/\<\(V\|H\|T\|W\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL
+ syn region factorArray matchgroup=factorDelimiter start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL
else
- syn region factorArray0 matchgroup=hlLevel0 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1
- syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2
- syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3
- syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4
- syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5
- syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6
- syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7
- syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8
- syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9
- syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0
+ syn region factorArray0 matchgroup=hlLevel0 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1
+ syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2
+ syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3
+ syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4
+ syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5
+ syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6
+ syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7
+ syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8
+ syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9
+ syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0
endif
syn match factorBracketErr /\<\]\>/
@@ -163,11 +182,21 @@ if version >= 508 || !exists("did_factor_syn_inits")
HiLink factorKeyword Keyword
HiLink factorOperator Operator
HiLink factorBoolean Boolean
- HiLink factorDefinition Typedef
+ HiLink factorDefnDelims Typedef
+ HiLink factorMethodDelims Typedef
+ HiLink factorGenericDelims Typedef
+ HiLink factorGenericNDelims Typedef
+ HiLink factorConstructor Typedef
+ HiLink factorPrivate Special
+ HiLink factorPrivateDefnDelims Special
+ HiLink factorPrivateMethodDelims Special
+ HiLink factorPGenericDelims Special
+ HiLink factorPGenericNDelims Special
HiLink factorString String
HiLink factorSbuf String
+ HiLink factorMultiStringContents String
+ HiLink factorMultiStringDelims Typedef
HiLink factorBracketErr Error
- HiLink factorStackEffectErr Error
HiLink factorComplex Number
HiLink factorRatio Number
HiLink factorBinary Number
@@ -186,14 +215,17 @@ if version >= 508 || !exists("did_factor_syn_inits")
HiLink factorCharErr Error
HiLink factorDelimiter Delimiter
HiLink factorBackslash Special
- HiLink factorCompileDirective Keyword
+ HiLink factorCompileDirective Typedef
HiLink factorSymbol Define
+ HiLink factorMixin Typedef
+ HiLink factorInstance Typedef
+ HiLink factorHook Typedef
+ HiLink factorMain Define
HiLink factorPostpone Define
HiLink factorDefer Define
HiLink factorForget Define
HiLink factorAlien Define
HiLink factorTuple Typedef
- HiLink factorGeneric Define
if &bg == "dark"
hi hlLevel0 ctermfg=red guifg=red1
@@ -230,3 +262,4 @@ set expandtab
set autoindent " annoying?
" vim: syntax=vim
+
diff --git a/misc/factor.vim.fgen b/misc/factor.vim.fgen
index 9782c4f1d0..7bcba78cde 100644
--- a/misc/factor.vim.fgen
+++ b/misc/factor.vim.fgen
@@ -1,4 +1,4 @@
-<% USING: kernel io prettyprint words sequences ;
+<% USING: kernel io prettyprint vocabs sequences ;
%>" Vim syntax file
" Language: factor
" Maintainer: Alex Chapman <chapman.alex@gmail.com>
@@ -22,15 +22,26 @@ else
set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255
endif
-syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple
+syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple
syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained
syn match factorComment /\<#! .*/ contains=factorTodo
syn match factorComment /\<! .*/ contains=factorTodo
-syn region None matchgroup=factorDefinition start=/\<\(C\|M\|G\|UNION\|PREDICATE\)\?:\>/ end=/\<;\>/ contains=@factorCluster,factorStackEffect,factorStackEffectErr,factorArray0,factorQuotation0
+syn cluster factorDefnContents contains=@factorCluster,factorStackEffect,factorArray0,factorQuotation0
+
+syn region factorDefn matchgroup=factorDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents
+syn region factorMethod matchgroup=factorMethodDelims start=/\<M:\s\+\S\+\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents
+syn region factorGeneric matchgroup=factorGenericDelims start=/\<GENERIC:\s\+\S\+\>/ end=/$/ contains=factorStackEffect
+syn region factorGenericN matchgroup=factorGenericNDelims start=/\<GENERIC#\s\+\S\+\s\+\d\+\>/ end=/$/ contains=factorStackEffect
+
+syn region factorPrivateDefn matchgroup=factorPrivateDefnDelims start=/\<\(MACRO\|MEMO\|:\)\?:\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained
+syn region factorPrivateMethod matchgroup=factorPrivateMethodDelims start=/\<M:\s\+\S\+\s\+\S\+\>/ end=/\<;\>/ contains=@factorDefnContents contained
+syn region factorPGeneric matchgroup=factorPGenericDelims start=/\<GENERIC:\s\+\S\+\>/ end=/$/ contains=factorStackEffect contained
+syn region factorPGenericN matchgroup=factorPGenericNDelims start=/\<GENERIC#\s\+\S\+\s\+\d\+\>/ end=/$/ contains=factorStackEffect
+
+syn region None matchgroup=factorPrivate start=/\<<PRIVATE\>/ end=/\<PRIVATE>\>/ contains=@factorDefnContents,factorPrivateDefn,factorPrivateMethod,factorPGeneric,factorPGenericN
-syn region None matchgroup=factorGeneric start=/\<GENERIC:\>/ end=/$/ contains=factorStackEffect,factorStackEffectErr
syn keyword factorBoolean boolean f general-t t
syn keyword factorCompileDirective inline foldable parsing
@@ -40,10 +51,13 @@ syn keyword factorCompileDirective inline foldable parsing
! that this changes factor.vim from around 8k to around 100k (and is a bit
! broken)
-! vocabs [ words [ "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write ] when* ] each %>
+! vocabs [ words [ "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write ] when* ] each
+%>
" kernel vocab keywords
-<% { "kernel" "math" "sequences" "namespaces" "arrays" "io" "strings" "vectors" "errors" } [ words "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write ] each %>
+<% { "kernel" "assocs" "combinators" "math" "sequences" "namespaces" "arrays" "io" "strings" "vectors" "continuations" } [
+ words "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write
+ ] each %>
syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
syn cluster factorNumber contains=@factorReal,factorComplex
@@ -70,11 +84,16 @@ syn match factorBackslash /\<\\\>\s\+\S\+\>/
syn region factorUsing start=/\<USING:\>/ end=/;/
syn region factorRequires start=/\<REQUIRES:\>/ end=/;/
-syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget
+syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
syn match factorSymbol /\<SYMBOL:\s\+\S\+\>/
syn match factorPostpone /\<POSTPONE:\s\+\S\+\>/
syn match factorDefer /\<DEFER:\s\+\S\+\>/
syn match factorForget /\<FORGET:\s\+\S\+\>/
+syn match factorMixin /\<MIXIN:\s\+\S\+\>/
+syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
+syn match factorHook /\<HOOK:\s\+\S\+\s\+\S\+\>/
+syn match factorMain /\<MAIN:\s\+\S\+\>/
+syn match factorConstructor /\<C:\s\+\S\+\s\+\S\+\>/
syn match factorAlien /\<ALIEN:\s\+\d\+\>/
@@ -84,8 +103,6 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
"misc:
" HELP:
" ARTICLE:
-" PROVIDE:
-" MAIN:
"literals:
" PRIMITIVE:
@@ -103,8 +120,11 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline
-syn match factorStackEffectErr /\<)\>/
-syn region factorStackEffectErr start=/\<(\>/ end=/\<)\>/
+syn region factorMultiString matchgroup=factorMultiStringDelims start=/\<STRING:\s\+\S\+\>/ end=/^;$/ contains=factorMultiStringContents
+syn match factorMultiStringContents /.*/ contained
+
+"syn match factorStackEffectErr /\<)\>/
+"syn region factorStackEffectErr start=/\<(\>/ end=/\<)\>/
syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained
"adapted from lisp.vim
@@ -124,18 +144,18 @@ else
endif
if exists("g:factor_norainbow")
- syn region factorArray matchgroup=factorDelimiter start=/\<\(V\|H\|T\|W\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL
+ syn region factorArray matchgroup=factorDelimiter start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL
else
- syn region factorArray0 matchgroup=hlLevel0 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1
- syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2
- syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3
- syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4
- syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5
- syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6
- syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7
- syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8
- syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9
- syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(V\|H\|T\|W\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0
+ syn region factorArray0 matchgroup=hlLevel0 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1
+ syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2
+ syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3
+ syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4
+ syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5
+ syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6
+ syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7
+ syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8
+ syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9
+ syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(V\|H\|T\|W\|F\|B\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0
endif
syn match factorBracketErr /\<\]\>/
@@ -160,11 +180,21 @@ if version >= 508 || !exists("did_factor_syn_inits")
HiLink factorKeyword Keyword
HiLink factorOperator Operator
HiLink factorBoolean Boolean
- HiLink factorDefinition Typedef
+ HiLink factorDefnDelims Typedef
+ HiLink factorMethodDelims Typedef
+ HiLink factorGenericDelims Typedef
+ HiLink factorGenericNDelims Typedef
+ HiLink factorConstructor Typedef
+ HiLink factorPrivate Special
+ HiLink factorPrivateDefnDelims Special
+ HiLink factorPrivateMethodDelims Special
+ HiLink factorPGenericDelims Special
+ HiLink factorPGenericNDelims Special
HiLink factorString String
HiLink factorSbuf String
+ HiLink factorMultiStringContents String
+ HiLink factorMultiStringDelims Typedef
HiLink factorBracketErr Error
- HiLink factorStackEffectErr Error
HiLink factorComplex Number
HiLink factorRatio Number
HiLink factorBinary Number
@@ -183,14 +213,17 @@ if version >= 508 || !exists("did_factor_syn_inits")
HiLink factorCharErr Error
HiLink factorDelimiter Delimiter
HiLink factorBackslash Special
- HiLink factorCompileDirective Keyword
+ HiLink factorCompileDirective Typedef
HiLink factorSymbol Define
+ HiLink factorMixin Typedef
+ HiLink factorInstance Typedef
+ HiLink factorHook Typedef
+ HiLink factorMain Define
HiLink factorPostpone Define
HiLink factorDefer Define
HiLink factorForget Define
HiLink factorAlien Define
HiLink factorTuple Typedef
- HiLink factorGeneric Define
if &bg == "dark"
hi hlLevel0 ctermfg=red guifg=red1
From 4a4aeb821e96bfb68f5520310af40c382e2c5e2a Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Thu, 13 Mar 2008 15:22:16 +1100
Subject: [PATCH 03/38] semantic-db: got rid of uniq in favour of prune
---
extra/semantic-db/hierarchy/hierarchy.factor | 9 +++------
1 file changed, 3 insertions(+), 6 deletions(-)
diff --git a/extra/semantic-db/hierarchy/hierarchy.factor b/extra/semantic-db/hierarchy/hierarchy.factor
index 7d5f976909..7465d67664 100644
--- a/extra/semantic-db/hierarchy/hierarchy.factor
+++ b/extra/semantic-db/hierarchy/hierarchy.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors db.tuples kernel new-slots semantic-db
-semantic-db.relations sorting sequences sequences.deep ;
+USING: accessors db.tuples hashtables kernel new-slots
+semantic-db semantic-db.relations sorting sequences ;
IN: semantic-db.hierarchy
TUPLE: tree id children ;
@@ -34,9 +34,6 @@ C: <tree> tree
: get-node-hierarchy ( node-id -- tree )
dup children [ get-node-hierarchy ] map <tree> ;
-: uniq ( sorted-seq -- seq )
- f swap [ tuck = not ] subset nip ;
-
: (get-root-nodes) ( node-id -- root-nodes/node-id )
dup parents dup empty? [
drop
@@ -45,4 +42,4 @@ C: <tree> tree
] if ;
: get-root-nodes ( node-id -- root-nodes )
- (get-root-nodes) flatten natural-sort uniq ;
+ (get-root-nodes) flatten prune ;
From 88c0ca84ef4145b7825c53843d039889a145984d Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Thu, 13 Mar 2008 15:41:51 +1100
Subject: [PATCH 04/38] semantic-db: fix a unit test and USE a missing vocab
---
extra/semantic-db/hierarchy/hierarchy.factor | 2 +-
extra/semantic-db/semantic-db-tests.factor | 9 +++++----
2 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/extra/semantic-db/hierarchy/hierarchy.factor b/extra/semantic-db/hierarchy/hierarchy.factor
index 7465d67664..be0789ba5e 100644
--- a/extra/semantic-db/hierarchy/hierarchy.factor
+++ b/extra/semantic-db/hierarchy/hierarchy.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors db.tuples hashtables kernel new-slots
-semantic-db semantic-db.relations sorting sequences ;
+semantic-db semantic-db.relations sequences sequences.deep ;
IN: semantic-db.hierarchy
TUPLE: tree id children ;
diff --git a/extra/semantic-db/semantic-db-tests.factor b/extra/semantic-db/semantic-db-tests.factor
index 6c2c4d3e9e..257133c67f 100644
--- a/extra/semantic-db/semantic-db-tests.factor
+++ b/extra/semantic-db/semantic-db-tests.factor
@@ -1,6 +1,7 @@
-USING: accessors arrays continuations db db.sqlite db.tuples io.files
-kernel math namespaces semantic-db semantic-db.context
-semantic-db.hierarchy semantic-db.relations sequences tools.test
+USING: accessors arrays continuations db db.sqlite
+db.tuples io.files kernel math namespaces semantic-db
+semantic-db.context semantic-db.hierarchy
+semantic-db.relations sequences sorting tools.test
tools.walker ;
IN: semantic-db.tests
@@ -63,7 +64,7 @@ test-db [
[ { "bob" "fran" } ] [ "eve" get children [ node-content ] map ] unit-test
[ { "adam" "eve" } ] [ "bob" get parents [ node-content ] map ] unit-test
[ "fran" { "charlie" } ] [ "fran" get get-node-hierarchy dup tree-id node-content swap tree-children [ tree-id node-content ] map ] unit-test
- [ { "adam" "eve" } ] [ "charlie" get get-root-nodes [ node-content ] map ] unit-test
+ [ { "adam" "eve" } ] [ "charlie" get get-root-nodes [ node-content ] map natural-sort >array ] unit-test
[ { } ] [ "fran" get "charlie" get tuck un-parent-child parents [ node-content ] map ] unit-test
] with-context
] with-db
From d5572b62181e83599f048dc76b51474aae279da8 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 01:43:30 -0600
Subject: [PATCH 05/38] io.files-docs: add some file-info docs
---
core/io/files/files-docs.factor | 41 +++++++++++++++++++++++++--------
1 file changed, 32 insertions(+), 9 deletions(-)
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index 1ff972b505..6eb025b6fd 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -1,5 +1,5 @@
-USING: help.markup help.syntax io io.styles strings
-io.backend io.files.private quotations ;
+USING: help.markup help.syntax io io.styles strings calendar
+ io.backend io.files.private quotations ;
IN: io.files
ARTICLE: "file-streams" "Reading and writing files"
@@ -43,12 +43,18 @@ ARTICLE: "directories" "Directories"
{ $subsection make-directory }
{ $subsection make-directories } ;
+! ARTICLE: "file-types" "File Types"
+
+! { $table { +directory+ "" } }
+
+! ;
+
ARTICLE: "fs-meta" "File meta-data"
+
{ $subsection file-info }
{ $subsection link-info }
{ $subsection exists? }
{ $subsection directory? }
-{ $subsection file-length }
{ $subsection file-modified }
{ $subsection stat } ;
@@ -119,11 +125,26 @@ HELP: file-name
! need a $class-description file-info
HELP: file-info
+
{ $values { "path" "a pathname string" }
- { "info" "a file-info tuple" } }
+ { "info" file-info } }
{ $description "Queries the file system for meta data. "
"If path refers to a symbolic link, it is followed."
- "If the file does not exist, an exception is thrown." } ;
+ "If the file does not exist, an exception is thrown." }
+
+ { $class-description "File meta data" }
+
+ { $table
+ { "type" { "One of the following:"
+ { $list { $link +regular-file+ }
+ { $link +directory+ }
+ { $link +symbolic-link+ } } } }
+
+ { "size" "Size of the file in bytes" }
+ { "modified" { "Last modification " { $link timestamp } } } }
+
+ ;
+
! need a see also to link-info
HELP: link-info
@@ -135,6 +156,8 @@ HELP: link-info
"If the file does not exist, an exception is thrown." } ;
! need a see also to file-info
+{ file-info link-info } related-words
+
HELP: <file-reader>
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" { "stream" "an input stream" } }
{ "stream" "an input stream" } }
@@ -199,7 +222,7 @@ HELP: stat ( path -- directory? permissions length modified )
"Queries the file system for file meta data. If the file does not exist, outputs " { $link f } " for all four values."
} ;
-{ stat exists? directory? file-length file-modified } related-words
+{ stat exists? directory? file-modified } related-words
HELP: path+
{ $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
@@ -227,9 +250,9 @@ HELP: directory*
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
-HELP: file-length
-{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
-{ $description "Outputs the length of the file in bytes, or " { $link f } " if it does not exist." } ;
+! HELP: file-length
+! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
+! { $description "Outputs the length of the file in bytes, or " { $link f } " if it does not exist." } ;
HELP: file-modified
{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
From ce8828e00736299daac95a30a8f65e76a54b2c65 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 01:47:39 -0600
Subject: [PATCH 06/38] io.files-docs: fix bug
---
core/io/files/files-docs.factor | 6 +-----
1 file changed, 1 insertion(+), 5 deletions(-)
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index 6eb025b6fd..55458b96b8 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -141,7 +141,7 @@ HELP: file-info
{ $link +symbolic-link+ } } } }
{ "size" "Size of the file in bytes" }
- { "modified" { "Last modification " { $link timestamp } } } }
+ { "modified" "Last modification timestamp." } }
;
@@ -250,10 +250,6 @@ HELP: directory*
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
-! HELP: file-length
-! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
-! { $description "Outputs the length of the file in bytes, or " { $link f } " if it does not exist." } ;
-
HELP: file-modified
{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
{ $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
From 979a81a25d0c509aac01fa601fb7fe4d3efaf21a Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 01:48:11 -0600
Subject: [PATCH 07/38] io.files-docs: fix another bug (reference to calendar
which is in extra)
---
core/io/files/files-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index 55458b96b8..a6dd1e0818 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io io.styles strings calendar
+USING: help.markup help.syntax io io.styles strings
io.backend io.files.private quotations ;
IN: io.files
From c3391ac0ae1b6420a6b37f55fab5b77a4b2ee759 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 01:49:21 -0600
Subject: [PATCH 08/38] Remove file-length
---
core/io/files/files.factor | 2 +-
extra/ui/freetype/freetype.factor | 3 ++-
2 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index cbb6e77ff9..104c38518a 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -220,7 +220,7 @@ M: pathname <=> [ pathname-string ] compare ;
>r <file-reader> r> with-stream ; inline
: file-contents ( path encoding -- str )
- dupd [ file-length read ] with-file-reader ;
+ dupd [ file-info file-info-size read ] with-file-reader ;
: with-file-writer ( path encoding quot -- )
>r <file-writer> r> with-stream ; inline
diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor
index 8078ec4a33..8dca72c29e 100755
--- a/extra/ui/freetype/freetype.factor
+++ b/extra/ui/freetype/freetype.factor
@@ -4,6 +4,7 @@ USING: alien alien.accessors alien.c-types arrays io kernel libc
math math.vectors namespaces opengl opengl.gl prettyprint assocs
sequences io.files io.styles continuations freetype
ui.gadgets.worlds ui.render ui.backend byte-arrays ;
+
IN: ui.freetype
TUPLE: freetype-renderer ;
@@ -74,7 +75,7 @@ M: freetype-renderer free-fonts ( world -- )
: open-face ( font style -- face )
ttf-name ttf-path
dup malloc-file-contents
- swap file-length
+ swap file-info file-info-size
(open-face) ;
SYMBOL: dpi
From f341b2a02c7d1ae749ce36b389a241e497d889b1 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:35:54 -0500
Subject: [PATCH 09/38] Clean up tools.vocabs a bit
---
extra/benchmark/benchmark.factor | 14 +++++++-------
extra/editors/editors.factor | 3 +--
extra/tools/vocabs/vocabs.factor | 10 +++++-----
3 files changed, 13 insertions(+), 14 deletions(-)
diff --git a/extra/benchmark/benchmark.factor b/extra/benchmark/benchmark.factor
index 7eb5f10276..26f1a9e96d 100755
--- a/extra/benchmark/benchmark.factor
+++ b/extra/benchmark/benchmark.factor
@@ -2,27 +2,27 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel vocabs vocabs.loader tools.time tools.vocabs
arrays assocs io.styles io help.markup prettyprint sequences
-continuations debugger ;
+continuations debugger combinators.cleave ;
IN: benchmark
: run-benchmark ( vocab -- result )
- [ dup require [ run ] benchmark ] [ error. drop f f ] recover 2array ;
+ [ [ require ] [ [ run ] benchmark nip ] bi ] curry
+ [ error. f ] recover ;
: run-benchmarks ( -- assoc )
- "benchmark" all-child-vocabs values concat [ vocab-name ] map
+ "benchmark" all-child-vocabs-seq
[ dup run-benchmark ] { } map>assoc ;
: benchmarks. ( assoc -- )
standard-table-style [
[
[ "Benchmark" write ] with-cell
- [ "Run time (ms)" write ] with-cell
- [ "GC time (ms)" write ] with-cell
+ [ "Time (ms)" write ] with-cell
] with-row
[
[
- swap [ dup ($vocab-link) ] with-cell
- first2 pprint-cell pprint-cell
+ [ [ 1array $vocab-link ] with-cell ]
+ [ pprint-cell ] bi*
] with-row
] assoc-each
] tabular-output ;
diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor
index bb3fd05400..4ee906bccb 100755
--- a/extra/editors/editors.factor
+++ b/extra/editors/editors.factor
@@ -13,8 +13,7 @@ M: no-edit-hook summary
SYMBOL: edit-hook
: available-editors ( -- seq )
- "editors" all-child-vocabs
- values concat [ vocab-name ] map ;
+ "editors" all-child-vocabs-seq [ vocab-name ] map ;
: editor-restarts ( -- alist )
available-editors
diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor
index ba6baa543f..21b8da8910 100755
--- a/extra/tools/vocabs/vocabs.factor
+++ b/extra/tools/vocabs/vocabs.factor
@@ -210,11 +210,11 @@ MEMO: all-vocabs-seq ( -- seq )
] { } map>assoc
f rot unrooted-child-vocabs 2array add ;
-: load-children ( prefix -- )
- all-child-vocabs values concat
- filter-dangerous
- require-all
- load-failures. ;
+: all-child-vocabs-seq ( prefix -- assoc )
+ vocab-roots get swap [
+ dupd (all-child-vocabs)
+ [ vocab-dir? ] with subset
+ ] curry map concat ;
: map>set ( seq quot -- )
map concat prune natural-sort ; inline
From 37d5ca384ec8382b4e7fdfefe13d4dcb3d5c06aa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:36:13 -0500
Subject: [PATCH 10/38] Clean up cross product
---
extra/math/matrices/matrices.factor | 27 +++++++++++++--------------
1 file changed, 13 insertions(+), 14 deletions(-)
mode change 100644 => 100755 extra/math/matrices/matrices.factor
diff --git a/extra/math/matrices/matrices.factor b/extra/math/matrices/matrices.factor
old mode 100644
new mode 100755
index df9a87fb40..e74ffc64d2
--- a/extra/math/matrices/matrices.factor
+++ b/extra/math/matrices/matrices.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel sequences math math.functions
-math.vectors ;
+math.vectors combinators.cleave ;
IN: math.matrices
! Matrices
@@ -33,23 +33,22 @@ IN: math.matrices
: mmax ( m -- n ) >r -1/0. r> [ [ max ] each ] each ;
: mnorm ( m -- n ) dup mmax abs m/n ;
-: cross-i ( vec1 vec2 -- i )
- over third over second * >r
- swap second swap third * r> - ;
+<PRIVATE
-: cross-j ( vec1 vec2 -- j )
- over first over third * >r
- swap third swap first * r> - ;
+: x first ; inline
+: y second ; inline
+: z third ; inline
-: cross-k ( vec1 vec2 -- k )
- over first over second * >r
- swap second swap first * r> - ;
+: i [ [ y ] [ z ] bi* * ] [ [ z ] [ y ] bi* * ] 2bi - ;
+: j [ [ z ] [ x ] bi* * ] [ [ x ] [ z ] bi* * ] 2bi - ;
+: k [ [ y ] [ x ] bi* * ] [ [ x ] [ y ] bi* * ] 2bi - ;
-: cross ( vec1 vec2 -- vec3 )
- [ cross-i ] 2keep [ cross-j ] 2keep cross-k 3array ;
+PRIVATE>
+
+: cross ( vec1 vec2 -- vec3 ) [ i ] [ j ] [ k ] 2tri 3array ;
: proj ( v u -- w )
- [ [ v. ] keep norm-sq / ] keep n*v ;
+ [ [ v. ] [ norm-sq ] bi / ] keep n*v ;
: (gram-schmidt) ( v seq -- newseq )
[ dupd proj v- ] each ;
From b95d5beba165923082f4be3fdb25f34bab2a8b33 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:38:01 -0500
Subject: [PATCH 11/38] Fix erronous stack comment in fasta
---
extra/benchmark/fasta/fasta.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
mode change 100644 => 100755 extra/benchmark/fasta/fasta.factor
diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor
old mode 100644
new mode 100755
index 3c9c78d358..30c3beb1ef
--- a/extra/benchmark/fasta/fasta.factor
+++ b/extra/benchmark/fasta/fasta.factor
@@ -51,7 +51,7 @@ HINTS: random fixnum ;
dup keys >byte-array
swap values >float-array unclip [ + ] accumulate swap add ;
-:: select-random ( seed chars floats -- elt )
+:: select-random ( seed chars floats -- seed elt )
floats seed random -rot
[ >= ] curry find drop
chars nth-unsafe ; inline
@@ -71,7 +71,7 @@ HINTS: random fixnum ;
write-description
[ make-random-fasta ] 2curry split-lines ; inline
-:: make-repeat-fasta ( k len alu -- )
+:: make-repeat-fasta ( k len alu -- k' )
[let | kn [ alu length ] |
len [ k + kn mod alu nth-unsafe ] B{ } map-as print
k len +
From dec21de6c3dd1c7d04978fa456bbd9a4281f6b05 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:38:11 -0500
Subject: [PATCH 12/38] Load vocab browser
---
extra/bootstrap/tools/tools.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/extra/bootstrap/tools/tools.factor b/extra/bootstrap/tools/tools.factor
index f395a903c3..0bf7a032ee 100755
--- a/extra/bootstrap/tools/tools.factor
+++ b/extra/bootstrap/tools/tools.factor
@@ -12,5 +12,6 @@ USING: vocabs.loader sequences ;
"tools.time"
"tools.threads"
"tools.vocabs"
+ "tools.vocabs.browser"
"editors"
} [ require ] each
From 618962aa7128b0c52a15f083110f2734f5dea3f8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:39:05 -0500
Subject: [PATCH 13/38] Fix minor bunny bug
---
extra/bunny/deploy.factor | 14 ++++++++------
extra/bunny/outlined/outlined.factor | 6 +++---
extra/opengl/demo-support/demo-support.factor | 13 +++++++------
3 files changed, 18 insertions(+), 15 deletions(-)
mode change 100644 => 100755 extra/bunny/outlined/outlined.factor
mode change 100644 => 100755 extra/opengl/demo-support/demo-support.factor
diff --git a/extra/bunny/deploy.factor b/extra/bunny/deploy.factor
index 12aaffc19c..a3f6174726 100755
--- a/extra/bunny/deploy.factor
+++ b/extra/bunny/deploy.factor
@@ -1,12 +1,14 @@
USING: tools.deploy.config ;
-V{
+H{
+ { deploy-math? t }
+ { deploy-reflection 1 }
+ { deploy-name "Bunny" }
+ { deploy-threads? t }
+ { deploy-word-props? f }
+ { "stop-after-last-window?" t }
{ deploy-ui? t }
{ deploy-io 3 }
- { deploy-reflection 1 }
{ deploy-compiler? t }
- { deploy-math? t }
- { deploy-word-props? f }
+ { deploy-word-defs? f }
{ deploy-c-types? f }
- { "stop-after-last-window?" t }
- { deploy-name "Bunny" }
}
diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor
old mode 100644
new mode 100755
index d7064ebdde..012aa1fd78
--- a/extra/bunny/outlined/outlined.factor
+++ b/extra/bunny/outlined/outlined.factor
@@ -1,7 +1,7 @@
USING: arrays bunny.model bunny.cel-shaded
combinators.lib continuations kernel math multiline
opengl opengl.shaders opengl.framebuffers opengl.gl
-opengl.capabilities sequences ui.gadgets ;
+opengl.capabilities sequences ui.gadgets combinators.cleave ;
IN: bunny.outlined
STRING: outlined-pass1-fragment-shader-main-source
@@ -177,7 +177,7 @@ TUPLE: bunny-outlined
[ bunny-outlined-normal-texture [ delete-texture ] when* ]
[ bunny-outlined-depth-texture [ delete-texture ] when* ]
[ f swap set-bunny-outlined-framebuffer-dim ]
- } call-with
+ } cleave
] [ drop ] if ;
: remake-framebuffer-if-needed ( draw -- )
@@ -237,4 +237,4 @@ M: bunny-outlined dispose
[ bunny-outlined-pass1-program [ delete-gl-program ] when* ]
[ bunny-outlined-pass2-program [ delete-gl-program ] when* ]
[ dispose-framebuffer ]
- } call-with ;
+ } cleave ;
diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor
old mode 100644
new mode 100755
index 59b7a3bcc3..8fee55962f
--- a/extra/opengl/demo-support/demo-support.factor
+++ b/extra/opengl/demo-support/demo-support.factor
@@ -1,5 +1,5 @@
USING: arrays combinators.lib kernel math math.functions math.vectors namespaces
- opengl opengl.gl sequences ui ui.gadgets ui.gestures ui.render ;
+ opengl opengl.gl sequences ui ui.gadgets ui.gestures ui.render combinators.cleave ;
IN: opengl.demo-support
: NEAR-PLANE 1.0 64.0 / ; inline
@@ -47,14 +47,15 @@ M: demo-gadget pref-dim* ( gadget -- dim )
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
GL_MODELVIEW glMatrixMode
glLoadIdentity
- { [ >r 0.0 0.0 r> demo-gadget-distance neg glTranslatef ]
- [ demo-gadget-pitch 1.0 0.0 0.0 glRotatef ]
- [ demo-gadget-yaw 0.0 1.0 0.0 glRotatef ] } call-with ;
+ [ >r 0.0 0.0 r> demo-gadget-distance neg glTranslatef ]
+ [ demo-gadget-pitch 1.0 0.0 0.0 glRotatef ]
+ [ demo-gadget-yaw 0.0 1.0 0.0 glRotatef ]
+ tri ;
: reset-last-drag-rel ( -- )
- { 0 0 } last-drag-loc set ;
+ { 0 0 } last-drag-loc set-global ;
: last-drag-rel ( -- rel )
- drag-loc [ last-drag-loc get v- ] keep last-drag-loc set ;
+ drag-loc [ last-drag-loc get v- ] keep last-drag-loc set-global ;
: drag-yaw-pitch ( -- yaw pitch )
last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
From fd9bf040baa678235d44c71353b38d950971e77d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:41:57 -0500
Subject: [PATCH 14/38] Removing call-with call-with2; use cleave instead
---
extra/combinators/cleave/cleave.factor | 3 ++
extra/combinators/lib/lib.factor | 6 ---
extra/io/windows/files/files.factor | 47 ++++++++++-------------
extra/io/windows/launcher/launcher.factor | 14 +++----
extra/opengl/shaders/shaders.factor | 4 +-
5 files changed, 32 insertions(+), 42 deletions(-)
mode change 100644 => 100755 extra/combinators/cleave/cleave.factor
mode change 100644 => 100755 extra/io/windows/files/files.factor
mode change 100644 => 100755 extra/opengl/shaders/shaders.factor
diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor
old mode 100644
new mode 100755
index 5359512610..383d5ca9ac
--- a/extra/combinators/cleave/cleave.factor
+++ b/extra/combinators/cleave/cleave.factor
@@ -17,6 +17,9 @@ IN: combinators.cleave
: 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline
+: 2tri ( obj obj quot quot quot -- val val val )
+ >r >r 2keep r> 2keep r> call ; inline
+
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! General cleave
diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor
index f65b94dc11..7c93f805cd 100755
--- a/extra/combinators/lib/lib.factor
+++ b/extra/combinators/lib/lib.factor
@@ -133,9 +133,6 @@ MACRO: parallel-call ( quots -- )
: (make-call-with) ( quots -- quot )
[ [ keep ] curry ] map concat [ drop ] append ;
-MACRO: call-with ( quots -- )
- (make-call-with) ;
-
MACRO: map-call-with ( quots -- )
[ (make-call-with) ] keep length [ narray ] curry compose ;
@@ -143,9 +140,6 @@ MACRO: map-call-with ( quots -- )
[ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
[ 2drop ] append ;
-MACRO: call-with2 ( quots -- )
- (make-call-with2) ;
-
MACRO: map-call-with2 ( quots -- )
[ (make-call-with2) ] keep length [ narray ] curry append ;
diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor
old mode 100644
new mode 100755
index 3d51e65116..2180ff7901
--- a/extra/io/windows/files/files.factor
+++ b/extra/io/windows/files/files.factor
@@ -3,7 +3,7 @@
USING: alien.c-types io.files io.windows kernel
math windows windows.kernel32 combinators.cleave
windows.time calendar combinators math.functions
-sequences combinators.lib namespaces words symbols ;
+sequences namespaces words symbols ;
IN: io.windows.files
SYMBOLS: +read-only+ +hidden+ +system+
@@ -11,34 +11,27 @@ SYMBOLS: +read-only+ +hidden+ +system+
+sparse-file+ +reparse-point+ +compressed+ +offline+
+not-content-indexed+ +encrypted+ ;
-: expand-constants ( word/obj -- obj'/obj )
- dup word? [ execute ] when ;
-
-: get-flags ( n seq -- seq' )
- [
- [
- first2 expand-constants
- [ swapd mask? [ , ] [ drop ] if ] 2curry
- ] map call-with
- ] { } make ;
+: win32-file-attribute ( n attr symbol -- n )
+ >r dupd mask? [ r> , ] [ r> drop ] if ;
: win32-file-attributes ( n -- seq )
- {
- { +read-only+ FILE_ATTRIBUTE_READONLY }
- { +hidden+ FILE_ATTRIBUTE_HIDDEN }
- { +system+ FILE_ATTRIBUTE_SYSTEM }
- { +directory+ FILE_ATTRIBUTE_DIRECTORY }
- { +archive+ FILE_ATTRIBUTE_ARCHIVE }
- { +device+ FILE_ATTRIBUTE_DEVICE }
- { +normal+ FILE_ATTRIBUTE_NORMAL }
- { +temporary+ FILE_ATTRIBUTE_TEMPORARY }
- { +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE }
- { +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT }
- { +compressed+ FILE_ATTRIBUTE_COMPRESSED }
- { +offline+ FILE_ATTRIBUTE_OFFLINE }
- { +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED }
- { +encrypted+ FILE_ATTRIBUTE_ENCRYPTED }
- } get-flags ;
+ [
+ FILE_ATTRIBUTE_READONLY +read-only+ win32-file-attribute
+ FILE_ATTRIBUTE_HIDDEN +hidden+ win32-file-attribute
+ FILE_ATTRIBUTE_SYSTEM +system+ win32-file-attribute
+ FILE_ATTRIBUTE_DIRECTORY +directory+ win32-file-attribute
+ FILE_ATTRIBUTE_ARCHIVE +archive+ win32-file-attribute
+ FILE_ATTRIBUTE_DEVICE +device+ win32-file-attribute
+ FILE_ATTRIBUTE_NORMAL +normal+ win32-file-attribute
+ FILE_ATTRIBUTE_TEMPORARY +temporary+ win32-file-attribute
+ FILE_ATTRIBUTE_SPARSE_FILE +sparse-file+ win32-file-attribute
+ FILE_ATTRIBUTE_REPARSE_POINT +reparse-point+ win32-file-attribute
+ FILE_ATTRIBUTE_COMPRESSED +compressed+ win32-file-attribute
+ FILE_ATTRIBUTE_OFFLINE +offline+ win32-file-attribute
+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED +not-content-indexed+ win32-file-attribute
+ FILE_ATTRIBUTE_ENCRYPTED +encrypted+ win32-file-attribute
+ drop
+ ] { } make ;
: win32-file-type ( n -- symbol )
FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor
index b09d867e10..3e49f1dc10 100755
--- a/extra/io/windows/launcher/launcher.factor
+++ b/extra/io/windows/launcher/launcher.factor
@@ -5,7 +5,7 @@ io.windows io.windows.nt.pipes libc io.nonblocking
io.streams.duplex windows.types math windows.kernel32 windows
namespaces io.launcher kernel sequences windows.errors assocs
splitting system threads init strings combinators
-io.backend new-slots accessors ;
+io.backend new-slots accessors concurrency.flags ;
IN: io.windows.launcher
TUPLE: CreateProcess-args
@@ -137,18 +137,18 @@ M: windows-io kill-process* ( handle -- )
dup HEX: ffffffff = [ win32-error ] when
dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;
+SYMBOL: wait-flag
+
: wait-loop ( -- )
processes get dup assoc-empty?
- [ drop f sleep-until ]
+ [ drop wait-flag get-global lower-flag ]
[ wait-for-processes [ 100 sleep ] when ] if ;
-SYMBOL: wait-thread
-
: start-wait-thread ( -- )
- [ wait-loop t ] "Process wait" spawn-server
- wait-thread set-global ;
+ <flag> wait-flag set-global
+ [ wait-loop t ] "Process wait" spawn-server drop ;
M: windows-io register-process
- drop wait-thread get-global interrupt ;
+ drop wait-flag get-global raise-flag ;
[ start-wait-thread ] "io.windows.launcher" add-init-hook
diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor
old mode 100644
new mode 100755
index fbbc4c496a..ceda434c75
--- a/extra/opengl/shaders/shaders.factor
+++ b/extra/opengl/shaders/shaders.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel opengl.gl alien.c-types continuations namespaces
assocs alien libc opengl math sequences combinators.lib
-macros arrays ;
+macros arrays combinators.cleave ;
IN: opengl.shaders
: with-gl-shader-source-ptr ( string quot -- )
@@ -117,7 +117,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
: (make-with-gl-program) ( uniforms quot -- q )
[
\ dup ,
- [ swap (with-gl-program-uniforms) , \ call-with , % ]
+ [ swap (with-gl-program-uniforms) , \ cleave , % ]
[ ] make ,
\ (with-gl-program) ,
] [ ] make ;
From 0ed8bfe276636364834be5b52f6953b0878a6b8e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:44:58 -0500
Subject: [PATCH 15/38] Documentation updates
---
core/compiler/errors/errors-docs.factor | 2 +-
core/source-files/source-files-docs.factor | 4 ++--
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/core/compiler/errors/errors-docs.factor b/core/compiler/errors/errors-docs.factor
index 6cce72eed0..dd71eb704f 100755
--- a/core/compiler/errors/errors-docs.factor
+++ b/core/compiler/errors/errors-docs.factor
@@ -9,7 +9,7 @@ ARTICLE: "compiler-errors" "Compiler warnings and errors"
{ $subsection :errors }
{ $subsection :warnings }
{ $subsection :linkage }
-"Words such as " { $link require } " and " { $link refresh-all } " use a combinator which counts errors and prints a report at the end:"
+"Words such as " { $link require } " use a combinator which counts errors and prints a report at the end:"
{ $link with-compiler-errors } ;
HELP: compiler-errors
diff --git a/core/source-files/source-files-docs.factor b/core/source-files/source-files-docs.factor
index 2371c27e52..31c2defd19 100755
--- a/core/source-files/source-files-docs.factor
+++ b/core/source-files/source-files-docs.factor
@@ -3,7 +3,7 @@ definitions quotations compiler.units ;
IN: source-files
ARTICLE: "source-files" "Source files"
-"Words in the " { $vocab-link "source-files" } " vocabulary are used to keep track of loaded source files. This is used to implement features such as " { $link refresh-all } "."
+"Words in the " { $vocab-link "source-files" } " vocabulary are used to keep track of loaded source files. This is used to implement " { $link "tools.vocabs" } "."
$nl
"The source file database:"
{ $subsection source-files }
@@ -75,7 +75,7 @@ HELP: record-form
$low-level-note ;
HELP: reset-checksums
-{ $description "Resets recorded modification times and CRC32 checksums for all loaded source files, creating a checkpoint for " { $link refresh } "." } ;
+{ $description "Resets recorded modification times and CRC32 checksums for all loaded source files, creating a checkpoint for " { $link "tools.vocabs" } "." } ;
HELP: forget-source
{ $values { "path" "a pathname string" } }
From cb2863ea5f566f62beda44c9a791c6727ac62055 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:45:08 -0500
Subject: [PATCH 16/38] Add tools.vocabs to default using
---
core/parser/parser.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 81c9b68668..cc28f09855 100755
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -416,6 +416,7 @@ SYMBOL: interactive-vocabs
"tools.test"
"tools.threads"
"tools.time"
+ "tools.vocabs"
"vocabs"
"vocabs.loader"
"words"
From 5d1dbeeaf67de3302c6ddcc5422271820aa81145 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:45:34 -0500
Subject: [PATCH 17/38] Help updates
---
extra/help/markup/markup.factor | 3 ++-
extra/help/tutorial/tutorial.factor | 2 +-
2 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor
index d81e9cd81e..710671857e 100755
--- a/extra/help/markup/markup.factor
+++ b/extra/help/markup/markup.factor
@@ -169,7 +169,8 @@ M: f print-element drop ;
] if
] ($subsection) ;
-: $vocab-link ( element -- ) first dup ($vocab-link) ;
+: $vocab-link ( element -- )
+ first dup vocab-name swap ($vocab-link) ;
: $vocabulary ( element -- )
first word-vocabulary [
diff --git a/extra/help/tutorial/tutorial.factor b/extra/help/tutorial/tutorial.factor
index f6b1faf385..f01840d927 100755
--- a/extra/help/tutorial/tutorial.factor
+++ b/extra/help/tutorial/tutorial.factor
@@ -1,6 +1,6 @@
USING: help.markup help.syntax ui.commands ui.operations
ui.tools.search ui.tools.workspace editors vocabs.loader
-kernel sequences prettyprint tools.test strings
+kernel sequences prettyprint tools.test tools.vocabs strings
unicode.categories unicode.case ;
IN: help.tutorial
From cf4dee6e0fd14de3ff83aa55e495622ddf8c8eb0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:46:25 -0500
Subject: [PATCH 18/38] Tree-shaker now computes which globals it needs to
strip, not which ones it needs to keep
---
extra/tools/deploy/backend/backend.factor | 48 +++---
extra/tools/deploy/config/config.factor | 2 +-
extra/tools/deploy/deploy-tests.factor | 24 ++-
extra/tools/deploy/shaker/shaker.factor | 190 ++++++++++++++--------
extra/tools/deploy/test/1/1.factor | 6 +
extra/tools/deploy/test/1/deploy.factor | 14 ++
extra/tools/deploy/test/2/2.factor | 6 +
extra/tools/deploy/test/2/deploy.factor | 14 ++
extra/tools/deploy/test/3/3.factor | 8 +
extra/tools/deploy/test/3/deploy.factor | 14 ++
10 files changed, 237 insertions(+), 89 deletions(-)
create mode 100755 extra/tools/deploy/test/1/1.factor
create mode 100755 extra/tools/deploy/test/1/deploy.factor
create mode 100755 extra/tools/deploy/test/2/2.factor
create mode 100755 extra/tools/deploy/test/2/deploy.factor
create mode 100755 extra/tools/deploy/test/3/3.factor
create mode 100755 extra/tools/deploy/test/3/deploy.factor
diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor
index 301ffa3378..15dc32115e 100755
--- a/extra/tools/deploy/backend/backend.factor
+++ b/extra/tools/deploy/backend/backend.factor
@@ -34,31 +34,33 @@ IN: tools.deploy.backend
: ?, [ , ] [ drop ] if ;
-: bootstrap-profile ( config -- profile )
+: bootstrap-profile ( -- profile )
[
- [
- "math" deploy-math? get ?,
- "compiler" deploy-compiler? get ?,
- "ui" deploy-ui? get ?,
- "io" native-io? ?,
- ] { } make
- ] bind ;
+ "math" deploy-math? get ?,
+ "compiler" deploy-compiler? get ?,
+ "ui" deploy-ui? get ?,
+ "io" native-io? ?,
+ ] { } make ;
-: staging-image-name ( profile -- name )
- "staging." swap bootstrap-profile "-" join ".image" 3append ;
+: staging-image-name ( -- name )
+ "staging."
+ bootstrap-profile strip-word-names? [ "strip" add ] when
+ "-" join ".image" 3append ;
: staging-command-line ( config -- flags )
[
- "-i=" my-boot-image-name append ,
+ [
+ "-i=" my-boot-image-name append ,
- "-output-image=" over staging-image-name append ,
+ "-output-image=" staging-image-name append ,
- "-include=" swap bootstrap-profile " " join append ,
+ "-include=" bootstrap-profile " " join append ,
- "-no-stack-traces" ,
+ strip-word-names? [ "-no-stack-traces" , ] when
- "-no-user-init" ,
- ] { } make ;
+ "-no-user-init" ,
+ ] { } make
+ ] bind ;
: run-factor ( vm flags -- )
swap add* dup . run-with-output ; inline
@@ -68,16 +70,18 @@ IN: tools.deploy.backend
: deploy-command-line ( image vocab config -- flags )
[
- "-i=" swap staging-image-name append ,
+ [
+ "-i=" staging-image-name append ,
- "-run=tools.deploy.shaker" ,
+ "-run=tools.deploy.shaker" ,
- "-deploy-vocab=" swap append ,
+ "-deploy-vocab=" swap append ,
- "-output-image=" swap append ,
+ "-output-image=" swap append ,
- "-no-stack-traces" ,
- ] { } make ;
+ strip-word-names? [ "-no-stack-traces" , ] when
+ ] { } make
+ ] bind ;
: make-deploy-image ( vm image vocab config -- )
make-boot-image
diff --git a/extra/tools/deploy/config/config.factor b/extra/tools/deploy/config/config.factor
index 64f863b730..78f1d487de 100755
--- a/extra/tools/deploy/config/config.factor
+++ b/extra/tools/deploy/config/config.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: vocabs.loader io.files io kernel sequences assocs
splitting parser prettyprint namespaces math vocabs
-hashtables tools.browser ;
+hashtables tools.vocabs ;
IN: tools.deploy.config
SYMBOL: deploy-name
diff --git a/extra/tools/deploy/deploy-tests.factor b/extra/tools/deploy/deploy-tests.factor
index d473d8f640..0f770f7b60 100755
--- a/extra/tools/deploy/deploy-tests.factor
+++ b/extra/tools/deploy/deploy-tests.factor
@@ -5,7 +5,7 @@ tools.deploy.backend math ;
: shake-and-bake
"." resource-path [
vm
- "hello.image" temp-file
+ "test.image" temp-file
rot dup deploy-config make-deploy-image
] with-directory ;
@@ -15,8 +15,30 @@ tools.deploy.backend math ;
"hello.image" temp-file file-length 500000 <=
] unit-test
+[ ] [ "sudoku" shake-and-bake ] unit-test
+
+[ t ] [
+ "hello.image" temp-file file-length 1500000 <=
+] unit-test
+
[ ] [ "hello-ui" shake-and-bake ] unit-test
[ t ] [
"hello.image" temp-file file-length 2000000 <=
] unit-test
+
+[ ] [ "bunny" shake-and-bake ] unit-test
+
+[ t ] [
+ "hello.image" temp-file file-length 3000000 <=
+] unit-test
+
+[ ] [
+ "tools.deploy.test.1" shake-and-bake
+ vm "-i=" "test.image" temp-file append try-process
+] unit-test
+
+[ ] [
+ "tools.deploy.test.2" shake-and-bake
+ vm "-i=" "test.image" temp-file append try-process
+] unit-test
diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor
index 0ddc2d5707..bddf3d76c9 100755
--- a/extra/tools/deploy/shaker/shaker.factor
+++ b/extra/tools/deploy/shaker/shaker.factor
@@ -1,11 +1,29 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces continuations.private kernel.private init
-assocs kernel vocabs words sequences memory io system arrays
-continuations math definitions mirrors splitting parser classes
-inspector layouts vocabs.loader prettyprint.config prettyprint
-debugger io.streams.c io.streams.duplex io.files io.backend
-quotations words.private tools.deploy.config compiler.units ;
+USING: qualified io.streams.c init fry namespaces assocs kernel
+parser tools.deploy.config vocabs sequences words words.private
+memory kernel.private continuations io prettyprint
+vocabs.loader debugger system strings ;
+QUALIFIED: bootstrap.stage2
+QUALIFIED: classes
+QUALIFIED: compiler.errors.private
+QUALIFIED: compiler.units
+QUALIFIED: continuations
+QUALIFIED: definitions
+QUALIFIED: init
+QUALIFIED: inspector
+QUALIFIED: io.backend
+QUALIFIED: io.nonblocking
+QUALIFIED: io.thread
+QUALIFIED: layouts
+QUALIFIED: libc.private
+QUALIFIED: libc.private
+QUALIFIED: listener
+QUALIFIED: prettyprint.config
+QUALIFIED: random.private
+QUALIFIED: source-files
+QUALIFIED: threads
+QUALIFIED: vocabs
IN: tools.deploy.shaker
: strip-init-hooks ( -- )
@@ -43,9 +61,6 @@ IN: tools.deploy.shaker
run-file
] when ;
-: strip-assoc ( retained-keys assoc -- newassoc )
- swap [ nip member? ] curry assoc-subset ;
-
: strip-word-names ( words -- )
"Stripping word names" show
[ f over set-word-name f swap set-word-vocabulary ] each ;
@@ -57,8 +72,11 @@ IN: tools.deploy.shaker
: strip-word-props ( retain-props words -- )
"Stripping word properties" show
[
- [ word-props strip-assoc f assoc-like ] keep
- set-word-props
+ [
+ word-props swap
+ '[ , nip member? ] assoc-subset
+ f assoc-like
+ ] keep set-word-props
] with each ;
: retained-props ( -- seq )
@@ -81,10 +99,101 @@ IN: tools.deploy.shaker
strip-word-names? [ dup strip-word-names ] when
2drop ;
-: strip-environment ( retain-globals -- )
+: strip-recompile-hook ( -- )
+ [ [ f ] { } map>assoc ]
+ compiler.units:recompile-hook
+ set-global ;
+
+: strip-vocab-globals ( except names -- words )
+ [ child-vocabs [ words ] map concat ] map concat seq-diff ;
+
+: stripped-globals ( -- seq )
+ [
+ random.private:mt ,
+
+ {
+ bootstrap.stage2:bootstrap-time
+ continuations:error
+ continuations:error-continuation
+ continuations:error-thread
+ continuations:restarts
+ error-hook
+ init:init-hooks
+ inspector:inspector-hook
+ io.thread:io-thread
+ libc.private:mallocs
+ source-files:source-files
+ stderr
+ stdio
+ } %
+
+ deploy-threads? [
+ threads:initial-thread ,
+ ] unless
+
+ strip-io? [ io.backend:io-backend , ] when
+
+ { io.backend:io-backend io.nonblocking:default-buffer-size }
+ { "alarms" "io" "tools" } strip-vocab-globals %
+
+ strip-dictionary? [
+ { } { "cpu" } strip-vocab-globals %
+
+ {
+ vocabs:dictionary
+ lexer-factory
+ vocabs:load-vocab-hook
+ layouts:num-tags
+ layouts:num-types
+ layouts:tag-mask
+ layouts:tag-numbers
+ layouts:type-numbers
+ classes:typemap
+ vocab-roots
+ definitions:crossref
+ compiled-crossref
+ interactive-vocabs
+ word
+ compiler.units:recompile-hook
+ listener:listener-hook
+ lexer-factory
+ classes:update-map
+ classes:class<map
+ } %
+ ] when
+
+ strip-prettyprint? [
+ {
+ prettyprint.config:margin
+ prettyprint.config:string-limit
+ prettyprint.config:tab-size
+ } %
+ ] when
+
+ strip-debugger? [
+ {
+ compiler.errors.private:compiler-errors
+ continuations:thread-error-hook
+ } %
+ ] when
+
+ deploy-c-types? get [
+ "c-types" "alien.c-types" lookup ,
+ ] unless
+
+ deploy-ui? get [
+ "ui-error-hook" "ui.gadgets.worlds" lookup ,
+ ] when
+ ] { } make ;
+
+: strip-globals ( stripped-globals -- )
strip-globals? [
- "Stripping environment" show
- global strip-assoc 21 setenv
+ "Stripping globals" show
+ global swap
+ '[ drop , member? not ] assoc-subset
+ [ drop string? not ] assoc-subset ! strip CLI args
+ dup keys .
+ 21 setenv
] [ drop ] if ;
: finish-deploy ( final-image -- )
@@ -108,55 +217,6 @@ SYMBOL: deploy-vocab
] [ ] make "Boot quotation: " write dup . flush
set-boot-quot ;
-: retained-globals ( -- seq )
- [
- builtins ,
- strip-io? [ io-backend , ] unless
-
- strip-dictionary? [
- {
- dictionary
- inspector-hook
- lexer-factory
- load-vocab-hook
- num-tags
- num-types
- tag-bits
- tag-mask
- tag-numbers
- typemap
- vocab-roots
- } %
- ] unless
-
- strip-prettyprint? [
- {
- tab-size
- margin
- } %
- ] unless
-
- deploy-c-types? get [
- "c-types" "alien.c-types" lookup ,
- ] when
-
- native-io? [
- "default-buffer-size" "io.nonblocking" lookup ,
- ] when
-
- deploy-ui? get [
- "ui" child-vocabs
- "cocoa" child-vocabs
- deploy-vocab get child-vocabs 3append
- global keys [ word? ] subset
- swap [ >r word-vocabulary r> member? ] curry
- subset %
- ] when
- ] { } make dup . ;
-
-: strip-recompile-hook ( -- )
- [ [ f ] { } map>assoc ] recompile-hook set-global ;
-
: strip ( -- )
strip-libc
strip-cocoa
@@ -165,7 +225,7 @@ SYMBOL: deploy-vocab
strip-init-hooks
deploy-vocab get vocab-main set-boot-quot*
retained-props >r
- retained-globals strip-environment
+ stripped-globals strip-globals
r> strip-words ;
: (deploy) ( final-image vocab config -- )
diff --git a/extra/tools/deploy/test/1/1.factor b/extra/tools/deploy/test/1/1.factor
new file mode 100755
index 0000000000..0bf8b10d0c
--- /dev/null
+++ b/extra/tools/deploy/test/1/1.factor
@@ -0,0 +1,6 @@
+IN: tools.deploy.test.1
+USING: threads ;
+
+: deploy-test-1 1000 sleep ;
+
+MAIN: deploy-test-1
diff --git a/extra/tools/deploy/test/1/deploy.factor b/extra/tools/deploy/test/1/deploy.factor
new file mode 100755
index 0000000000..f06bcbc0f0
--- /dev/null
+++ b/extra/tools/deploy/test/1/deploy.factor
@@ -0,0 +1,14 @@
+USING: tools.deploy.config ;
+H{
+ { deploy-c-types? f }
+ { deploy-io 2 }
+ { deploy-reflection 1 }
+ { deploy-threads? t }
+ { deploy-word-props? f }
+ { deploy-word-defs? f }
+ { deploy-name "tools.deploy.test.1" }
+ { deploy-math? t }
+ { deploy-compiler? t }
+ { "stop-after-last-window?" t }
+ { deploy-ui? f }
+}
diff --git a/extra/tools/deploy/test/2/2.factor b/extra/tools/deploy/test/2/2.factor
new file mode 100755
index 0000000000..e029e3050a
--- /dev/null
+++ b/extra/tools/deploy/test/2/2.factor
@@ -0,0 +1,6 @@
+IN: tools.deploy.test.2
+USING: calendar calendar.format ;
+
+: deploy-test-2 now (timestamp>string) ;
+
+MAIN: deploy-test-2
diff --git a/extra/tools/deploy/test/2/deploy.factor b/extra/tools/deploy/test/2/deploy.factor
new file mode 100755
index 0000000000..bd087d65bf
--- /dev/null
+++ b/extra/tools/deploy/test/2/deploy.factor
@@ -0,0 +1,14 @@
+USING: tools.deploy.config ;
+H{
+ { deploy-c-types? f }
+ { deploy-io 2 }
+ { deploy-reflection 1 }
+ { deploy-threads? t }
+ { deploy-word-props? f }
+ { deploy-word-defs? f }
+ { deploy-name "tools.deploy.test.2" }
+ { deploy-math? t }
+ { deploy-compiler? t }
+ { "stop-after-last-window?" t }
+ { deploy-ui? f }
+}
diff --git a/extra/tools/deploy/test/3/3.factor b/extra/tools/deploy/test/3/3.factor
new file mode 100755
index 0000000000..443e82f7d9
--- /dev/null
+++ b/extra/tools/deploy/test/3/3.factor
@@ -0,0 +1,8 @@
+IN: tools.deploy.test.3
+USING: io.encodings.ascii io.files kernel ;
+
+: deploy-test-3
+ "resource:extra/tools/deploy/test/3/3.factor"
+ ?resource-path ascii file-contents drop ;
+
+MAIN: deploy-test-3
diff --git a/extra/tools/deploy/test/3/deploy.factor b/extra/tools/deploy/test/3/deploy.factor
new file mode 100755
index 0000000000..b8b8bf4aa2
--- /dev/null
+++ b/extra/tools/deploy/test/3/deploy.factor
@@ -0,0 +1,14 @@
+USING: tools.deploy.config ;
+H{
+ { deploy-math? t }
+ { deploy-reflection 1 }
+ { deploy-name "tools.deploy.test.3" }
+ { deploy-threads? t }
+ { deploy-word-props? f }
+ { "stop-after-last-window?" t }
+ { deploy-ui? f }
+ { deploy-io 3 }
+ { deploy-compiler? t }
+ { deploy-word-defs? f }
+ { deploy-c-types? f }
+}
From 85cfca546847cfb20f20e60224fb7ae72d51d9b8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:48:39 -0500
Subject: [PATCH 19/38] Fix minor HTTPd omissions
---
extra/http/server/server.factor | 1 +
extra/http/server/static/static.factor | 2 --
2 files changed, 1 insertion(+), 2 deletions(-)
diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor
index 37f21278df..283cb53627 100755
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@@ -12,6 +12,7 @@ GENERIC: call-responder ( path responder -- response )
: <content> ( content-type -- response )
<response>
200 >>code
+ "Document follows" >>message
swap set-content-type ;
TUPLE: trivial-responder response ;
diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor
index 6c365ad87b..18870a993f 100755
--- a/extra/http/server/static/static.factor
+++ b/extra/http/server/static/static.factor
@@ -7,8 +7,6 @@ calendar.format new-slots accessors io.encodings.binary
combinators.cleave fry ;
IN: http.server.static
-SYMBOL: responder
-
! special maps mime types to quots with effect ( path -- )
TUPLE: file-responder root hook special ;
From 5e6a1bd241023c4a2b38af5f06c69079079e6aba Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:49:07 -0500
Subject: [PATCH 20/38] Locals doesn't need to use map-call-with2
---
extra/locals/locals.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/extra/locals/locals.factor b/extra/locals/locals.factor
index 956504be2c..9819e65e37 100755
--- a/extra/locals/locals.factor
+++ b/extra/locals/locals.factor
@@ -5,7 +5,7 @@ inference.transforms parser words quotations debugger macros
arrays macros splitting combinators prettyprint.backend
definitions prettyprint hashtables combinators.lib
prettyprint.sections sequences.private effects generic
-compiler.units ;
+compiler.units combinators.cleave ;
IN: locals
! Inspired by
@@ -108,8 +108,8 @@ UNION: special local quote local-word local-reader local-writer ;
if ;
: (point-free) ( quot args -- newquot )
- { [ load-locals ] [ point-free-body ] [ point-free-end ] }
- map-call-with2 concat >quotation ;
+ [ load-locals ] [ point-free-body ] [ point-free-end ]
+ 2tri 3append >quotation ;
: point-free ( quot args -- newquot )
over empty? [ drop ] [ (point-free) ] if ;
From b846d9797d709e88b3f9561b6267718dfbaa4e26 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:49:22 -0500
Subject: [PATCH 21/38] Fix using
---
extra/tools/test/test.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor
index 259b91c3af..031b3c3af8 100755
--- a/extra/tools/test/test.factor
+++ b/extra/tools/test/test.factor
@@ -4,7 +4,7 @@ USING: namespaces arrays prettyprint sequences kernel
vectors quotations words parser assocs combinators
continuations debugger io io.files vocabs tools.time
vocabs.loader source-files compiler.units inspector
-inference effects ;
+inference effects tools.vocabs ;
IN: tools.test
SYMBOL: failures
From cc5ee16f06ca1e486395e6b2d1f84c6c51cf20d9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:49:31 -0500
Subject: [PATCH 22/38] Add disassembler tests
---
extra/tools/disassembler/disassembler-tests.factor | 5 +++++
1 file changed, 5 insertions(+)
create mode 100755 extra/tools/disassembler/disassembler-tests.factor
diff --git a/extra/tools/disassembler/disassembler-tests.factor b/extra/tools/disassembler/disassembler-tests.factor
new file mode 100755
index 0000000000..2a89fe908e
--- /dev/null
+++ b/extra/tools/disassembler/disassembler-tests.factor
@@ -0,0 +1,5 @@
+IN: tools.disassembler.tests
+USING: math tuples prettyprint.backend tools.disassembler ;
+
+[ ] [ \ + disassemble ] unit-test
+[ ] [ { tuple prettyprint* } disassemble ] unit-test
From bb137bb7841b47848f0a5d92b9e5c83e2e677b0f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:51:25 -0500
Subject: [PATCH 23/38] Fix disassembler tests
---
extra/tools/disassembler/disassembler-tests.factor | 5 +++--
extra/tools/disassembler/disassembler.factor | 6 +++++-
2 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/extra/tools/disassembler/disassembler-tests.factor b/extra/tools/disassembler/disassembler-tests.factor
index 2a89fe908e..9983db7d00 100755
--- a/extra/tools/disassembler/disassembler-tests.factor
+++ b/extra/tools/disassembler/disassembler-tests.factor
@@ -1,5 +1,6 @@
IN: tools.disassembler.tests
-USING: math tuples prettyprint.backend tools.disassembler ;
+USING: math tuples prettyprint.backend tools.disassembler
+tools.test strings ;
[ ] [ \ + disassemble ] unit-test
-[ ] [ { tuple prettyprint* } disassemble ] unit-test
+[ ] [ { string pprint* } disassemble ] unit-test
diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor
index 2fa882ff68..479ae9c42c 100755
--- a/extra/tools/disassembler/disassembler.factor
+++ b/extra/tools/disassembler/disassembler.factor
@@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.files io words alien kernel math.parser alien.syntax
io.launcher system assocs arrays sequences namespaces qualified
-system math generator.fixup io.encodings.ascii accessors ;
+system math generator.fixup io.encodings.ascii accessors
+generic ;
IN: tools.disassembler
: in-file "gdb-in.txt" temp-file ;
@@ -22,6 +23,9 @@ M: pair make-disassemble-cmd
[ number>string write bl ] each
] with-file-writer ;
+M: method-spec make-disassemble-cmd
+ first2 method make-disassemble-cmd ;
+
: run-gdb ( -- lines )
<process>
+closed+ >>stdin
From b55fa49b7c5e29f6fb0a71ac08ef2c513e8a38a4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:51:39 -0500
Subject: [PATCH 24/38] Update builder for tools.vocabs
---
extra/builder/test/test.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 extra/builder/test/test.factor
diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor
old mode 100644
new mode 100755
index dd3c640a84..409d0db11c
--- a/extra/builder/test/test.factor
+++ b/extra/builder/test/test.factor
@@ -4,7 +4,7 @@ USING: kernel namespaces sequences assocs builder continuations
io
io.files
prettyprint
- tools.browser
+ tools.vocabs
tools.test
io.encodings.utf8
combinators.cleave
From 37a44cebc513a1b2898dcb623a6ce04bdb4b8839 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:51:54 -0500
Subject: [PATCH 25/38] Fix typo
---
extra/ui/render/render-docs.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/ui/render/render-docs.factor b/extra/ui/render/render-docs.factor
index 2f82d983cc..fb4c000971 100755
--- a/extra/ui/render/render-docs.factor
+++ b/extra/ui/render/render-docs.factor
@@ -1,5 +1,5 @@
USING: ui.gadgets ui.gestures help.markup help.syntax
-kernel classes strings opengl.gl ;
+kernel classes strings opengl.gl models ;
IN: ui.render
HELP: gadget
@@ -15,7 +15,7 @@ HELP: gadget
{ { $link gadget-clipped? } " - a boolean indicating if clipping will be enabled when drawing this gadget's children." }
{ { $link gadget-interior } " - an object whose class implements the " { $link draw-interior } " generic word." }
{ { $link gadget-boundary } " - an object whose class implements the " { $link draw-boundary } " generic word." }
- { { $link gadget-model } " - XXX" }
+ { { $link gadget-model } " - a " { $link model } " or " { $link f } "; see " { $link "ui-control-impl" } }
}
"Gadgets delegate to " { $link rect } " instances holding their location and dimensions." }
{ $notes
From 99665a749f3e0c0f743ab1e5c5ef27bbcd632c33 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 03:52:04 -0500
Subject: [PATCH 26/38] Update ui.tools for tools.vocabs
---
extra/ui/tools/tools.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/extra/ui/tools/tools.factor b/extra/ui/tools/tools.factor
index b98b1dba28..d71b657491 100755
--- a/extra/ui/tools/tools.factor
+++ b/extra/ui/tools/tools.factor
@@ -8,7 +8,8 @@ prettyprint quotations sequences ui ui.commands ui.gadgets
ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
ui.gadgets.presentations ui.gestures words vocabs.loader
-tools.test ui.gadgets.buttons ui.gadgets.status-bar mirrors ;
+tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
+mirrors ;
IN: ui.tools
: <workspace-tabs> ( -- tabs )
From 3929d02f17c83fe5a43ec29c3c6cf62e0f71d89a Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 04:19:32 -0600
Subject: [PATCH 27/38] Fix a couple of problems preventing bootstrap
---
core/io/files/files-docs.factor | 10 +++++-----
core/io/files/files.factor | 5 ++++-
extra/io/unix/files/files.factor | 2 +-
3 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index a6dd1e0818..df9c78fe47 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -55,7 +55,7 @@ ARTICLE: "fs-meta" "File meta-data"
{ $subsection link-info }
{ $subsection exists? }
{ $subsection directory? }
-{ $subsection file-modified }
+! { $subsection file-modified }
{ $subsection stat } ;
ARTICLE: "delete-move-copy" "Deleting, moving, copying files"
@@ -222,7 +222,7 @@ HELP: stat ( path -- directory? permissions length modified )
"Queries the file system for file meta data. If the file does not exist, outputs " { $link f } " for all four values."
} ;
-{ stat exists? directory? file-modified } related-words
+{ stat exists? directory? } related-words
HELP: path+
{ $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
@@ -250,9 +250,9 @@ HELP: directory*
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
-HELP: file-modified
-{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
-{ $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
+! HELP: file-modified
+! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
+! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
HELP: resource-path
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 104c38518a..8a81bb1972 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -219,8 +219,11 @@ M: pathname <=> [ pathname-string ] compare ;
: with-file-reader ( path encoding quot -- )
>r <file-reader> r> with-stream ; inline
+! : file-contents ( path encoding -- str )
+! dupd [ file-info file-info-size read ] with-file-reader ;
+
: file-contents ( path encoding -- str )
- dupd [ file-info file-info-size read ] with-file-reader ;
+ dupd [ file-length read ] with-file-reader ;
: with-file-writer ( path encoding quot -- )
>r <file-writer> r> with-stream ; inline
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index 73090ea724..bdcd0b985d 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -68,7 +68,7 @@ M: unix-io delete-directory ( path -- )
] with-disposal ;
M: unix-io copy-file ( from to -- )
- [ (copy-file) ] 2keep swap file-permissions chmod io-error ;
+ [ (copy-file) ] 2keep swap file-info file-info-permissions io-error ;
: stat>type ( stat -- type )
stat-st_mode {
From 3cddca95ae6d09a447411b70bc44d861e800d30f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 04:54:33 -0500
Subject: [PATCH 28/38] Simply core: don't call directory? and file-modified
until after bootstrap
---
core/parser/parser.factor | 1 -
core/source-files/source-files-docs.factor | 12 ------
core/source-files/source-files.factor | 43 ++++++----------------
core/vocabs/loader/loader-tests.factor | 2 +-
core/vocabs/loader/loader.factor | 21 -----------
extra/tools/vocabs/vocabs-docs.factor | 4 ++
extra/tools/vocabs/vocabs.factor | 38 ++++++++++++++++++-
7 files changed, 53 insertions(+), 68 deletions(-)
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index cc28f09855..50f8f582d3 100755
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -484,7 +484,6 @@ SYMBOL: interactive-vocabs
: finish-parsing ( lines quot -- )
file get
[ record-form ] keep
- [ record-modified ] keep
[ record-definitions ] keep
record-checksum ;
diff --git a/core/source-files/source-files-docs.factor b/core/source-files/source-files-docs.factor
index 31c2defd19..505ca59425 100755
--- a/core/source-files/source-files-docs.factor
+++ b/core/source-files/source-files-docs.factor
@@ -9,10 +9,7 @@ $nl
{ $subsection source-files }
"The class of source files:"
{ $subsection source-file }
-"Testing if a source file has been changed on disk:"
-{ $subsection source-modified? }
"Words intended for the parser:"
-{ $subsection record-modified }
{ $subsection record-checksum }
{ $subsection record-form }
{ $subsection xref-source }
@@ -41,15 +38,6 @@ HELP: source-file
}
} ;
-HELP: source-modified?
-{ $values { "path" "a pathname string" } { "?" "a boolean" } }
-{ $description "Tests if the source file has been modified since it was last loaded. This compares the file's modification time and CRC32 checksum of the file's contents against previously-recorded values." } ;
-
-HELP: record-modified
-{ $values { "source-file" source-file } }
-{ $description "Records the modification time of the source file." }
-$low-level-note ;
-
HELP: record-checksum
{ $values { "source-file" source-file } { "lines" "a sequence of strings" } }
{ $description "Records the CRC32 checksm of the source file's contents." }
diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor
index 98438b48d8..f4428e4e8b 100755
--- a/core/source-files/source-files.factor
+++ b/core/source-files/source-files.factor
@@ -1,44 +1,25 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays definitions generic assocs kernel math
-namespaces prettyprint sequences strings vectors words
-quotations inspector io.styles io combinators sorting
-splitting math.parser effects continuations debugger
-io.files io.crc32 io.streams.string vocabs
-hashtables graphs compiler.units io.encodings.utf8 ;
+USING: arrays definitions generic assocs kernel math namespaces
+prettyprint sequences strings vectors words quotations inspector
+io.styles io combinators sorting splitting math.parser effects
+continuations debugger io.files io.crc32 vocabs hashtables
+graphs compiler.units io.encodings.utf8 ;
IN: source-files
SYMBOL: source-files
TUPLE: source-file
path
-modified checksum
+checksum
uses definitions ;
-: (source-modified?) ( path modified checksum -- ? )
- pick file-modified rot [ 0 or ] 2apply >
- [ swap utf8 file-lines lines-crc32 = not ] [ 2drop f ] if ;
-
-: source-modified? ( path -- ? )
- dup source-files get at [
- dup source-file-path ?resource-path
- over source-file-modified
- rot source-file-checksum
- (source-modified?)
- ] [
- resource-exists?
- ] ?if ;
-
-: record-modified ( source-file -- )
- dup source-file-path ?resource-path file-modified
- swap set-source-file-modified ;
-
: record-checksum ( lines source-file -- )
- swap lines-crc32 swap set-source-file-checksum ;
+ >r lines-crc32 r> set-source-file-checksum ;
: (xref-source) ( source-file -- pathname uses )
- dup source-file-path <pathname> swap source-file-uses
- [ crossref? ] subset ;
+ dup source-file-path <pathname>
+ swap source-file-uses [ crossref? ] subset ;
: xref-source ( source-file -- )
(xref-source) crossref get add-vertex ;
@@ -67,9 +48,7 @@ uses definitions ;
: reset-checksums ( -- )
source-files get [
- swap ?resource-path dup exists?
- [
- over record-modified
+ swap ?resource-path dup exists? [
utf8 file-lines swap record-checksum
] [ 2drop ] if
] assoc-each ;
diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor
index f99bf94aa4..514e45f10f 100755
--- a/core/vocabs/loader/loader-tests.factor
+++ b/core/vocabs/loader/loader-tests.factor
@@ -3,7 +3,7 @@ IN: vocabs.loader.tests
USING: vocabs.loader tools.test continuations vocabs math
kernel arrays sequences namespaces io.streams.string
parser source-files words assocs tuples definitions
-debugger compiler.units ;
+debugger compiler.units tools.vocabs ;
! This vocab should not exist, but just in case...
[ ] [
diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 430aa066a8..fa9ff5b504 100755
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -48,27 +48,6 @@ M: string vocab-root
M: vocab-link vocab-root
vocab-link-root ;
-: vocab-tests ( vocab -- tests )
- dup vocab-root [
- [
- f >vocab-link dup
-
- dup "-tests.factor" vocab-dir+ vocab-path+
- dup resource-exists? [ , ] [ drop ] if
-
- dup vocab-dir "tests" path+ vocab-path+ dup
- ?resource-path directory keys [ ".factor" tail? ] subset
- [ path+ , ] with each
- ] { } make
- ] [ drop f ] if ;
-
-: vocab-files ( vocab -- seq )
- f >vocab-link [
- dup vocab-source-path [ , ] when*
- dup vocab-docs-path [ , ] when*
- vocab-tests %
- ] { } make ;
-
SYMBOL: load-help?
: source-was-loaded t swap set-vocab-source-loaded? ;
diff --git a/extra/tools/vocabs/vocabs-docs.factor b/extra/tools/vocabs/vocabs-docs.factor
index bdc3954e2e..ee82134379 100755
--- a/extra/tools/vocabs/vocabs-docs.factor
+++ b/extra/tools/vocabs/vocabs-docs.factor
@@ -25,6 +25,10 @@ ARTICLE: "tools.vocabs" "Vocabulary tools"
ABOUT: "tools.vocabs"
+HELP: source-modified?
+{ $values { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Tests if the source file has been modified since it was last loaded. This compares the file's CRC32 checksum of the file's contents against the previously-recorded value." } ;
+
HELP: refresh
{ $values { "prefix" string } }
{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor
index 21b8da8910..675a2e1d6e 100755
--- a/extra/tools/vocabs/vocabs.factor
+++ b/extra/tools/vocabs/vocabs.factor
@@ -3,9 +3,45 @@
USING: io.files kernel io.encodings.utf8 vocabs.loader vocabs
sequences namespaces math.parser arrays hashtables assocs
memoize inspector sorting splitting combinators source-files
-io debugger continuations compiler.errors init ;
+io debugger continuations compiler.errors init io.crc32 ;
IN: tools.vocabs
+: vocab-tests-file, ( vocab -- )
+ dup "-tests.factor" vocab-dir+ vocab-path+
+ dup resource-exists? [ , ] [ drop ] if ;
+
+: vocab-tests-dir, ( vocab -- )
+ dup vocab-dir "tests" path+ vocab-path+
+ dup resource-exists? [
+ dup ?resource-path directory keys
+ [ ".factor" tail? ] subset
+ [ path+ , ] with each
+ ] [ drop ] if ;
+
+: vocab-tests ( vocab -- tests )
+ dup vocab-root [
+ [
+ f >vocab-link dup
+ vocab-tests-file,
+ vocab-tests-dir,
+ ] { } make
+ ] [ drop f ] if ;
+
+: vocab-files ( vocab -- seq )
+ f >vocab-link [
+ dup vocab-source-path [ , ] when*
+ dup vocab-docs-path [ , ] when*
+ vocab-tests %
+ ] { } make ;
+
+: source-modified? ( path -- ? )
+ dup source-files get at [
+ dup source-file-path ?resource-path utf8 file-lines lines-crc32
+ swap source-file-checksum = not
+ ] [
+ resource-exists?
+ ] ?if ;
+
: modified ( seq quot -- seq )
[ dup ] swap compose { } map>assoc
[ nip ] assoc-subset
From 02d7c9fb24937f726fc9e2c48eac392c957b0d70 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 05:21:56 -0500
Subject: [PATCH 29/38] Simplifications
---
core/source-files/source-files-docs.factor | 1 -
core/vocabs/loader/loader-docs.factor | 8 --------
extra/http/server/server.factor | 2 +-
extra/tools/deploy/deploy-tests.factor | 2 +-
extra/tools/vocabs/vocabs-docs.factor | 8 ++++++++
5 files changed, 10 insertions(+), 11 deletions(-)
diff --git a/core/source-files/source-files-docs.factor b/core/source-files/source-files-docs.factor
index 505ca59425..2f2f8fd0c0 100755
--- a/core/source-files/source-files-docs.factor
+++ b/core/source-files/source-files-docs.factor
@@ -31,7 +31,6 @@ HELP: source-file
{ $class-description "Instances retain information about loaded source files, and have the following slots:"
{ $list
{ { $link source-file-path } " - a pathname string." }
- { { $link source-file-modified } " - the result of " { $link file-modified } " at the time the source file was most recently loaded." }
{ { $link source-file-checksum } " - the CRC32 checksum of the source file's contents at the time it was most recently loaded." }
{ { $link source-file-uses } " - an assoc whose keys are words referenced from this source file's top level form." }
{ { $link source-file-definitions } " - a pair of assocs, containing definitions and classes defined in this source file, respectively" }
diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor
index 886e678330..c7652c34c7 100755
--- a/core/vocabs/loader/loader-docs.factor
+++ b/core/vocabs/loader/loader-docs.factor
@@ -39,20 +39,12 @@ HELP: vocab-main
HELP: vocab-roots
{ $var-description "A sequence of pathname strings to search for vocabularies." } ;
-HELP: vocab-tests
-{ $values { "vocab" "a vocabulary specifier" } { "tests" "a sequence of pathname strings" } }
-{ $description "Outputs a sequence of pathnames where the unit tests for " { $snippet "vocab" } " are located." } ;
-
HELP: find-vocab-root
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } }
{ $description "Searches for a vocabulary in the vocabulary roots." } ;
{ vocab-root find-vocab-root } related-words
-HELP: vocab-files
-{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
-{ $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
-
HELP: no-vocab
{ $values { "name" "a vocabulary name" } }
{ $description "Throws a " { $link no-vocab } "." }
diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor
index 283cb53627..b3fafc543f 100755
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@@ -3,7 +3,7 @@
USING: assocs kernel namespaces io io.timeouts strings splitting
threads http sequences prettyprint io.server logging calendar
new-slots html.elements accessors math.parser combinators.lib
-vocabs.loader debugger html continuations random combinators
+tools.vocabs debugger html continuations random combinators
destructors io.encodings.latin1 fry combinators.cleave ;
IN: http.server
diff --git a/extra/tools/deploy/deploy-tests.factor b/extra/tools/deploy/deploy-tests.factor
index 0f770f7b60..d26e278fc5 100755
--- a/extra/tools/deploy/deploy-tests.factor
+++ b/extra/tools/deploy/deploy-tests.factor
@@ -1,6 +1,6 @@
IN: tools.deploy.tests
USING: tools.test system io.files kernel tools.deploy.config
-tools.deploy.backend math ;
+tools.deploy.backend math sequences ;
: shake-and-bake
"." resource-path [
diff --git a/extra/tools/vocabs/vocabs-docs.factor b/extra/tools/vocabs/vocabs-docs.factor
index ee82134379..33f197d0ea 100755
--- a/extra/tools/vocabs/vocabs-docs.factor
+++ b/extra/tools/vocabs/vocabs-docs.factor
@@ -25,6 +25,14 @@ ARTICLE: "tools.vocabs" "Vocabulary tools"
ABOUT: "tools.vocabs"
+HELP: vocab-files
+{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
+{ $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
+
+HELP: vocab-tests
+{ $values { "vocab" "a vocabulary specifier" } { "tests" "a sequence of pathname strings" } }
+{ $description "Outputs a sequence of pathnames where the unit tests for " { $snippet "vocab" } " are located." } ;
+
HELP: source-modified?
{ $values { "path" "a pathname string" } { "?" "a boolean" } }
{ $description "Tests if the source file has been modified since it was last loaded. This compares the file's CRC32 checksum of the file's contents against the previously-recorded value." } ;
From 93afd5a7c5c20eec4267759e69e89feb1a986d9e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 06:15:11 -0500
Subject: [PATCH 30/38] Get jamshred to load
---
extra/jamshred/jamshred.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
mode change 100644 => 100755 extra/jamshred/jamshred.factor
diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor
old mode 100644
new mode 100755
index 8beecc955c..42414b9893
--- a/extra/jamshred/jamshred.factor
+++ b/extra/jamshred/jamshred.factor
@@ -59,7 +59,7 @@ M: jamshred-gadget ungraft* ( gadget -- )
USE: vocabs.loader
jamshred-gadget H{
- { T{ key-down f f "r" } [ jamshred-restart refresh-all ] }
+ { T{ key-down f f "r" } [ jamshred-restart ] }
{ T{ key-down f f " " } [ jamshred-gadget-jamshred toggle-running ] }
{ T{ motion } [ handle-mouse-motion ] }
} set-gestures
From 067fae725c60a9b8fd19fb0e4e51f1b1799c2812 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 06:37:50 -0500
Subject: [PATCH 31/38] Fix deploy tests again
---
extra/tools/deploy/deploy-tests.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/tools/deploy/deploy-tests.factor b/extra/tools/deploy/deploy-tests.factor
index d26e278fc5..c68c259a6e 100755
--- a/extra/tools/deploy/deploy-tests.factor
+++ b/extra/tools/deploy/deploy-tests.factor
@@ -1,6 +1,6 @@
IN: tools.deploy.tests
USING: tools.test system io.files kernel tools.deploy.config
-tools.deploy.backend math sequences ;
+tools.deploy.backend math sequences io.launcher ;
: shake-and-bake
"." resource-path [
From a34146e33c4b28d1f96eb6c1a587478226096ba0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 06:38:00 -0500
Subject: [PATCH 32/38] Fix Window UI mouse handling bug
---
extra/ui/windows/windows.factor | 11 ++++-------
1 file changed, 4 insertions(+), 7 deletions(-)
diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor
index f65f293ca4..8eb5fe59aa 100755
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@@ -266,11 +266,6 @@ SYMBOL: nc-buttons
key-modifiers swap message>button
[ <button-down> ] [ <button-up> ] if ;
-: mouse-buttons ( -- seq ) WM_LBUTTONDOWN WM_RBUTTONDOWN 2array ;
-
-: capture-mouse? ( umsg -- ? )
- mouse-buttons member? ;
-
: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
nip >r mouse-event>gesture r> >lo-hi rot window ;
@@ -287,8 +282,10 @@ SYMBOL: nc-buttons
mouse-captured off ;
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
- >r >r dup capture-mouse? [ over set-capture ] when r> r>
- prepare-mouse send-button-down ;
+ >r >r
+ over set-capture
+ dup message>button drop nc-buttons get delete
+ r> r> prepare-mouse send-button-down ;
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
mouse-captured get [ release-capture ] when
From fc725ce7fa7c6cd0c6d286b900d9df10c661dc57 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 06:38:09 -0500
Subject: [PATCH 33/38] Add unit test
---
core/parser/parser-tests.factor | 17 +++++++++++++++++
1 file changed, 17 insertions(+)
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index 89783d1b3c..a69e28ab97 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -430,3 +430,20 @@ IN: parser.tests
[ "resource:core/parser/test/assert-depth.factor" run-file ]
[ relative-overflow-stack { 1 2 3 } sequence= ]
must-fail-with
+
+2 [
+ [ ] [
+ "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
+ <string-reader> "d-f-s-test" parse-stream drop
+ ] unit-test
+
+ [ ] [
+ "IN: parser.tests DEFER: d-f-s d-f-s FORGET: d-f-s SYMBOL: d-f-s d-f-s"
+ <string-reader> "d-f-s-test" parse-stream drop
+ ] unit-test
+
+ [ ] [
+ "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
+ <string-reader> "d-f-s-test" parse-stream drop
+ ] unit-test
+] times
From 67562173a4441e5c8ce174b7e98d997364ead3b8 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 14:10:56 -0600
Subject: [PATCH 34/38] Replace more old 'stat' based code
---
core/io/files/files.factor | 12 ++++++------
extra/http/server/static/static.factor | 5 +++--
2 files changed, 9 insertions(+), 8 deletions(-)
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 8a81bb1972..3ab489739b 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -86,11 +86,11 @@ SYMBOL: +unknown+
: stat ( path -- directory? permissions length modified )
normalize-pathname (stat) ;
-: file-length ( path -- n ) stat drop 2nip ;
+! : file-length ( path -- n ) stat drop 2nip ;
: file-modified ( path -- n ) stat >r 3drop r> ;
-: file-permissions ( path -- perm ) stat 2drop nip ;
+! : file-permissions ( path -- perm ) stat 2drop nip ;
: exists? ( path -- ? ) file-modified >boolean ;
@@ -219,11 +219,11 @@ M: pathname <=> [ pathname-string ] compare ;
: with-file-reader ( path encoding quot -- )
>r <file-reader> r> with-stream ; inline
-! : file-contents ( path encoding -- str )
-! dupd [ file-info file-info-size read ] with-file-reader ;
-
: file-contents ( path encoding -- str )
- dupd [ file-length read ] with-file-reader ;
+ dupd [ file-info file-info-size read ] with-file-reader ;
+
+! : file-contents ( path encoding -- str )
+! dupd [ file-length read ] with-file-reader ;
: with-file-writer ( path encoding quot -- )
>r <file-writer> r> with-stream ; inline
diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor
index 18870a993f..9c05b87a71 100755
--- a/extra/http/server/static/static.factor
+++ b/extra/http/server/static/static.factor
@@ -14,7 +14,8 @@ TUPLE: file-responder root hook special ;
>r unix-1970 r> seconds time+ ;
: file-http-date ( filename -- string )
- file-modified unix-time>timestamp timestamp>http-string ;
+ file-info file-info-modified
+ unix-time>timestamp timestamp>http-string ;
: last-modified-matches? ( filename -- ? )
file-http-date dup [
@@ -31,7 +32,7 @@ TUPLE: file-responder root hook special ;
[
<content>
swap
- [ file-length "content-length" set-header ]
+ [ file-info file-info-size "content-length" set-header ]
[ file-http-date "last-modified" set-header ]
[ '[ , binary <file-reader> stdio get stream-copy ] >>body ]
tri
From a5551f8f56341427ce92a06434d385150dd818e5 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 15:39:25 -0600
Subject: [PATCH 35/38] combinators.cleave: add 2cleave and improve stack
effect comments
---
extra/combinators/cleave/cleave.factor | 16 ++++++++++++++--
1 file changed, 14 insertions(+), 2 deletions(-)
mode change 100755 => 100644 extra/combinators/cleave/cleave.factor
diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor
old mode 100755
new mode 100644
index 383d5ca9ac..fd66536c12
--- a/extra/combinators/cleave/cleave.factor
+++ b/extra/combinators/cleave/cleave.factor
@@ -15,9 +15,9 @@ IN: combinators.cleave
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline
+: 2bi ( x y p q -- p(x,y) q(x,y) ) >r 2keep r> call ; inline
-: 2tri ( obj obj quot quot quot -- val val val )
+: 2tri ( x y z p q r -- p(x,y,z) q(x,y,z) r(x,y,z) )
>r >r 2keep r> 2keep r> call ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -36,6 +36,18 @@ MACRO: cleave ( seq -- )
[ drop ]
append ;
+MACRO: 2cleave ( seq -- )
+ dup
+ [ drop [ 2dup ] ] map concat
+ swap
+ dup
+ [ drop [ >r >r ] ] map concat
+ swap
+ [ [ r> r> ] append ] map concat
+ 3append
+ [ 2drop ]
+ append ;
+
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! The spread family
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
From 70e160d08c769608b4607b0716a36b75bc46dc8f Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 15:39:54 -0600
Subject: [PATCH 36/38] combinators.cleave-docs: Add a couple of items
---
extra/combinators/cleave/cleave-docs.factor | 16 +++++++++++++++-
1 file changed, 15 insertions(+), 1 deletion(-)
diff --git a/extra/combinators/cleave/cleave-docs.factor b/extra/combinators/cleave/cleave-docs.factor
index 0c491b88b1..18968628d5 100644
--- a/extra/combinators/cleave/cleave-docs.factor
+++ b/extra/combinators/cleave/cleave-docs.factor
@@ -9,6 +9,7 @@ ARTICLE: "cleave-combinators" "Cleave Combinators"
{ $subsection bi }
{ $subsection tri }
+{ $subsection cleave }
{ $notes
"From the Merriam-Webster Dictionary: "
@@ -49,10 +50,17 @@ HELP: tri
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+HELP: cleave
+
+{ $code "( obj { q1 q2 ... qN } -- q1(obj) q2(obj) ... qN(obj) )" } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
ARTICLE: "spread-combinators" "Spread Combinators"
{ $subsection bi* }
-{ $subsection tri* } ;
+{ $subsection tri* }
+{ $subsection spread } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -80,3 +88,9 @@ HELP: tri*
{ "p(x)" "p applied to x" }
{ "q(y)" "q applied to y" }
{ "r(z)" "r applied to z" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: spread
+
+{ $code "( v1 v2 ... vN { q1 q2 ... qN } -- q1(v1) q2(v2) ... qN(vN) )" } ;
\ No newline at end of file
From f6a2a9fa49f5243c1b7cd5f56b42d97cd0edd922 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Thu, 13 Mar 2008 15:40:55 -0600
Subject: [PATCH 37/38] builder: change mode
---
extra/builder/builder.factor | 0
1 file changed, 0 insertions(+), 0 deletions(-)
mode change 100755 => 100644 extra/builder/builder.factor
diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor
old mode 100755
new mode 100644
From 93ad9cb096fa78e1e82244dedc729730b0945ea2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 13 Mar 2008 17:20:28 -0500
Subject: [PATCH 38/38] Working on classes
---
core/classes/classes-docs.factor | 21 ++--------
core/classes/classes-tests.factor | 66 +++++++++++++++----------------
core/classes/classes.factor | 14 ++-----
3 files changed, 40 insertions(+), 61 deletions(-)
diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor
index df97a3eff5..1e71173153 100755
--- a/core/classes/classes-docs.factor
+++ b/core/classes/classes-docs.factor
@@ -1,7 +1,7 @@
USING: help.markup help.syntax kernel kernel.private
namespaces sequences words arrays layouts help effects math
layouts classes.private classes.union classes.mixin
-classes.predicate ;
+classes.predicate quotations ;
IN: classes
ARTICLE: "builtin-classes" "Built-in classes"
@@ -114,24 +114,9 @@ HELP: predicate-word
{ $values { "word" "a word" } { "predicate" "a predicate word" } }
{ $description "Suffixes the word's name with \"?\" and creates a word with that name in the same vocabulary as the word itself." } ;
-HELP: define-predicate*
-{ $values { "class" class } { "predicate" "a predicate word" } { "quot" "a quotation" } }
-{ $description
- "Defines a predicate word. This is identical to a word definition associating " { $snippet "quot" } " with " { $snippet "predicate" } " with the added perk that three word properties are set:"
- { $list
- { "the class word's " { $snippet "\"predicate\"" } " property is set to a quotation that calls the predicate" }
- { "the predicate word's " { $snippet "\"predicating\"" } " property is set to the class word" }
- { "the predicate word's " { $snippet "\"declared-effect\"" } " word property is set to a descriptive " { $link effect } }
- }
- "These properties are used by method dispatch and the help system."
-}
-$low-level-note ;
-
HELP: define-predicate
-{ $values { "class" class } { "quot" "a quotation" } }
-{ $description
- "Defines a predicate word named " { $snippet "class?" } " with " { $link define-predicate* } "."
-}
+{ $values { "class" class } { "quot" quotation } }
+{ $description "Defines a predicate word for a class." }
$low-level-note ;
HELP: superclass
diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor
index 640439312d..dbc1bcace2 100755
--- a/core/classes/classes-tests.factor
+++ b/core/classes/classes-tests.factor
@@ -178,39 +178,39 @@ UNION: forget-class-bug-2 forget-class-bug-1 dll ;
[ f ] [ forget-class-bug-2 typemap get values [ memq? ] with contains? ] unit-test
-DEFER: mixin-forget-test-g
-
-[ "mixin-forget-test" forget-source ] with-compilation-unit
-
-[ ] [
- {
- "USING: sequences ;"
- "IN: classes.tests"
- "MIXIN: mixin-forget-test"
- "INSTANCE: sequence mixin-forget-test"
- "GENERIC: mixin-forget-test-g ( x -- y )"
- "M: mixin-forget-test mixin-forget-test-g ;"
- } "\n" join <string-reader> "mixin-forget-test"
- parse-stream drop
-] unit-test
-
-[ { } ] [ { } mixin-forget-test-g ] unit-test
-[ H{ } mixin-forget-test-g ] must-fail
-
-[ ] [
- {
- "USING: hashtables ;"
- "IN: classes.tests"
- "MIXIN: mixin-forget-test"
- "INSTANCE: hashtable mixin-forget-test"
- "GENERIC: mixin-forget-test-g ( x -- y )"
- "M: mixin-forget-test mixin-forget-test-g ;"
- } "\n" join <string-reader> "mixin-forget-test"
- parse-stream drop
-] unit-test
-
-[ { } mixin-forget-test-g ] must-fail
-[ H{ } ] [ H{ } mixin-forget-test-g ] unit-test
+2 [
+ [ "mixin-forget-test" forget-source ] with-compilation-unit
+
+ [ ] [
+ {
+ "USING: sequences ;"
+ "IN: classes.tests"
+ "MIXIN: mixin-forget-test"
+ "INSTANCE: sequence mixin-forget-test"
+ "GENERIC: mixin-forget-test-g ( x -- y )"
+ "M: mixin-forget-test mixin-forget-test-g ;"
+ } "\n" join <string-reader> "mixin-forget-test"
+ parse-stream drop
+ ] unit-test
+
+ [ { } ] [ { } "mixin-forget-test-g" "classes.tests" lookup execute ] unit-test
+ [ H{ } "mixin-forget-test-g" "classes.tests" lookup execute ] must-fail
+
+ [ ] [
+ {
+ "USING: hashtables ;"
+ "IN: classes.tests"
+ "MIXIN: mixin-forget-test"
+ "INSTANCE: hashtable mixin-forget-test"
+ "GENERIC: mixin-forget-test-g ( x -- y )"
+ "M: mixin-forget-test mixin-forget-test-g ;"
+ } "\n" join <string-reader> "mixin-forget-test"
+ parse-stream drop
+ ] unit-test
+
+ [ { } "mixin-forget-test-g" "classes.tests" lookup execute ] must-fail
+ [ H{ } ] [ H{ } "mixin-forget-test-g" "classes.tests" lookup execute ] unit-test
+] times
! Method flattening interfered with mixin update
MIXIN: flat-mx-1
diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index 48ddb2adf5..e60d3ba223 100755
--- a/core/classes/classes.factor
+++ b/core/classes/classes.factor
@@ -31,17 +31,9 @@ PREDICATE: class tuple-class
PREDICATE: word predicate "predicating" word-prop >boolean ;
-: define-predicate* ( class predicate quot -- )
- over [
- dupd predicate-effect define-declared
- 2dup 1quotation "predicate" set-word-prop
- swap "predicating" set-word-prop
- ] [ 3drop ] if ;
-
: define-predicate ( class quot -- )
- over "forgotten" word-prop [ 2drop ] [
- >r dup predicate-word r> define-predicate*
- ] if ;
+ >r "predicate" word-prop first
+ r> predicate-effect define-declared ;
: superclass ( class -- super )
"superclass" word-prop ;
@@ -257,6 +249,8 @@ PRIVATE>
over reset-class
over deferred? [ over define-symbol ] when
>r dup word-props r> union over set-word-props
+ dup predicate-word 2dup 1quotation "predicate" set-word-prop
+ over "predicating" set-word-prop
t "class" set-word-prop ;
GENERIC: update-predicate ( class -- )