XMode doesn't use parser combinators at all; regexes allow parens for grouping
parent
d0d615fb2b
commit
ff265aa919
|
@ -183,15 +183,8 @@ M: character-class-range nfa-node ( node -- )
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: capture-group nfa-node ( node -- )
|
M: capture-group nfa-node ( node -- )
|
||||||
"capture-groups" feature-is-broken
|
term>> nfa-node ;
|
||||||
eps literal-transition add-simple-entry
|
|
||||||
capture-group-on add-traversal-flag
|
|
||||||
term>> nfa-node
|
|
||||||
eps literal-transition add-simple-entry
|
|
||||||
capture-group-off add-traversal-flag
|
|
||||||
2 [ concatenate-nodes ] times ;
|
|
||||||
|
|
||||||
! xyzzy
|
|
||||||
M: non-capture-group nfa-node ( node -- )
|
M: non-capture-group nfa-node ( node -- )
|
||||||
term>> nfa-node ;
|
term>> nfa-node ;
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: xmode.loader xmode.utilities xmode.rules namespaces
|
USING: xmode.loader xmode.utilities xmode.rules namespaces
|
||||||
strings splitting assocs sequences kernel io.files xml memoize
|
strings splitting assocs sequences kernel io.files xml memoize
|
||||||
words globs combinators io.encodings.utf8 sorting accessors xml.data
|
words globs combinators io.encodings.utf8 sorting accessors xml.data
|
||||||
xml.traversal ;
|
xml.traversal xml.syntax ;
|
||||||
IN: xmode.catalog
|
IN: xmode.catalog
|
||||||
|
|
||||||
TUPLE: mode file file-name-glob first-line-glob ;
|
TUPLE: mode file file-name-glob first-line-glob ;
|
||||||
|
@ -97,8 +97,8 @@ ERROR: mutually-recursive-rulesets ruleset ;
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: finalize-mode ( rulesets -- )
|
: finalize-mode ( rulesets -- )
|
||||||
rule-sets [
|
dup rule-sets [
|
||||||
dup [ nip finalize-rule-set ] assoc-each
|
[ nip finalize-rule-set ] assoc-each
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
: load-mode ( name -- rule-sets )
|
: load-mode ( name -- rule-sets )
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: xmode.loader.syntax xmode.tokens xmode.rules
|
USING: xmode.loader.syntax xmode.tokens xmode.rules
|
||||||
xmode.keyword-map xml.data xml.traversal xml assocs kernel
|
xmode.keyword-map xml.data xml.traversal xml assocs kernel
|
||||||
combinators sequences math.parser namespaces parser
|
combinators sequences math.parser namespaces parser
|
||||||
xmode.utilities regexp io.files accessors ;
|
xmode.utilities regexp io.files accessors xml.syntax ;
|
||||||
IN: xmode.loader
|
IN: xmode.loader
|
||||||
|
|
||||||
! Based on org.gjt.sp.jedit.XModeHandler
|
! Based on org.gjt.sp.jedit.XModeHandler
|
||||||
|
@ -48,7 +48,7 @@ TAG: KEYWORDS parse-rule-tag
|
||||||
swap (>>keywords) ;
|
swap (>>keywords) ;
|
||||||
|
|
||||||
: ?<regexp> ( string/f -- regexp/f )
|
: ?<regexp> ( string/f -- regexp/f )
|
||||||
dup [ rule-set get ignore-case?>> drop <regexp> ] when ;
|
dup [ rule-set get ignore-case?>> <?insensitive-regexp> ] when ;
|
||||||
|
|
||||||
: (parse-rules-tag) ( tag -- rule-set )
|
: (parse-rules-tag) ( tag -- rule-set )
|
||||||
<rule-set> dup rule-set set
|
<rule-set> dup rule-set set
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors xmode.tokens xmode.rules xmode.keyword-map
|
USING: accessors xmode.tokens xmode.rules xmode.keyword-map
|
||||||
xml.data xml.traversal xml assocs kernel combinators sequences
|
xml.data xml.traversal xml assocs kernel combinators sequences
|
||||||
math.parser namespaces make parser lexer xmode.utilities
|
math.parser namespaces make parser lexer xmode.utilities
|
||||||
regexp io.files splitting arrays xml.syntax.private ;
|
regexp io.files splitting arrays xml.syntax xml.syntax.private ;
|
||||||
IN: xmode.loader.syntax
|
IN: xmode.loader.syntax
|
||||||
|
|
||||||
! Rule tag parsing utilities
|
! Rule tag parsing utilities
|
||||||
|
@ -11,10 +11,10 @@ IN: xmode.loader.syntax
|
||||||
new swap init-from-tag swap add-rule ; inline
|
new swap init-from-tag swap add-rule ; inline
|
||||||
|
|
||||||
: RULE:
|
: RULE:
|
||||||
scan scan-word scan-word
|
scan scan-word scan-word [
|
||||||
parse-definition { } make
|
parse-definition { } make
|
||||||
[ swap [ (parse-rule-tag) ] 2curry ] dip
|
swap [ (parse-rule-tag) ] 2curry
|
||||||
swap define-tag ; parsing
|
] dip swap define-tag ; parsing
|
||||||
|
|
||||||
! Attribute utilities
|
! Attribute utilities
|
||||||
: string>boolean ( string -- ? ) "TRUE" = ;
|
: string>boolean ( string -- ? ) "TRUE" = ;
|
||||||
|
@ -47,7 +47,8 @@ IN: xmode.loader.syntax
|
||||||
swap position-attrs <matcher> ;
|
swap position-attrs <matcher> ;
|
||||||
|
|
||||||
: parse-regexp-matcher ( tag -- matcher )
|
: parse-regexp-matcher ( tag -- matcher )
|
||||||
dup children>string rule-set get ignore-case?>> drop <regexp>
|
dup children>string
|
||||||
|
rule-set get ignore-case?>> <?insensitive-regexp>
|
||||||
swap position-attrs <matcher> ;
|
swap position-attrs <matcher> ;
|
||||||
|
|
||||||
: shared-tag-attrs ( -- )
|
: shared-tag-attrs ( -- )
|
||||||
|
|
|
@ -4,11 +4,25 @@ IN: xmode.marker
|
||||||
USING: kernel namespaces make xmode.rules xmode.tokens
|
USING: kernel namespaces make xmode.rules xmode.tokens
|
||||||
xmode.marker.state xmode.marker.context xmode.utilities
|
xmode.marker.state xmode.marker.context xmode.utilities
|
||||||
xmode.catalog sequences math assocs combinators strings
|
xmode.catalog sequences math assocs combinators strings
|
||||||
regexp splitting ascii parser-combinators regexp.backend
|
regexp splitting ascii regexp.backend unicode.case
|
||||||
ascii combinators.short-circuit accessors ;
|
ascii combinators.short-circuit accessors ;
|
||||||
! parser-combinators is for the string-head? word
|
|
||||||
! regexp.backend is for the regexp class
|
! regexp.backend is for the regexp class
|
||||||
|
|
||||||
|
! Next two words copied from parser-combinators
|
||||||
|
! Just like head?, but they optionally ignore case
|
||||||
|
|
||||||
|
: string= ( str1 str2 ignore-case -- ? )
|
||||||
|
[ [ >upper ] bi@ ] when sequence= ;
|
||||||
|
|
||||||
|
: string-head? ( str1 str2 ignore-case -- ? )
|
||||||
|
2over shorter?
|
||||||
|
[ 3drop f ] [
|
||||||
|
[
|
||||||
|
[ nip ]
|
||||||
|
[ length head-slice ] 2bi
|
||||||
|
] dip string=
|
||||||
|
] if ;
|
||||||
|
|
||||||
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
||||||
|
|
||||||
: current-keyword ( -- string )
|
: current-keyword ( -- string )
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
|
USING: assocs xmode.utilities tools.test ;
|
||||||
IN: xmode.utilities.tests
|
IN: xmode.utilities.tests
|
||||||
USING: accessors xmode.utilities tools.test xml xml.data kernel
|
|
||||||
strings vectors sequences io.files prettyprint assocs
|
|
||||||
unicode.case ;
|
|
||||||
[ "hi" 3 ] [
|
[ "hi" 3 ] [
|
||||||
{ 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
|
{ 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
|
||||||
] unit-test
|
] unit-test
|
||||||
|
@ -9,44 +8,3 @@ unicode.case ;
|
||||||
[ f f ] [
|
[ f f ] [
|
||||||
{ 1 2 3 4 5 6 7 8 } [ H{ { 11 "hi" } } at ] map-find
|
{ 1 2 3 4 5 6 7 8 } [ H{ { 11 "hi" } } at ] map-find
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
TUPLE: company employees type ;
|
|
||||||
|
|
||||||
: <company> V{ } clone f company boa ;
|
|
||||||
|
|
||||||
: add-employee employees>> push ;
|
|
||||||
|
|
||||||
<TAGS: parse-employee-tag
|
|
||||||
|
|
||||||
TUPLE: employee name description ;
|
|
||||||
|
|
||||||
TAG: employee
|
|
||||||
employee new
|
|
||||||
{ { "name" f (>>name) } { f (>>description) } }
|
|
||||||
init-from-tag swap add-employee ;
|
|
||||||
|
|
||||||
TAGS>
|
|
||||||
|
|
||||||
\ parse-employee-tag see
|
|
||||||
|
|
||||||
: parse-company-tag
|
|
||||||
[
|
|
||||||
<company>
|
|
||||||
{ { "type" >upper (>>type) } }
|
|
||||||
init-from-tag dup
|
|
||||||
] keep
|
|
||||||
children>> [ tag? ] filter
|
|
||||||
[ parse-employee-tag ] with each ;
|
|
||||||
|
|
||||||
[
|
|
||||||
T{ company f
|
|
||||||
V{
|
|
||||||
T{ employee f "Joe" "VP Sales" }
|
|
||||||
T{ employee f "Jane" "CFO" }
|
|
||||||
}
|
|
||||||
"PUBLIC"
|
|
||||||
}
|
|
||||||
] [
|
|
||||||
"resource:basis/xmode/utilities/test.xml"
|
|
||||||
file>xml parse-company-tag
|
|
||||||
] unit-test
|
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
USING: accessors sequences assocs kernel quotations namespaces
|
USING: accessors sequences assocs kernel quotations namespaces
|
||||||
xml.data xml.traversal combinators macros parser lexer words fry ;
|
xml.data xml.traversal combinators macros parser lexer words fry
|
||||||
|
regexp ;
|
||||||
IN: xmode.utilities
|
IN: xmode.utilities
|
||||||
|
|
||||||
: implies ( x y -- z ) [ not ] dip or ; inline
|
: implies ( x y -- z ) [ not ] dip or ; inline
|
||||||
|
@ -35,3 +36,6 @@ MACRO: (init-from-tag) ( specs -- )
|
||||||
|
|
||||||
: init-from-tag ( tag tuple specs -- tuple )
|
: init-from-tag ( tag tuple specs -- tuple )
|
||||||
over [ (init-from-tag) ] dip ; inline
|
over [ (init-from-tag) ] dip ; inline
|
||||||
|
|
||||||
|
: <?insensitive-regexp> ( string ? -- regexp )
|
||||||
|
"i" "" ? <optioned-regexp> ;
|
||||||
|
|
Loading…
Reference in New Issue