From c06f0eb5f707519ca622c4034d7883e95a69a845 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 22 Aug 2017 00:11:19 -0500 Subject: [PATCH] modern: Fix up a bit. --- extra/modern/modern.factor | 12 ++- extra/modern/paths/authors.txt | 1 + extra/modern/paths/paths.factor | 134 ++++++++++++++++++++++++++++++ extra/modern/slices/slices.factor | 7 +- 4 files changed, 149 insertions(+), 5 deletions(-) create mode 100644 extra/modern/paths/authors.txt create mode 100644 extra/modern/paths/paths.factor diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor index d2afd9f1f8..b7bc19190a 100644 --- a/extra/modern/modern.factor +++ b/extra/modern/modern.factor @@ -99,7 +99,7 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) ) { [ dup openstreq member? ] [ ch read-double-matched ] } ! (=( or (( { [ dup blank? ] [ drop dup '[ _ matching-delimiter-string closestr1 2array lex-until ] dip - 1 cut-slice* rot unclip-last 4array ] } ! ( foo ) + swap unclip-last 3array ] } ! ( foo ) [ drop [ slice-til-whitespace drop ] dip span-slices ] ! (foo) } cond ] ; @@ -130,12 +130,18 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) ) 2over ?nth CHAR: [ = [ [ 1 + ] 2dip 2over ?nth read-double-matched-bracket ] [ - [ slice-til-eol drop dup ] dip 1 cut-slice* 4array + [ slice-til-eol drop ] dip swap 2array ] if ; : read-til-semicolon ( n string slice -- n' string semi ) dup '[ but-last ";" append ";" 2array lex-colon-until ] dip - swap 2array ; + swap + ! Remove the ; from the paylaod if present + dup ?last ";" sequence= [ + unclip-last 3array + ] [ + 2array + ] if ; : read-word-or-til-semicolon ( n string slice -- n' string obj ) 2over next-char-from* "\s\r\n" member? [ diff --git a/extra/modern/paths/authors.txt b/extra/modern/paths/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/modern/paths/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/modern/paths/paths.factor b/extra/modern/paths/paths.factor new file mode 100644 index 0000000000..5a4817d37e --- /dev/null +++ b/extra/modern/paths/paths.factor @@ -0,0 +1,134 @@ +! Copyright (C) 2015 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.smart io.files kernel sequences +splitting vocabs.files vocabs.hierarchy vocabs.loader +vocabs.metadata sets ; +IN: modern.paths + +: modern-if-available ( path -- path' ) + dup ".factor" ?tail [ + ".modern" append + dup exists? [ nip ] [ drop ] if + ] [ + drop + ] if ; + +ERROR: not-a-source-path path ; +: force-modern-path ( path -- path' ) + ".factor" ?tail [ ".modern" append ] [ not-a-source-path ] if ; +: modern-docs-path ( path -- path' ) + vocab-docs-path modern-if-available ; +: modern-tests-path ( path -- path' ) + vocab-tests-path modern-if-available ; +: modern-source-path ( path -- path' ) + vocab-source-path modern-if-available ; +: modern-syntax-path ( path -- path' ) + vocab-source-path ".factor" ?tail drop "-syntax.modern" append ; + +: force-modern-docs-path ( path -- path' ) + vocab-docs-path force-modern-path ; +: force-modern-tests-path ( path -- path' ) + vocab-tests-path force-modern-path ; +: force-modern-source-path ( path -- path' ) + vocab-source-path force-modern-path ; + +: vocabs-from ( root -- vocabs ) + "" disk-vocabs-in-root/prefix + no-prefixes [ name>> ] map ; + +: core-vocabs ( -- seq ) "resource:core" vocabs-from ; +: less-core-test-vocabs ( seq -- seq' ) + { + "vocabs.loader.test.a" + "vocabs.loader.test.b" + "vocabs.loader.test.c" + "vocabs.loader.test.d" + "vocabs.loader.test.e" + "vocabs.loader.test.f" + "vocabs.loader.test.g" + "vocabs.loader.test.h" + "vocabs.loader.test.i" + "vocabs.loader.test.j" + "vocabs.loader.test.k" + "vocabs.loader.test.l" + "vocabs.loader.test.m" + "vocabs.loader.test.n" + "vocabs.loader.test.o" + "vocabs.loader.test.p" + } diff ; + +: core-bootstrap-vocabs ( -- seq ) + core-vocabs less-core-test-vocabs ; + +: basis-vocabs ( -- seq ) "resource:basis" vocabs-from ; +: extra-vocabs ( -- seq ) "resource:extra" vocabs-from ; +: all-vocabs ( -- seq ) + [ + core-vocabs + basis-vocabs + extra-vocabs + ] { } append-outputs-as ; + +: filter-exists ( seq -- seq' ) [ exists? ] filter ; + +! These paths have syntax errors on purpose... +: reject-some-paths ( seq -- seq' ) + { + "resource:core/vocabs/loader/test/a/a.factor" + "resource:core/vocabs/loader/test/b/b.factor" + "resource:core/vocabs/loader/test/c/c.factor" + ! Here down have parse errors + "resource:core/vocabs/loader/test/d/d.factor" + "resource:core/vocabs/loader/test/e/e.factor" + "resource:core/vocabs/loader/test/f/f.factor" + "resource:core/vocabs/loader/test/g/g.factor" + "resource:core/vocabs/loader/test/h/h.factor" + "resource:core/vocabs/loader/test/i/i.factor" + "resource:core/vocabs/loader/test/j/j.factor" + "resource:core/vocabs/loader/test/k/k.factor" + "resource:core/vocabs/loader/test/l/l.factor" + "resource:core/vocabs/loader/test/m/m.factor" + "resource:core/vocabs/loader/test/n/n.factor" + "resource:core/vocabs/loader/test/o/o.factor" + "resource:core/vocabs/loader/test/p/p.factor" + "resource:extra/math/blas/vectors/vectors.factor" ! need .modern file + "resource:extra/math/blas/matrices/matrices.factor" ! need .modern file + } diff + ! Don't parse .modern files yet + [ ".modern" tail? ] reject ; + +: modern-source-paths ( names -- paths ) + [ modern-source-path ] map filter-exists reject-some-paths ; +: modern-docs-paths ( names -- paths ) + [ modern-docs-path ] map filter-exists reject-some-paths ; +: modern-tests-paths ( names -- paths ) + [ vocab-tests ] map concat + [ modern-if-available ] map filter-exists reject-some-paths ; + +: all-source-paths ( -- seq ) + all-vocabs modern-source-paths ; + +: all-docs-paths ( -- seq ) + all-vocabs modern-docs-paths ; + +: all-tests-paths ( -- seq ) + all-vocabs modern-tests-paths ; + +: all-syntax-paths ( -- seq ) + all-vocabs [ modern-syntax-path ] map filter-exists reject-some-paths ; + +: all-factor-paths ( -- seq ) + [ + all-syntax-paths all-source-paths all-docs-paths all-tests-paths + ] { } append-outputs-as ; + +: vocab-names>syntax ( strings -- seq ) + [ modern-syntax-path ] map [ exists? ] filter ; + +: core-syntax-paths ( -- seq ) core-vocabs vocab-names>syntax reject-some-paths ; +: basis-syntax-paths ( -- seq ) basis-vocabs vocab-names>syntax reject-some-paths ; +: extra-syntax-paths ( -- seq ) extra-vocabs vocab-names>syntax reject-some-paths ; + +: core-source-paths ( -- seq ) core-vocabs modern-source-paths reject-some-paths ; +: basis-source-paths ( -- seq ) basis-vocabs modern-source-paths reject-some-paths ; +: extra-source-paths ( -- seq ) extra-vocabs modern-source-paths reject-some-paths ; diff --git a/extra/modern/slices/slices.factor b/extra/modern/slices/slices.factor index cc9802d4b4..6ad44376d3 100644 --- a/extra/modern/slices/slices.factor +++ b/extra/modern/slices/slices.factor @@ -1,9 +1,12 @@ ! Copyright (C) 2016 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs fry kernel locals math math.private -sequences sequences.extras sequences.private unicode ; +USING: accessors assocs fry kernel locals math sequences +sequences.deep sequences.extras strings unicode ; IN: modern.slices +: >strings ( seq -- str ) + [ dup slice? [ >string ] when ] deep-map ; + : matching-delimiter ( ch -- ch' ) H{ { CHAR: ( CHAR: ) }