From 05686c44a35bf62991a30073bfcbab41baacb5d8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 29 Oct 2019 18:41:50 -0500 Subject: [PATCH] modern: working on lookup --- extra/modern/lexer/authors.txt | 1 - extra/modern/lexer/lexer.factor | 64 -------------- extra/modern/manifest/manifest.factor | 121 +++----------------------- extra/modern/modern.factor | 14 ++- extra/modern/out/out.factor | 7 +- 5 files changed, 27 insertions(+), 180 deletions(-) delete mode 100644 extra/modern/lexer/authors.txt delete mode 100644 extra/modern/lexer/lexer.factor diff --git a/extra/modern/lexer/authors.txt b/extra/modern/lexer/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/extra/modern/lexer/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/modern/lexer/lexer.factor b/extra/modern/lexer/lexer.factor deleted file mode 100644 index 1e09a2aac5..0000000000 --- a/extra/modern/lexer/lexer.factor +++ /dev/null @@ -1,64 +0,0 @@ -! Copyright (C) 2019 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors ascii constructors kernel prettyprint.backend -prettyprint.custom sequences sequences.private ; -IN: modern.lexer - -ERROR: ws-expected string ; - -TUPLE: ws string ; -CONSTRUCTOR: ws ( string -- ws ) - dup string>> [ blank? not ] any? [ ws-expected ] when ; - -: no-ws ( seq -- seq' ) - [ ws? ] reject ; - -M: ws nth string>> nth ; -M: ws nth-unsafe string>> nth-unsafe ; -M: ws length string>> length ; - -! Weird experiment -! M: ws pprint* - ! drop ; - ! string>> dup "\"" "\"" pprint-string ; - -TUPLE: lexed tokens ; - -TUPLE: bracket < lexed tag payload ; -CONSTRUCTOR: bracket ( tag payload -- obj ) ; - -TUPLE: dbracket < lexed tag payload ; -CONSTRUCTOR: dbracket ( tag payload -- obj ) ; - -TUPLE: brace < lexed tag payload ; -CONSTRUCTOR: brace ( tag payload -- obj ) ; - -TUPLE: dbrace < lexed tag payload ; -CONSTRUCTOR: dbrace ( tag payload -- obj ) ; - -TUPLE: lcolon < lexed tag payload ; -: ( tag payload -- obj ) - lcolon new - swap no-ws >>payload - swap >>tag ; inline - -TUPLE: ucolon < lexed name effect body ; -CONSTRUCTOR: ucolon ( name effect body -- obj ) ; - -TUPLE: dquote < lexed tag payload ; -CONSTRUCTOR: dquote ( tag payload -- obj ) ; - -TUPLE: section < lexed payload ; -CONSTRUCTOR:
section ( payload -- obj ) ; - -TUPLE: named-section < lexed name payload ; -CONSTRUCTOR: named-section ( name payload -- obj ) ; - -TUPLE: backslash < lexed object ; -CONSTRUCTOR: backslash ( object -- obj ) ; - -TUPLE: hashtag < lexed object ; -CONSTRUCTOR: hashtag ( object -- obj ) ; - -TUPLE: token < lexed name ; -CONSTRUCTOR: token ( name -- obj ) ; diff --git a/extra/modern/manifest/manifest.factor b/extra/modern/manifest/manifest.factor index 428647b10b..7e4ebe73b3 100644 --- a/extra/modern/manifest/manifest.factor +++ b/extra/modern/manifest/manifest.factor @@ -5,6 +5,16 @@ combinators.short-circuit kernel modern sequences splitting.monotonic strings words ; IN: modern.manifest +MIXIN: token + +TUPLE: uri + uri + vocab-root + vocab + section-path + word ; + + TUPLE: syntax-forms sections named-sections @@ -201,48 +211,10 @@ ERROR: key-exists val key assoc existing-value ; nip like nip ] if ; inline -:: map-forms* ( seq namespace quot: ( namespace obj -- obj' ) -- seq' ) - seq - [ - { - ! { [ dup slice? ] [ namespace quot call ] } - { [ - dup { [ array? ] [ first section-open? ] } 1&& - ] [ - first3 ! pick . - [ namespace pick [ char: < = ] trim-head "." "" ?glue-as dup . quot map-forms* ] dip 3array - ! dup last . - ] } - { [ - dup { [ array? ] [ first upper-colon? ] } 1&& - ] [ - dup first2 first namespace -rot 3array . - ] } - [ - ! "oops" throw - ] - } cond - ] map ; inline recursive - -: map-forms ( seq quot: ( namespace obj -- obj' ) -- seq' ) - f swap map-forms* ; inline - : apply-decorators ( seq forms -- seq' ) '[ nip dup slice? [ >string _ rdecorators>> at ] [ drop f ] if ] monotonic-split ; -TUPLE: manifest ; - -GENERIC: flatten-literal ( obj -- obj' ) -M: sequence flatten-literal - [ flatten-literal ] map ; - -M: slice flatten-literal >string ; - -: flatten-literals ( seq -- seq' ) - ; - - : upper-colon>form ( seq -- form ) [ first "syntax" lookup-word ] [ ] bi 2array ; @@ -251,82 +223,9 @@ GENERIC: upper-colon>definitions ( form -- seq ) ! M: \: upper-colon>definitions ! second first >string ; - - : form>definitions ( obj -- obj' ) { { [ dup ?first upper-colon? ] [ upper-colon>definitions ] } [ ] } cond ; - -! math+private,macos:fixnum+ -! math+private:fixnum+ -! math:fixnum+ -#[[ - - private decorator - - macos decorator - MACOS> - macos,private decorators - - PRIVATE> -;VOCAB> - private.macos namespace - - math#private.macos - math+private.macos - math:foo - math+private:foo - math+private.macos:foo - - git@github.com:erg/factor#master -git@github.com:erg/factor#master\core/math+private.macos:foo - ^ - -uri\path\path/path/ - -GITHUB\core/math.order -git@github.com:erg/factor#master\core/math/order/order.factor -git@github.com:erg/factor#master\core//math.order -git@github.com:erg/factor#master\core//math.order -${github}:erg/factor#master\core//math.order - - - - -git branch name: no backslash, ., .., ~^:, end in / - - - PRIVATE> - ;VOCAB> -;ROOT> - - - PRIVATE> - ;VOCAB> - ;ROOT> -;REPO> -]] diff --git a/extra/modern/modern.factor b/extra/modern/modern.factor index 3046271bfa..bb3ac7f67e 100644 --- a/extra/modern/modern.factor +++ b/extra/modern/modern.factor @@ -2,11 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs combinators combinators.short-circuit constructors continuations io.encodings.utf8 io.files kernel -make math math.order modern.lexer modern.paths modern.slices +make math math.order modern.paths modern.slices sequences sequences.extras sequences.generalizations sets shuffle splitting strings syntax.modern unicode vocabs.loader ; IN: modern +: ( obj -- obj ) ; + ERROR: long-opening-mismatch tag open string n ch ; ERROR: unexpected-terminator string n slice ; ! ] } ) ; ERROR: compound-syntax-disallowed seq n obj ; @@ -181,6 +183,16 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) ) : strict-upper? ( string -- ? ) { [ [ char: \: = ] all? ] [ (strict-upper?) ] } 1|| ; +: neither? ( obj1 obj2 quot -- ? ) either? not ; inline +: xnor ( obj1 obj2 -- ? ) xor not ; inline +: xnor? ( obj1 obj2 quot -- ? ) bi@ xnor ; inline +: count-bs ( string -- n ) [ char: \\ = ] count-head ; inline +: uri-token? ( string -- ? ) count-bs 4 = ; +: vocab-root-token? ( string -- ? ) count-bs 3 = ; +: vocab-token? ( string -- ? ) count-bs 2 = ; +: word-token? ( string -- ? ) count-bs 1 = ; + + ! : section-open? ( string -- ? ) { diff --git a/extra/modern/out/out.factor b/extra/modern/out/out.factor index 395700a19a..98746f8718 100644 --- a/extra/modern/out/out.factor +++ b/extra/modern/out/out.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators.short-circuit constructors continuations io io.encodings.utf8 io.files -io.streams.string kernel modern modern.paths modern.slices -prettyprint sequences sequences.extras splitting strings -syntax.modern vocabs.loader ; +io.streams.string kernel modern modern.compiler modern.paths +modern.slices prettyprint sequences sequences.extras splitting +strings syntax.modern vocabs.loader ; IN: modern.out TUPLE: renamed slice string ; @@ -23,6 +23,7 @@ CONSTRUCTOR: renamed ( slice string -- obj ) ; GENERIC: write-literal* ( last obj -- last' ) M: slice write-literal* [ write-whitespace ] [ >string write ] [ ] tri ; M: array write-literal* [ write-literal* ] each ; +M: lexed write-literal* tokens>> write-literal* ; M: renamed write-literal* [ slice>> write-whitespace ] [ string>> write ] [ slice>> ] tri ; ! for refactoring : write-literal ( obj -- ) f swap write-literal* drop ;