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

Get more code to load after SYNTAX: change

db4
Slava Pestov 2009-03-21 03:22:21 -05:00
parent 385892be64
commit 30816ba5d0
3 changed files with 33 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/html/templates/chloe/components/components.factor
View File

@ -25,8 +25,7 @@ M: tuple-class component-tag ( tag class -- )
[ compile-component-attrs ] 2bi [ compile-component-attrs ] 2bi
[ render ] [code] ; [ render ] [code] ;
: COMPONENT: SYNTAX: COMPONENT:
scan-word scan-word
[ name>> ] [ '[ _ component-tag ] ] bi [ name>> ] [ '[ _ component-tag ] ] bi
define-chloe-tag ; define-chloe-tag ;
parsing

9
extra/multi-methods/multi-methods.factor
View File

@ -224,8 +224,7 @@ M: no-method error.
] if ; ] if ;
! Syntax ! Syntax
: GENERIC: SYNTAX: GENERIC: CREATE define-generic ;
CREATE define-generic ; parsing
: parse-method ( -- quot classes generic ) : parse-method ( -- quot classes generic )
parse-definition [ 2 tail ] [ second ] [ first ] tri ; parse-definition [ 2 tail ] [ second ] [ first ] tri ;
@ -238,13 +237,13 @@ M: no-method error.
: (METHOD:) ( -- method def ) CREATE-METHOD parse-definition ; : (METHOD:) ( -- method def ) CREATE-METHOD parse-definition ;
: METHOD: (METHOD:) define ; parsing SYNTAX: METHOD: (METHOD:) define ;
! For compatibility ! For compatibility
: M: SYNTAX: M:
scan-word 1array scan-word create-method-in scan-word 1array scan-word create-method-in
parse-definition parse-definition
define ; parsing define ;
! Definition protocol. We qualify core generics here ! Definition protocol. We qualify core generics here
QUALIFIED: syntax QUALIFIED: syntax

46
extra/peg-lexer/peg-lexer.factor
View File

@ -9,36 +9,46 @@ CONSULT: assoc-protocol lex-hash hash>> ;
: pos-or-0 ( neg? -- pos/0 ) dup 0 < [ drop 0 ] when ; : pos-or-0 ( neg? -- pos/0 ) dup 0 < [ drop 0 ] when ;
:: prepare-pos ( v i -- c l ) :: prepare-pos ( v i -- c l )
[let | n [ i v head-slice ] | [let | n [ i v head-slice ] |
v CHAR: \n n last-index -1 or 1+ - v CHAR: \n n last-index -1 or 1+ -
n [ CHAR: \n = ] count 1+ ] ; n [ CHAR: \n = ] count 1+
] ;
: store-pos ( v a -- ) input swap at prepare-pos : store-pos ( v a -- )
lexer get [ (>>line) ] keep (>>column) ; input swap at prepare-pos
lexer get [ (>>line) ] keep (>>column) ;
M: lex-hash set-at swap { M: lex-hash set-at
{ pos [ store-pos ] } swap {
[ swap hash>> set-at ] } case ; { pos [ store-pos ] }
[ swap hash>> set-at ]
} case ;
:: at-pos ( t l c -- p ) t l head-slice [ length ] map sum l 1- + c + ; :: at-pos ( t l c -- p ) t l head-slice [ length ] map sum l 1- + c + ;
M: lex-hash at* swap { M: lex-hash at*
swap {
{ input [ drop lexer get text>> "\n" join t ] } { input [ drop lexer get text>> "\n" join t ] }
{ pos [ drop lexer get [ text>> ] [ line>> 1- ] [ column>> 1+ ] tri at-pos t ] } { pos [ drop lexer get [ text>> ] [ line>> 1- ] [ column>> 1+ ] tri at-pos t ] }
[ swap hash>> at* ] } case ; [ swap hash>> at* ]
} case ;
: with-global-lexer ( quot -- result ) : with-global-lexer ( quot -- result )
[ f lrstack set [
V{ } clone error-stack set H{ } clone \ heads set f lrstack set
H{ } clone \ packrat set ] f make-assoc <lex-hash> V{ } clone error-stack set H{ } clone \ heads set
H{ } clone \ packrat set
] f make-assoc <lex-hash>
swap bind ; inline swap bind ; inline
: parse* ( parser -- ast ) compile : parse* ( parser -- ast )
[ execute [ error-stack get first throw ] unless* ] with-global-lexer compile
ast>> ; [ execute [ error-stack get first throw ] unless* ] with-global-lexer
ast>> ;
: create-bnf ( name parser -- ) reset-tokenizer [ lexer get skip-blank parse* parsed ] curry : create-bnf ( name parser -- )
define word make-parsing ; reset-tokenizer [ lexer get skip-blank parse* parsed ] curry
define-syntax ;
SYNTAX: ON-BNF: SYNTAX: ON-BNF:
CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf