XMode doesn't use parser combinators at all; regexes allow parens for grouping
parent
d0d615fb2b
commit
ff265aa919
basis
regexp/nfa
xmode
catalog
loader
marker
|
@ -183,15 +183,8 @@ M: character-class-range nfa-node ( node -- )
|
|||
] if ;
|
||||
|
||||
M: capture-group nfa-node ( node -- )
|
||||
"capture-groups" feature-is-broken
|
||||
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 ;
|
||||
term>> nfa-node ;
|
||||
|
||||
! xyzzy
|
||||
M: non-capture-group nfa-node ( node -- )
|
||||
term>> nfa-node ;
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
USING: xmode.loader xmode.utilities xmode.rules namespaces
|
||||
strings splitting assocs sequences kernel io.files xml memoize
|
||||
words globs combinators io.encodings.utf8 sorting accessors xml.data
|
||||
xml.traversal ;
|
||||
xml.traversal xml.syntax ;
|
||||
IN: xmode.catalog
|
||||
|
||||
TUPLE: mode file file-name-glob first-line-glob ;
|
||||
|
@ -97,8 +97,8 @@ ERROR: mutually-recursive-rulesets ruleset ;
|
|||
] if ;
|
||||
|
||||
: finalize-mode ( rulesets -- )
|
||||
rule-sets [
|
||||
dup [ nip finalize-rule-set ] assoc-each
|
||||
dup rule-sets [
|
||||
[ nip finalize-rule-set ] assoc-each
|
||||
] with-variable ;
|
||||
|
||||
: load-mode ( name -- rule-sets )
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
USING: xmode.loader.syntax xmode.tokens xmode.rules
|
||||
xmode.keyword-map xml.data xml.traversal xml assocs kernel
|
||||
combinators sequences math.parser namespaces parser
|
||||
xmode.utilities regexp io.files accessors ;
|
||||
xmode.utilities regexp io.files accessors xml.syntax ;
|
||||
IN: xmode.loader
|
||||
|
||||
! Based on org.gjt.sp.jedit.XModeHandler
|
||||
|
@ -48,7 +48,7 @@ TAG: KEYWORDS parse-rule-tag
|
|||
swap (>>keywords) ;
|
||||
|
||||
: ?<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 )
|
||||
<rule-set> dup rule-set set
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors xmode.tokens xmode.rules xmode.keyword-map
|
||||
xml.data xml.traversal xml assocs kernel combinators sequences
|
||||
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
|
||||
|
||||
! Rule tag parsing utilities
|
||||
|
@ -11,10 +11,10 @@ IN: xmode.loader.syntax
|
|||
new swap init-from-tag swap add-rule ; inline
|
||||
|
||||
: RULE:
|
||||
scan scan-word scan-word
|
||||
parse-definition { } make
|
||||
[ swap [ (parse-rule-tag) ] 2curry ] dip
|
||||
swap define-tag ; parsing
|
||||
scan scan-word scan-word [
|
||||
parse-definition { } make
|
||||
swap [ (parse-rule-tag) ] 2curry
|
||||
] dip swap define-tag ; parsing
|
||||
|
||||
! Attribute utilities
|
||||
: string>boolean ( string -- ? ) "TRUE" = ;
|
||||
|
@ -47,7 +47,8 @@ IN: xmode.loader.syntax
|
|||
swap position-attrs <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> ;
|
||||
|
||||
: shared-tag-attrs ( -- )
|
||||
|
|
|
@ -4,11 +4,25 @@ IN: xmode.marker
|
|||
USING: kernel namespaces make xmode.rules xmode.tokens
|
||||
xmode.marker.state xmode.marker.context xmode.utilities
|
||||
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 ;
|
||||
! parser-combinators is for the string-head? word
|
||||
! 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
|
||||
|
||||
: current-keyword ( -- string )
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
USING: assocs xmode.utilities tools.test ;
|
||||
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 ] [
|
||||
{ 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
|
||||
] unit-test
|
||||
|
@ -9,44 +8,3 @@ unicode.case ;
|
|||
[ f f ] [
|
||||
{ 1 2 3 4 5 6 7 8 } [ H{ { 11 "hi" } } at ] map-find
|
||||
] 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
|
||||
xml.data xml.traversal combinators macros parser lexer words fry ;
|
||||
xml.data xml.traversal combinators macros parser lexer words fry
|
||||
regexp ;
|
||||
IN: xmode.utilities
|
||||
|
||||
: implies ( x y -- z ) [ not ] dip or ; inline
|
||||
|
@ -35,3 +36,6 @@ MACRO: (init-from-tag) ( specs -- )
|
|||
|
||||
: init-from-tag ( tag tuple specs -- tuple )
|
||||
over [ (init-from-tag) ] dip ; inline
|
||||
|
||||
: <?insensitive-regexp> ( string ? -- regexp )
|
||||
"i" "" ? <optioned-regexp> ;
|
||||
|
|
Loading…
Reference in New Issue