steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix a couple of bugs in xmode and add a unit test

db4
Slava Pestov 2009-01-30 19:34:31 -06:00
parent e36376b432
commit f8092480a6
7 changed files with 49 additions and 39 deletions

36
basis/xmode/catalog/catalog.factor
View File

@ -52,9 +52,15 @@ SYMBOL: rule-sets
dup "::" split1 [ swap (load-mode) ] [ rule-sets get ] if*
dup -roll at* [ nip ] [ drop no-such-rule-set ] if ;
DEFER: finalize-rule-set
: resolve-delegate ( rule -- )
dup delegate>> dup string?
[ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ;
dup delegate>> dup string? [
get-rule-set
dup rule-set? [ "not a rule set" throw ] unless
swap rule-sets [ dup finalize-rule-set ] with-variable
>>delegate drop
] [ 2drop ] if ;
: each-rule ( rule-set quot -- )
[ rules>> values concat ] dip each ; inline
@ -74,26 +80,22 @@ SYMBOL: rule-sets
: resolve-imports ( ruleset -- )
dup imports>> [
get-rule-set swap rule-sets [
dup resolve-delegates
2dup import-keywords
import-rules
[ nip resolve-delegates ]
[ import-keywords ]
[ import-rules ]
2tri
] with-variable
] with each ;
ERROR: mutually-recursive-rulesets ruleset ;
: finalize-rule-set ( ruleset -- )
dup finalized?>> {
{ f [
{
[ 1 >>finalized? drop ]
[ resolve-imports ]
[ resolve-delegates ]
[ t >>finalized? drop ]
} cleave
] }
{ t [ drop ] }
{ 1 [ mutually-recursive-rulesets ] }
} case ;
dup finalized?>> [ drop ] [
t >>finalized?
[ resolve-imports ]
[ resolve-delegates ]
bi
] if ;
: finalize-mode ( rulesets -- )
rule-sets [

9
basis/xmode/code2html/code2html-tests.factor
View File

@ -1,7 +1,7 @@
IN: xmode.code2html.tests
USING: xmode.code2html xmode.catalog
tools.test multiline splitting memoize
kernel ;
kernel io.streams.string xml.writer ;
[ ] [ \ (load-mode) reset-memoized ] unit-test
@ -9,4 +9,11 @@ kernel ;
<" <style type="text/css" media="screen" >
* {margin:0; padding:0; border:0;} ">
string-lines "html" htmlize-lines drop
] unit-test
[ ] [
"test.c"
<" int x = "hi";
/* a comment */ "> <string-reader> htmlize-stream
write-xml
] unit-test

6
basis/xmode/code2html/code2html.factor
View File

@ -8,14 +8,14 @@ IN: xmode.code2html
[ str>> ] [ id>> ] bi [
name>> swap
[XML <span class=<->><-></span> XML]
] [ ] if*
] when*
] map ;
: htmlize-line ( line-context line rules -- line-context' xml )
tokenize-line htmlize-tokens ;
: htmlize-lines ( lines mode -- xml )
[ f ] 2dip load-mode [ htmlize-line ] curry map nip ;
[ f ] 2dip load-mode [ htmlize-line "\n" suffix ] curry map nip ;
: default-stylesheet ( -- xml )
"resource:basis/xmode/code2html/stylesheet.css"
@ -24,7 +24,7 @@ IN: xmode.code2html
:: htmlize-stream ( path stream -- xml )
stream lines
[ "" ] [ first find-mode path swap htmlize-lines ]
[ "" ] [ path over first find-mode htmlize-lines ]
if-empty :> input
default-stylesheet :> stylesheet
<XML <html>

16
basis/xmode/loader/loader.factor
View File

@ -43,17 +43,17 @@ RULE: MARK_PREVIOUS mark-previous-rule
shared-tag-attrs match-type-attr literal-start ;
TAG: KEYWORDS ( rule-set tag -- key value )
ignore-case? get <keyword-map>
rule-set get ignore-case?>> <keyword-map>
swap child-tags [ over parse-keyword-tag ] each
swap (>>keywords) ;
TAGS>
: ?<regexp> ( string/f -- regexp/f )
dup [ ignore-case? get <regexp> ] when ;
dup [ rule-set get ignore-case?>> <regexp> ] when ;
: (parse-rules-tag) ( tag -- rule-set )
<rule-set>
<rule-set> dup rule-set set
{
{ "SET" string>rule-set-name (>>name) }
{ "IGNORE_CASE" string>boolean (>>ignore-case?) }
@ -65,11 +65,11 @@ TAGS>
} init-from-tag ;
: parse-rules-tag ( tag -- rule-set )
dup (parse-rules-tag) [
dup ignore-case?>> ignore-case? [
swap child-tags [ parse-rule-tag ] with each
] with-variable
] keep ;
[
[ (parse-rules-tag) ] [ child-tags ] bi
[ parse-rule-tag ] with each
rule-set get
] with-scope ;
: merge-rule-set-props ( props rule-set -- )
[ assoc-union ] change-props drop ;

13
basis/xmode/loader/syntax/syntax.factor
View File

@ -1,13 +1,11 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors xmode.tokens xmode.rules xmode.keyword-map
xml.data xml.utilities xml assocs kernel combinators sequences
math.parser namespaces make parser lexer xmode.utilities
parser-combinators.regexp io.files ;
parser-combinators.regexp io.files splitting arrays ;
IN: xmode.loader.syntax
SYMBOL: ignore-case?
! Rule tag parsing utilities
: (parse-rule-tag) ( rule-set tag specs class -- )
new swap init-from-tag swap add-rule ; inline
@ -44,16 +42,19 @@ SYMBOL: ignore-case?
: parse-literal-matcher ( tag -- matcher )
dup children>string
ignore-case? get <string-matcher>
rule-set get ignore-case?>> <string-matcher>
swap position-attrs <matcher> ;
: parse-regexp-matcher ( tag -- matcher )
dup children>string ignore-case? get <regexp>
dup children>string rule-set get ignore-case?>> <regexp>
swap position-attrs <matcher> ;
: shared-tag-attrs ( -- )
{ "TYPE" string>token (>>body-token) } , ; inline
: parse-delegate ( string -- pair )
"::" split1 [ rule-set get swap ] unless* 2array ;
: delegate-attr ( -- )
{ "DELEGATE" f (>>delegate) } , ;

4
basis/xmode/marker/context/context.factor
View File

@ -1,4 +1,4 @@
USING: accessors kernel ;
USING: accessors kernel xmode.rules ;
IN: xmode.marker.context
! Based on org.gjt.sp.jedit.syntax.TokenMarker.LineContext
@ -10,7 +10,7 @@ end
;
: <line-context> ( ruleset parent -- line-context )
over [ "no context" throw ] unless
over rule-set? [ "not a rule-set" throw ] unless
line-context new
swap >>parent
swap >>in-rule-set ;

4
basis/xmode/marker/marker.factor
View File

@ -157,7 +157,7 @@ M: seq-rule handle-rule-start
mark-token
add-remaining-token
tuck body-token>> next-token,
delegate>> [ push-context ] when* ;
get-delegate [ push-context ] when* ;
UNION: abstract-span-rule span-rule eol-span-rule ;
@ -168,7 +168,7 @@ M: abstract-span-rule handle-rule-start
tuck rule-match-token* next-token,
! ... end subst ...
dup context get (>>in-rule)
delegate>> push-context ;
get-delegate push-context ;
M: span-rule handle-rule-end
2drop ;