modern: working on lookup

extra/modern/lexer/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

extra/modern/lexer/lexer.factor

@@ -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> 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> bracket ( tag payload -- obj ) ;
-
-TUPLE: dbracket < lexed tag payload ;
-CONSTRUCTOR: <dbracket> dbracket ( tag payload -- obj ) ;
-
-TUPLE: brace < lexed tag payload ;
-CONSTRUCTOR: <brace> brace ( tag payload -- obj ) ;
-
-TUPLE: dbrace < lexed tag payload ;
-CONSTRUCTOR: <dbrace> dbrace ( tag payload -- obj ) ;
-
-TUPLE: lcolon < lexed tag payload ;
-: <lcolon> ( tag payload -- obj )
-    lcolon new
-        swap no-ws >>payload
-        swap >>tag ; inline
-
-TUPLE: ucolon < lexed name effect body ;
-CONSTRUCTOR: <ucolon> ucolon ( name effect body -- obj ) ;
-
-TUPLE: dquote < lexed tag payload ;
-CONSTRUCTOR: <dquote> dquote ( tag payload -- obj ) ;
-
-TUPLE: section < lexed payload ;
-CONSTRUCTOR: <section> section ( payload -- obj ) ;
-
-TUPLE: named-section < lexed name payload ;
-CONSTRUCTOR: <named-section> named-section ( name payload -- obj ) ;
-
-TUPLE: backslash < lexed object ;
-CONSTRUCTOR: <backslash> backslash ( object -- obj ) ;
-
-TUPLE: hashtag < lexed object ;
-CONSTRUCTOR: <hashtag> hashtag ( object -- obj ) ;
-
-TUPLE: token < lexed name ;
-CONSTRUCTOR: <token> token ( name -- obj ) ;

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 PRIVATE>
-    private decorator
-  <MACOS MACOS>
-    macos decorator
-  <MACOS <PRIVATE PRIVATE> MACOS>
-    macos,private decorators
-<VOCAB: math
-  : foo ;
-  <PRIVATE
-    : bar ;
-    <MACOS
-      : baz ;
-    MACOS>
-  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, ., .., ~^:<sp>, end in /
-
-<ROOT: core
-  <VOCAB: math
-    : foo ;
-    <PRIVATE
-      : bar ;
-      <MACOS
-        : baz ;
-      MACOS>
-    PRIVATE>
-  ;VOCAB>
-;ROOT>
-
-<REPO: github
-  <ROOT: core
-    <VOCAB: math
-      : foo ;
-      <PRIVATE
-        : bar ;
-        <MACOS
-          : baz ;
-        MACOS>
-      PRIVATE>
-    ;VOCAB>
-  ;ROOT>
-;REPO>
-]]

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
 
+: <ws> ( 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 = ;
+
+
 ! <A <A: but not <A>
 : section-open? ( string -- ? )
     {

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
+io.streams.string kernel modern modern.compiler modern.paths
-prettyprint sequences sequences.extras splitting strings
+modern.slices prettyprint sequences sequences.extras splitting
-syntax.modern vocabs.loader ;
+strings syntax.modern vocabs.loader ;
 IN: modern.out
 
 TUPLE: renamed slice string ;
@@ -23,6 +23,7 @@ CONSTRUCTOR: <renamed> 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 ;