modern: working on lookup
Doug Coleman
parent
dc85cb9dcc
commit
05686c44a3
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -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 ) ;
|
||||
|
|
@ -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>
|
||||
]]
|
||||
|
|
|
|||
|
|
@ -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 -- ? )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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> 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 ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue