Merge branch 'master' of git://double.co.nz/git/factor
Doug Coleman
commit
fd1d1387a4
|
|
@ -2,7 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: kernel tools.test peg peg.ebnf words math math.parser
|
||||
sequences accessors ;
|
||||
sequences accessors peg.parsers parser namespaces arrays
|
||||
strings ;
|
||||
IN: peg.ebnf.tests
|
||||
|
||||
{ T{ ebnf-non-terminal f "abc" } } [
|
||||
|
|
@ -164,23 +165,23 @@ IN: peg.ebnf.tests
|
|||
] unit-test
|
||||
|
||||
{ 6 } [
|
||||
"4+2" [EBNF num=[0-9] => [[ digit> ]] foo=num:x '+' num:y => [[ drop x y + ]] EBNF] call ast>>
|
||||
"4+2" [EBNF num=[0-9] => [[ digit> ]] foo=num:x '+' num:y => [[ x y + ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ 6 } [
|
||||
"4+2" [EBNF foo=[0-9]:x '+' [0-9]:y => [[ drop x digit> y digit> + ]] EBNF] call ast>>
|
||||
"4+2" [EBNF foo=[0-9]:x '+' [0-9]:y => [[ x digit> y digit> + ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ 10 } [
|
||||
{ 1 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call ast>>
|
||||
{ 1 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ x y + ]] | num EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
{ "a" 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call
|
||||
{ "a" 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ x y + ]] | num EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ 3 } [
|
||||
{ 1 2 "a" 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call ast>>
|
||||
{ 1 2 "a" 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ x y + ]] | num EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -251,7 +252,7 @@ IN: peg.ebnf.tests
|
|||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"abcd='9' | ('8'):x => [[ drop x ]]" 'ebnf' parse parse-result-remaining empty?
|
||||
"abcd='9' | ('8'):x => [[ x ]]" 'ebnf' parse parse-result-remaining empty?
|
||||
] unit-test
|
||||
|
||||
EBNF: primary
|
||||
|
|
@ -365,3 +366,153 @@ main = Primary
|
|||
"ab c ab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "a" "a" } } [
|
||||
"aaa" [EBNF a=('a')* b=!('b') a:x => [[ x ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"aaa" [EBNF a=('a')* b=!('b') a:x => [[ x ]] EBNF] call ast>>
|
||||
"aaa" [EBNF a=('a')* b=!('b') (a):x => [[ x ]] EBNF] call ast>> =
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "a" "a" } } [
|
||||
"aaa" [EBNF a=('a')* b=a:x => [[ x ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"aaa" [EBNF a=('a')* b=a:x => [[ x ]] EBNF] call ast>>
|
||||
"aaa" [EBNF a=('a')* b=(a):x => [[ x ]] EBNF] call ast>> =
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=(digit)+:n 'a'" 'ebnf' parse remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=(digit)+ 'a'" 'ebnf' parse remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=digit+ 'a'" 'ebnf' parse remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"number=digit+:n 'a'" 'ebnf' parse remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"foo=(name):n !(keyword) => [[ n ]]" 'rule' parse ast>>
|
||||
"foo=name:n !(keyword) => [[ n ]]" 'rule' parse ast>> =
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"foo=!(keyword) (name):n => [[ n ]]" 'rule' parse ast>>
|
||||
"foo=!(keyword) name:n => [[ n ]]" 'rule' parse ast>> =
|
||||
] unit-test
|
||||
|
||||
<<
|
||||
EBNF: parser1
|
||||
foo='a'
|
||||
;EBNF
|
||||
>>
|
||||
|
||||
EBNF: parser2
|
||||
foo=<foreign parser1 foo> 'b'
|
||||
;EBNF
|
||||
|
||||
EBNF: parser3
|
||||
foo=<foreign parser1> 'c'
|
||||
;EBNF
|
||||
|
||||
EBNF: parser4
|
||||
foo=<foreign any-char> 'd'
|
||||
;EBNF
|
||||
|
||||
{ "a" } [
|
||||
"a" parser1 ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
"ab" parser2 ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "c" } } [
|
||||
"ac" parser3 ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ CHAR: a "d" } } [
|
||||
"ad" parser4 ast>>
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"USING: kernel peg.ebnf ; [EBNF foo='a' '\n' => [[ drop \"\n\" ]] EBNF]" eval drop t
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"USING: peg.ebnf ; [EBNF foo='a' foo='b' EBNF]" eval drop
|
||||
] must-fail
|
||||
|
||||
{ t } [
|
||||
#! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule
|
||||
#! if a var in a namespace is set. This unit test is to remind me to fix this.
|
||||
[ "fail" "foo" set "foo='a'" 'ebnf' parse ast>> transform drop t ] with-scope
|
||||
] unit-test
|
||||
|
||||
#! Tokenizer tests
|
||||
{ V{ "a" CHAR: b } } [
|
||||
"ab" [EBNF tokenizer=default foo="a" . EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
TUPLE: ast-number value ;
|
||||
|
||||
EBNF: a-tokenizer
|
||||
Letter = [a-zA-Z]
|
||||
Digit = [0-9]
|
||||
Digits = Digit+
|
||||
SingleLineComment = "//" (!("\n") .)* "\n" => [[ ignore ]]
|
||||
MultiLineComment = "/*" (!("*/") .)* "*/" => [[ ignore ]]
|
||||
Space = " " | "\t" | "\r" | "\n" | SingleLineComment | MultiLineComment
|
||||
Spaces = Space* => [[ ignore ]]
|
||||
Number = Digits:ws '.' Digits:fs => [[ ws "." fs 3array concat >string string>number ast-number boa ]]
|
||||
| Digits => [[ >string string>number ast-number boa ]]
|
||||
Special = "(" | ")" | "{" | "}" | "[" | "]" | "," | ";"
|
||||
| "?" | ":" | "!==" | "~=" | "===" | "==" | "=" | ">="
|
||||
| ">" | "<=" | "<" | "++" | "+=" | "+" | "--" | "-="
|
||||
| "-" | "*=" | "*" | "/=" | "/" | "%=" | "%" | "&&="
|
||||
| "&&" | "||=" | "||" | "." | "!"
|
||||
Tok = Spaces (Number | Special )
|
||||
;EBNF
|
||||
|
||||
{ V{ CHAR: 1 T{ ast-number f 23 } ";" CHAR: x } } [
|
||||
"123;x" [EBNF bar = .
|
||||
tokenizer = <foreign a-tokenizer Tok> foo=.
|
||||
tokenizer=default baz=.
|
||||
main = bar foo foo baz
|
||||
EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ CHAR: 5 "+" CHAR: 2 } } [
|
||||
"5+2" [EBNF
|
||||
space=(" " | "\n")
|
||||
number=[0-9]
|
||||
operator=("*" | "+")
|
||||
spaces=space* => [[ ignore ]]
|
||||
tokenizer=spaces (number | operator)
|
||||
main= . . .
|
||||
EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ CHAR: 5 "+" CHAR: 2 } } [
|
||||
"5 + 2" [EBNF
|
||||
space=(" " | "\n")
|
||||
number=[0-9]
|
||||
operator=("*" | "+")
|
||||
spaces=space* => [[ ignore ]]
|
||||
tokenizer=spaces (number | operator)
|
||||
main= . . .
|
||||
EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ "++" } [
|
||||
"++--" [EBNF tokenizer=("++" | "--") main="++" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
|
@ -1,13 +1,45 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel compiler.units parser words arrays strings math.parser sequences
|
||||
USING: kernel compiler.units words arrays strings math.parser sequences
|
||||
quotations vectors namespaces math assocs continuations peg
|
||||
peg.parsers unicode.categories multiline combinators.lib
|
||||
splitting accessors effects sequences.deep peg.search ;
|
||||
peg.parsers unicode.categories multiline combinators combinators.lib
|
||||
splitting accessors effects sequences.deep peg.search inference
|
||||
io.streams.string io prettyprint parser ;
|
||||
IN: peg.ebnf
|
||||
|
||||
: rule ( name word -- parser )
|
||||
#! Given an EBNF word produced from EBNF: return the EBNF rule
|
||||
"ebnf-parser" word-prop at ;
|
||||
|
||||
TUPLE: tokenizer any one many ;
|
||||
|
||||
: default-tokenizer ( -- tokenizer )
|
||||
T{ tokenizer f
|
||||
[ any-char ]
|
||||
[ token ]
|
||||
[ [ = ] curry any-char swap semantic ]
|
||||
} ;
|
||||
|
||||
: parser-tokenizer ( parser -- tokenizer )
|
||||
[ 1quotation ] keep
|
||||
[ swap [ = ] curry semantic ] curry dup tokenizer boa ;
|
||||
|
||||
: rule-tokenizer ( name word -- tokenizer )
|
||||
rule parser-tokenizer ;
|
||||
|
||||
: tokenizer ( -- word )
|
||||
\ tokenizer get-global [ default-tokenizer ] unless* ;
|
||||
|
||||
: reset-tokenizer ( -- )
|
||||
default-tokenizer \ tokenizer set-global ;
|
||||
|
||||
: TOKENIZER:
|
||||
scan search [ "Tokenizer not found" throw ] unless*
|
||||
execute \ tokenizer set-global ; parsing
|
||||
|
||||
TUPLE: ebnf-non-terminal symbol ;
|
||||
TUPLE: ebnf-terminal symbol ;
|
||||
TUPLE: ebnf-foreign word rule ;
|
||||
TUPLE: ebnf-any-character ;
|
||||
TUPLE: ebnf-range pattern ;
|
||||
TUPLE: ebnf-ensure group ;
|
||||
|
|
@ -18,6 +50,7 @@ TUPLE: ebnf-repeat0 group ;
|
|||
TUPLE: ebnf-repeat1 group ;
|
||||
TUPLE: ebnf-optional group ;
|
||||
TUPLE: ebnf-whitespace group ;
|
||||
TUPLE: ebnf-tokenizer elements ;
|
||||
TUPLE: ebnf-rule symbol elements ;
|
||||
TUPLE: ebnf-action parser code ;
|
||||
TUPLE: ebnf-var parser name ;
|
||||
|
|
@ -26,6 +59,7 @@ TUPLE: ebnf rules ;
|
|||
|
||||
C: <ebnf-non-terminal> ebnf-non-terminal
|
||||
C: <ebnf-terminal> ebnf-terminal
|
||||
C: <ebnf-foreign> ebnf-foreign
|
||||
C: <ebnf-any-character> ebnf-any-character
|
||||
C: <ebnf-range> ebnf-range
|
||||
C: <ebnf-ensure> ebnf-ensure
|
||||
|
|
@ -36,12 +70,17 @@ C: <ebnf-repeat0> ebnf-repeat0
|
|||
C: <ebnf-repeat1> ebnf-repeat1
|
||||
C: <ebnf-optional> ebnf-optional
|
||||
C: <ebnf-whitespace> ebnf-whitespace
|
||||
C: <ebnf-tokenizer> ebnf-tokenizer
|
||||
C: <ebnf-rule> ebnf-rule
|
||||
C: <ebnf-action> ebnf-action
|
||||
C: <ebnf-var> ebnf-var
|
||||
C: <ebnf-semantic> ebnf-semantic
|
||||
C: <ebnf> ebnf
|
||||
|
||||
: filter-hidden ( seq -- seq )
|
||||
#! Remove elements that produce no AST from sequence
|
||||
[ ebnf-ensure-not? not ] filter [ ebnf-ensure? not ] filter ;
|
||||
|
||||
: syntax ( string -- parser )
|
||||
#! Parses the string, ignoring white space, and
|
||||
#! does not put the result in the AST.
|
||||
|
|
@ -52,6 +91,25 @@ C: <ebnf> ebnf
|
|||
#! begin and end.
|
||||
[ syntax ] 2dip syntax pack ;
|
||||
|
||||
#! Don't want to use 'replace' in an action since replace doesn't infer.
|
||||
#! Do the compilation of the peg at parse time and call (replace).
|
||||
PEG: escaper ( string -- ast )
|
||||
[
|
||||
"\\t" token [ drop "\t" ] action ,
|
||||
"\\n" token [ drop "\n" ] action ,
|
||||
"\\r" token [ drop "\r" ] action ,
|
||||
] choice* any-char-parser 2array choice repeat0 ;
|
||||
|
||||
: replace-escapes ( string -- string )
|
||||
escaper sift [ [ tree-write ] each ] with-string-writer ;
|
||||
|
||||
: insert-escapes ( string -- string )
|
||||
[
|
||||
"\t" token [ drop "\\t" ] action ,
|
||||
"\n" token [ drop "\\n" ] action ,
|
||||
"\r" token [ drop "\\r" ] action ,
|
||||
] choice* replace ;
|
||||
|
||||
: 'identifier' ( -- parser )
|
||||
#! Return a parser that parses an identifer delimited by
|
||||
#! a quotation character. The quotation can be single
|
||||
|
|
@ -60,7 +118,7 @@ C: <ebnf> ebnf
|
|||
[
|
||||
[ CHAR: " = not ] satisfy repeat1 "\"" "\"" surrounded-by ,
|
||||
[ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,
|
||||
] choice* [ >string ] action ;
|
||||
] choice* [ >string replace-escapes ] action ;
|
||||
|
||||
: 'non-terminal' ( -- parser )
|
||||
#! A non-terminal is the name of another rule. It can
|
||||
|
|
@ -87,6 +145,8 @@ C: <ebnf> ebnf
|
|||
[ dup CHAR: ? = ]
|
||||
[ dup CHAR: : = ]
|
||||
[ dup CHAR: ~ = ]
|
||||
[ dup CHAR: < = ]
|
||||
[ dup CHAR: > = ]
|
||||
} 0|| not nip
|
||||
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;
|
||||
|
||||
|
|
@ -95,6 +155,24 @@ C: <ebnf> ebnf
|
|||
#! and it represents the literal value of the identifier.
|
||||
'identifier' [ <ebnf-terminal> ] action ;
|
||||
|
||||
: 'foreign-name' ( -- parser )
|
||||
#! Parse a valid foreign parser name
|
||||
[
|
||||
{
|
||||
[ dup blank? ]
|
||||
[ dup CHAR: > = ]
|
||||
} 0|| not nip
|
||||
] satisfy repeat1 [ >string ] action ;
|
||||
|
||||
: 'foreign' ( -- parser )
|
||||
#! A foreign call is a call to a rule in another ebnf grammar
|
||||
[
|
||||
"<foreign" syntax ,
|
||||
'foreign-name' sp ,
|
||||
'foreign-name' sp optional ,
|
||||
">" syntax ,
|
||||
] seq* [ first2 <ebnf-foreign> ] action ;
|
||||
|
||||
: 'any-character' ( -- parser )
|
||||
#! A parser to match the symbol for any character match.
|
||||
[ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ;
|
||||
|
|
@ -113,11 +191,18 @@ C: <ebnf> ebnf
|
|||
#! The latter indicates that it is the beginning of a
|
||||
#! new rule.
|
||||
[
|
||||
[
|
||||
'non-terminal' ,
|
||||
'terminal' ,
|
||||
'range-parser' ,
|
||||
'any-character' ,
|
||||
[
|
||||
[
|
||||
'non-terminal' ,
|
||||
'terminal' ,
|
||||
'foreign' ,
|
||||
'range-parser' ,
|
||||
'any-character' ,
|
||||
] choice*
|
||||
[ dup , "*" token hide , ] seq* [ first <ebnf-repeat0> ] action ,
|
||||
[ dup , "+" token hide , ] seq* [ first <ebnf-repeat1> ] action ,
|
||||
[ dup , "?[" token ensure-not , "?" token hide , ] seq* [ first <ebnf-optional> ] action ,
|
||||
,
|
||||
] choice* ,
|
||||
[
|
||||
"=" syntax ensure-not ,
|
||||
|
|
@ -125,6 +210,8 @@ C: <ebnf> ebnf
|
|||
] choice* ,
|
||||
] seq* [ first ] action ;
|
||||
|
||||
DEFER: 'action'
|
||||
|
||||
: 'element' ( -- parser )
|
||||
[
|
||||
[ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
|
||||
|
|
@ -192,14 +279,18 @@ DEFER: 'choice'
|
|||
: ('sequence') ( -- parser )
|
||||
#! A sequence of terminals and non-terminals, including
|
||||
#! groupings of those.
|
||||
[
|
||||
'ensure-not' sp ,
|
||||
'ensure' sp ,
|
||||
'element' sp ,
|
||||
'group' sp ,
|
||||
'repeat0' sp ,
|
||||
'repeat1' sp ,
|
||||
'optional' sp ,
|
||||
[
|
||||
[
|
||||
'ensure-not' sp ,
|
||||
'ensure' sp ,
|
||||
'element' sp ,
|
||||
'group' sp ,
|
||||
'repeat0' sp ,
|
||||
'repeat1' sp ,
|
||||
'optional' sp ,
|
||||
] choice*
|
||||
[ dup , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
|
||||
,
|
||||
] choice* ;
|
||||
|
||||
: 'action' ( -- parser )
|
||||
|
|
@ -222,18 +313,25 @@ DEFER: 'choice'
|
|||
: 'actioned-sequence' ( -- parser )
|
||||
[
|
||||
[ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 <ebnf-action> ] action ,
|
||||
[ 'sequence' , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , "=>" syntax , 'action' , ] seq* [ first3 >r <ebnf-var> r> <ebnf-action> ] action ,
|
||||
[ 'sequence' , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
|
||||
'sequence' ,
|
||||
] choice* ;
|
||||
|
||||
: 'choice' ( -- parser )
|
||||
'actioned-sequence' sp "|" token sp list-of [
|
||||
'actioned-sequence' sp repeat1 [ dup length 1 = [ first ] [ <ebnf-sequence> ] if ] action "|" token sp list-of [
|
||||
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
||||
] action ;
|
||||
|
||||
: 'tokenizer' ( -- parser )
|
||||
[
|
||||
"tokenizer" syntax ,
|
||||
"=" syntax ,
|
||||
">" token ensure-not ,
|
||||
[ "default" token sp , 'choice' , ] choice* ,
|
||||
] seq* [ first <ebnf-tokenizer> ] action ;
|
||||
|
||||
: 'rule' ( -- parser )
|
||||
[
|
||||
"tokenizer" token ensure-not ,
|
||||
'non-terminal' [ symbol>> ] action ,
|
||||
"=" syntax ,
|
||||
">" token ensure-not ,
|
||||
|
|
@ -241,7 +339,7 @@ DEFER: 'choice'
|
|||
] seq* [ first2 <ebnf-rule> ] action ;
|
||||
|
||||
: 'ebnf' ( -- parser )
|
||||
'rule' sp repeat1 [ <ebnf> ] action ;
|
||||
[ 'tokenizer' sp , 'rule' sp , ] choice* repeat1 [ <ebnf> ] action ;
|
||||
|
||||
GENERIC: (transform) ( ast -- parser )
|
||||
|
||||
|
|
@ -259,11 +357,23 @@ SYMBOL: ignore-ws
|
|||
|
||||
M: ebnf (transform) ( ast -- parser )
|
||||
rules>> [ (transform) ] map peek ;
|
||||
|
||||
M: ebnf-tokenizer (transform) ( ast -- parser )
|
||||
elements>> dup "default" = [
|
||||
drop default-tokenizer \ tokenizer set-global any-char
|
||||
] [
|
||||
(transform)
|
||||
dup parser-tokenizer \ tokenizer set-global
|
||||
] if ;
|
||||
|
||||
M: ebnf-rule (transform) ( ast -- parser )
|
||||
dup elements>>
|
||||
(transform) [
|
||||
swap symbol>> set
|
||||
swap symbol>> dup get { [ tuple? ] [ delegate parser? ] } 1&& [
|
||||
"Rule '" over append "' defined more than once" append throw
|
||||
] [
|
||||
set
|
||||
] if
|
||||
] keep ;
|
||||
|
||||
M: ebnf-sequence (transform) ( ast -- parser )
|
||||
|
|
@ -279,7 +389,7 @@ M: ebnf-choice (transform) ( ast -- parser )
|
|||
options>> [ (transform) ] map choice ;
|
||||
|
||||
M: ebnf-any-character (transform) ( ast -- parser )
|
||||
drop any-char ;
|
||||
drop tokenizer any>> call ;
|
||||
|
||||
M: ebnf-range (transform) ( ast -- parser )
|
||||
pattern>> range-pattern ;
|
||||
|
|
@ -309,23 +419,29 @@ M: ebnf-whitespace (transform) ( ast -- parser )
|
|||
GENERIC: build-locals ( code ast -- code )
|
||||
|
||||
M: ebnf-sequence build-locals ( code ast -- code )
|
||||
elements>> dup [ ebnf-var? ] filter empty? [
|
||||
drop
|
||||
] [
|
||||
[
|
||||
"USING: locals sequences ; [let* | " %
|
||||
dup length swap [
|
||||
dup ebnf-var? [
|
||||
name>> %
|
||||
" [ " % # " over nth ] " %
|
||||
] [
|
||||
2drop
|
||||
] if
|
||||
] 2each
|
||||
" | " %
|
||||
%
|
||||
" ]" %
|
||||
] "" make
|
||||
#! Note the need to filter out this ebnf items that
|
||||
#! leave nothing in the AST
|
||||
elements>> filter-hidden dup length 1 = [
|
||||
first build-locals
|
||||
] [
|
||||
dup [ ebnf-var? ] filter empty? [
|
||||
drop
|
||||
] [
|
||||
[
|
||||
"USING: locals sequences ; [let* | " %
|
||||
dup length swap [
|
||||
dup ebnf-var? [
|
||||
name>> %
|
||||
" [ " % # " over nth ] " %
|
||||
] [
|
||||
2drop
|
||||
] if
|
||||
] 2each
|
||||
" | " %
|
||||
%
|
||||
" nip ]" %
|
||||
] "" make
|
||||
] if
|
||||
] if ;
|
||||
|
||||
M: ebnf-var build-locals ( code ast -- )
|
||||
|
|
@ -334,29 +450,50 @@ M: ebnf-var build-locals ( code ast -- )
|
|||
name>> % " [ dup ] " %
|
||||
" | " %
|
||||
%
|
||||
" ]" %
|
||||
" nip ]" %
|
||||
] "" make ;
|
||||
|
||||
M: object build-locals ( code ast -- )
|
||||
drop ;
|
||||
|
||||
: check-action-effect ( quot -- quot )
|
||||
dup infer {
|
||||
{ [ dup (( a -- b )) effect<= ] [ drop ] }
|
||||
{ [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] }
|
||||
[
|
||||
[
|
||||
"Bad effect: " write effect>string write
|
||||
" for quotation " write pprint
|
||||
] with-string-writer throw
|
||||
]
|
||||
} cond ;
|
||||
|
||||
M: ebnf-action (transform) ( ast -- parser )
|
||||
[ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
|
||||
string-lines parse-lines action ;
|
||||
[ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals
|
||||
string-lines parse-lines check-action-effect action ;
|
||||
|
||||
M: ebnf-semantic (transform) ( ast -- parser )
|
||||
[ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
|
||||
[ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals
|
||||
string-lines parse-lines semantic ;
|
||||
|
||||
M: ebnf-var (transform) ( ast -- parser )
|
||||
parser>> (transform) ;
|
||||
|
||||
M: ebnf-terminal (transform) ( ast -- parser )
|
||||
symbol>> token ;
|
||||
symbol>> tokenizer one>> call ;
|
||||
|
||||
M: ebnf-foreign (transform) ( ast -- parser )
|
||||
dup word>> search
|
||||
[ "Foreign word '" swap word>> append "' not found" append throw ] unless*
|
||||
swap rule>> [ main ] unless* dupd swap rule [
|
||||
nip
|
||||
] [
|
||||
execute
|
||||
] if* ;
|
||||
|
||||
: parser-not-found ( name -- * )
|
||||
[
|
||||
"Parser " % % " not found." %
|
||||
"Parser '" % % "' not found." %
|
||||
] "" make throw ;
|
||||
|
||||
M: ebnf-non-terminal (transform) ( ast -- parser )
|
||||
|
|
@ -384,20 +521,12 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
|
|||
parse-result-ast transform dup dup parser [ main swap at compile ] with-variable
|
||||
[ compiled-parse ] curry [ with-scope ] curry ;
|
||||
|
||||
: replace-escapes ( string -- string )
|
||||
[
|
||||
"\\t" token [ drop "\t" ] action ,
|
||||
"\\n" token [ drop "\n" ] action ,
|
||||
"\\r" token [ drop "\r" ] action ,
|
||||
] choice* replace ;
|
||||
|
||||
: [EBNF "EBNF]" parse-multiline-string replace-escapes ebnf>quot nip parsed ; parsing
|
||||
: [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip parsed reset-tokenizer ; parsing
|
||||
|
||||
: EBNF:
|
||||
CREATE-WORD dup
|
||||
";EBNF" parse-multiline-string replace-escapes
|
||||
ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop ; parsing
|
||||
reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string
|
||||
ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop
|
||||
reset-tokenizer ; parsing
|
||||
|
||||
|
||||
|
||||
: rule ( name word -- parser )
|
||||
#! Given an EBNF word produced from EBNF: return the EBNF rule
|
||||
"ebnf-parser" word-prop at ;
|
||||
|
|
@ -0,0 +1,42 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel ;
|
||||
IN: peg.javascript.ast
|
||||
|
||||
TUPLE: ast-keyword value ;
|
||||
TUPLE: ast-name value ;
|
||||
TUPLE: ast-number value ;
|
||||
TUPLE: ast-string value ;
|
||||
TUPLE: ast-regexp value ;
|
||||
TUPLE: ast-cond-expr condition then else ;
|
||||
TUPLE: ast-set lhs rhs ;
|
||||
TUPLE: ast-get value ;
|
||||
TUPLE: ast-mset lhs rhs operator ;
|
||||
TUPLE: ast-binop lhs rhs operator ;
|
||||
TUPLE: ast-unop expr operator ;
|
||||
TUPLE: ast-postop expr operator ;
|
||||
TUPLE: ast-preop expr operator ;
|
||||
TUPLE: ast-getp index expr ;
|
||||
TUPLE: ast-send method expr args ;
|
||||
TUPLE: ast-call expr args ;
|
||||
TUPLE: ast-this ;
|
||||
TUPLE: ast-new name args ;
|
||||
TUPLE: ast-array values ;
|
||||
TUPLE: ast-json bindings ;
|
||||
TUPLE: ast-binding name value ;
|
||||
TUPLE: ast-func fs body ;
|
||||
TUPLE: ast-var name value ;
|
||||
TUPLE: ast-begin statements ;
|
||||
TUPLE: ast-if condition true false ;
|
||||
TUPLE: ast-while condition statements ;
|
||||
TUPLE: ast-do-while statements condition ;
|
||||
TUPLE: ast-for i c u statements ;
|
||||
TUPLE: ast-for-in v e statements ;
|
||||
TUPLE: ast-switch expr statements ;
|
||||
TUPLE: ast-break ;
|
||||
TUPLE: ast-continue ;
|
||||
TUPLE: ast-throw e ;
|
||||
TUPLE: ast-try t e c f ;
|
||||
TUPLE: ast-return e ;
|
||||
TUPLE: ast-case c cs ;
|
||||
TUPLE: ast-default cs ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Chris Double
|
||||
|
|
@ -0,0 +1 @@
|
|||
Abstract Syntax Tree for JavaScript parser
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
text
|
||||
javascript
|
||||
parsing
|
||||
|
|
@ -0,0 +1 @@
|
|||
Chris Double
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax ;
|
||||
IN: peg.javascript
|
||||
|
||||
HELP: parse-javascript
|
||||
{ $values
|
||||
{ "string" "a string" }
|
||||
{ "ast" "a JavaScript abstract syntax tree" }
|
||||
}
|
||||
{ $description
|
||||
"Parse the input string using the JavaScript parser. Throws an error if "
|
||||
"the string does not contain valid JavaScript. Returns the abstract syntax tree "
|
||||
"if successful." } ;
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: kernel tools.test peg.javascript peg.javascript.ast accessors ;
|
||||
IN: peg.javascript.tests
|
||||
|
||||
\ parse-javascript must-infer
|
||||
|
||||
{ T{ ast-begin f V{ T{ ast-number f 123 } } } } [
|
||||
"123;" parse-javascript
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors peg.javascript.tokenizer peg.javascript.parser ;
|
||||
IN: peg.javascript
|
||||
|
||||
: parse-javascript ( string -- ast )
|
||||
javascript [
|
||||
ast>>
|
||||
] [
|
||||
"Unable to parse JavaScript" throw
|
||||
] if* ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Chris Double
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: kernel tools.test peg peg.javascript.ast peg.javascript.parser
|
||||
accessors multiline sequences math ;
|
||||
IN: peg.javascript.parser.tests
|
||||
|
||||
\ javascript must-infer
|
||||
|
||||
{
|
||||
T{
|
||||
ast-begin
|
||||
f
|
||||
V{
|
||||
T{ ast-number f 123 }
|
||||
T{ ast-string f "hello" }
|
||||
T{
|
||||
ast-call
|
||||
f
|
||||
T{ ast-get f "foo" }
|
||||
V{ T{ ast-get f "x" } }
|
||||
}
|
||||
}
|
||||
}
|
||||
} [
|
||||
"123; 'hello'; foo(x);" javascript ast>>
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
<"
|
||||
var x=5
|
||||
var y=10
|
||||
"> javascript remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
|
||||
{ t } [
|
||||
<"
|
||||
function foldl(f, initial, seq) {
|
||||
for(var i=0; i< seq.length; ++i)
|
||||
initial = f(initial, seq[i]);
|
||||
return initial;
|
||||
}
|
||||
"> javascript remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
<"
|
||||
ParseState.prototype.from = function(index) {
|
||||
var r = new ParseState(this.input, this.index + index);
|
||||
r.cache = this.cache;
|
||||
r.length = this.length - index;
|
||||
return r;
|
||||
}
|
||||
"> javascript remaining>> length zero?
|
||||
] unit-test
|
||||
|
||||
|
|
@ -0,0 +1,142 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors peg peg.ebnf peg.javascript.ast peg.javascript.tokenizer ;
|
||||
IN: peg.javascript.parser
|
||||
|
||||
#! Grammar for JavaScript. Based on OMeta-JS example from:
|
||||
#! http://jarrett.cs.ucla.edu/ometa-js/#JavaScript_Compiler
|
||||
|
||||
#! The interesting thing about this parser is the mixing of
|
||||
#! a default and non-default tokenizer. The JavaScript tokenizer
|
||||
#! removes all newlines. So when operating on tokens there is no
|
||||
#! need for newline and space skipping in the grammar. But JavaScript
|
||||
#! uses the newline in the 'automatic semicolon insertion' rule.
|
||||
#!
|
||||
#! If a statement ends in a newline, sometimes the semicolon can be
|
||||
#! skipped. So we define an 'nl' rule using the default tokenizer.
|
||||
#! This operates a character at a time. Using this 'nl' in the parser
|
||||
#! allows us to detect newlines when we need to for the semicolon
|
||||
#! insertion rule, but ignore it in all other places.
|
||||
EBNF: javascript
|
||||
tokenizer = default
|
||||
nl = "\r" "\n" | "\n"
|
||||
|
||||
tokenizer = <foreign tokenize-javascript Tok>
|
||||
End = !(.)
|
||||
Space = " " | "\t" | "\n"
|
||||
Spaces = Space* => [[ ignore ]]
|
||||
Name = . ?[ ast-name? ]? => [[ value>> ]]
|
||||
Number = . ?[ ast-number? ]? => [[ value>> ]]
|
||||
String = . ?[ ast-string? ]? => [[ value>> ]]
|
||||
RegExp = . ?[ ast-regexp? ]? => [[ value>> ]]
|
||||
SpacesNoNl = (!(nl) Space)* => [[ ignore ]]
|
||||
|
||||
Expr = OrExpr:e "?" Expr:t ":" Expr:f => [[ e t f ast-cond-expr boa ]]
|
||||
| OrExpr:e "=" Expr:rhs => [[ e rhs ast-set boa ]]
|
||||
| OrExpr:e "+=" Expr:rhs => [[ e rhs "+" ast-mset boa ]]
|
||||
| OrExpr:e "-=" Expr:rhs => [[ e rhs "-" ast-mset boa ]]
|
||||
| OrExpr:e "*=" Expr:rhs => [[ e rhs "*" ast-mset boa ]]
|
||||
| OrExpr:e "/=" Expr:rhs => [[ e rhs "/" ast-mset boa ]]
|
||||
| OrExpr:e "%=" Expr:rhs => [[ e rhs "%" ast-mset boa ]]
|
||||
| OrExpr:e "&&=" Expr:rhs => [[ e rhs "&&" ast-mset boa ]]
|
||||
| OrExpr:e "||=" Expr:rhs => [[ e rhs "||" ast-mset boa ]]
|
||||
| OrExpr:e => [[ e ]]
|
||||
|
||||
OrExpr = OrExpr:x "||" AndExpr:y => [[ x y "||" ast-binop boa ]]
|
||||
| AndExpr
|
||||
AndExpr = AndExpr:x "&&" EqExpr:y => [[ x y "&&" ast-binop boa ]]
|
||||
| EqExpr
|
||||
EqExpr = EqExpr:x "==" RelExpr:y => [[ x y "==" ast-binop boa ]]
|
||||
| EqExpr:x "!=" RelExpr:y => [[ x y "!=" ast-binop boa ]]
|
||||
| EqExpr:x "===" RelExpr:y => [[ x y "===" ast-binop boa ]]
|
||||
| EqExpr:x "!==" RelExpr:y => [[ x y "!==" ast-binop boa ]]
|
||||
| RelExpr
|
||||
RelExpr = RelExpr:x ">" AddExpr:y => [[ x y ">" ast-binop boa ]]
|
||||
| RelExpr:x ">=" AddExpr:y => [[ x y ">=" ast-binop boa ]]
|
||||
| RelExpr:x "<" AddExpr:y => [[ x y "<" ast-binop boa ]]
|
||||
| RelExpr:x "<=" AddExpr:y => [[ x y "<=" ast-binop boa ]]
|
||||
| RelExpr:x "instanceof" AddExpr:y => [[ x y "instanceof" ast-binop boa ]]
|
||||
| AddExpr
|
||||
AddExpr = AddExpr:x "+" MulExpr:y => [[ x y "+" ast-binop boa ]]
|
||||
| AddExpr:x "-" MulExpr:y => [[ x y "-" ast-binop boa ]]
|
||||
| MulExpr
|
||||
MulExpr = MulExpr:x "*" MulExpr:y => [[ x y "*" ast-binop boa ]]
|
||||
| MulExpr:x "/" MulExpr:y => [[ x y "/" ast-binop boa ]]
|
||||
| MulExpr:x "%" MulExpr:y => [[ x y "%" ast-binop boa ]]
|
||||
| Unary
|
||||
Unary = "-" Postfix:p => [[ p "-" ast-unop boa ]]
|
||||
| "+" Postfix:p => [[ p ]]
|
||||
| "++" Postfix:p => [[ p "++" ast-preop boa ]]
|
||||
| "--" Postfix:p => [[ p "--" ast-preop boa ]]
|
||||
| "!" Postfix:p => [[ p "!" ast-unop boa ]]
|
||||
| "typeof" Postfix:p => [[ p "typeof" ast-unop boa ]]
|
||||
| "void" Postfix:p => [[ p "void" ast-unop boa ]]
|
||||
| "delete" Postfix:p => [[ p "delete" ast-unop boa ]]
|
||||
| Postfix
|
||||
Postfix = PrimExpr:p SpacesNoNl "++" => [[ p "++" ast-postop boa ]]
|
||||
| PrimExpr:p SpacesNoNl "--" => [[ p "--" ast-postop boa ]]
|
||||
| PrimExpr
|
||||
Args = (Expr ("," Expr => [[ second ]])* => [[ first2 swap prefix ]])?
|
||||
PrimExpr = PrimExpr:p "[" Expr:i "]" => [[ i p ast-getp boa ]]
|
||||
| PrimExpr:p "." Name:m "(" Args:as ")" => [[ m p as ast-send boa ]]
|
||||
| PrimExpr:p "." Name:f => [[ f p ast-getp boa ]]
|
||||
| PrimExpr:p "(" Args:as ")" => [[ p as ast-call boa ]]
|
||||
| PrimExprHd
|
||||
PrimExprHd = "(" Expr:e ")" => [[ e ]]
|
||||
| "this" => [[ ast-this boa ]]
|
||||
| Name => [[ ast-get boa ]]
|
||||
| Number => [[ ast-number boa ]]
|
||||
| String => [[ ast-string boa ]]
|
||||
| RegExp => [[ ast-regexp boa ]]
|
||||
| "function" FuncRest:fr => [[ fr ]]
|
||||
| "new" Name:n "(" Args:as ")" => [[ n as ast-new boa ]]
|
||||
| "[" Args:es "]" => [[ es ast-array boa ]]
|
||||
| Json
|
||||
JsonBindings = (JsonBinding ("," JsonBinding => [[ second ]])* => [[ first2 swap prefix ]])?
|
||||
Json = "{" JsonBindings:bs "}" => [[ bs ast-json boa ]]
|
||||
JsonBinding = JsonPropName:n ":" Expr:v => [[ n v ast-binding boa ]]
|
||||
JsonPropName = Name | Number | String | RegExp
|
||||
Formal = Spaces Name
|
||||
Formals = (Formal ("," Formal => [[ second ]])* => [[ first2 swap prefix ]])?
|
||||
FuncRest = "(" Formals:fs ")" "{" SrcElems:body "}" => [[ fs body ast-func boa ]]
|
||||
Sc = SpacesNoNl (nl | &("}") | End)| ";"
|
||||
Binding = Name:n "=" Expr:v => [[ n v ast-var boa ]]
|
||||
| Name:n => [[ n "undefined" ast-get boa ast-var boa ]]
|
||||
Block = "{" SrcElems:ss "}" => [[ ss ]]
|
||||
Bindings = (Binding ("," Binding => [[ second ]])* => [[ first2 swap prefix ]])?
|
||||
For1 = "var" Binding => [[ second ]]
|
||||
| Expr
|
||||
| Spaces => [[ "undefined" ast-get boa ]]
|
||||
For2 = Expr
|
||||
| Spaces => [[ "true" ast-get boa ]]
|
||||
For3 = Expr
|
||||
| Spaces => [[ "undefined" ast-get boa ]]
|
||||
ForIn1 = "var" Name:n => [[ n "undefined" ast-get boa ast-var boa ]]
|
||||
| Expr
|
||||
Switch1 = "case" Expr:c ":" SrcElems:cs => [[ c cs ast-case boa ]]
|
||||
| "default" ":" SrcElems:cs => [[ cs ast-default boa ]]
|
||||
SwitchBody = Switch1*
|
||||
Finally = "finally" Block:b => [[ b ]]
|
||||
| Spaces => [[ "undefined" ast-get boa ]]
|
||||
Stmt = Block
|
||||
| "var" Bindings:bs Sc => [[ bs ast-begin boa ]]
|
||||
| "if" "(" Expr:c ")" Stmt:t "else" Stmt:f => [[ c t f ast-if boa ]]
|
||||
| "if" "(" Expr:c ")" Stmt:t => [[ c t "undefined" ast-get boa ast-if boa ]]
|
||||
| "while" "(" Expr:c ")" Stmt:s => [[ c s ast-while boa ]]
|
||||
| "do" Stmt:s "while" "(" Expr:c ")" Sc => [[ s c ast-do-while boa ]]
|
||||
| "for" "(" For1:i ";" For2:c ";" For3:u ")" Stmt:s => [[ i c u s ast-for boa ]]
|
||||
| "for" "(" ForIn1:v "in" Expr:e ")" Stmt:s => [[ v e s ast-for-in boa ]]
|
||||
| "switch" "(" Expr:e ")" "{" SwitchBody:cs "}" => [[ e cs ast-switch boa ]]
|
||||
| "break" Sc => [[ ast-break boa ]]
|
||||
| "continue" Sc => [[ ast-continue boa ]]
|
||||
| "throw" SpacesNoNl Expr:e Sc => [[ e ast-throw boa ]]
|
||||
| "try" Block:t "catch" "(" Name:e ")" Block:c Finally:f => [[ t e c f ast-try boa ]]
|
||||
| "return" Expr:e Sc => [[ e ast-return boa ]]
|
||||
| "return" Sc => [[ "undefined" ast-get boa ast-return boa ]]
|
||||
| Expr:e Sc => [[ e ]]
|
||||
| ";" => [[ "undefined" ast-get boa ]]
|
||||
SrcElem = "function" Name:n FuncRest:f => [[ n f ast-var boa ]]
|
||||
| Stmt
|
||||
SrcElems = SrcElem* => [[ ast-begin boa ]]
|
||||
TopLevel = SrcElems Spaces
|
||||
;EBNF
|
||||
|
|
@ -0,0 +1 @@
|
|||
JavaScript Parser
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
text
|
||||
javascript
|
||||
parsing
|
||||
|
|
@ -0,0 +1 @@
|
|||
JavaScript parser
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
text
|
||||
javascript
|
||||
parsing
|
||||
|
|
@ -0,0 +1 @@
|
|||
Chris Double
|
||||
|
|
@ -0,0 +1 @@
|
|||
Tokenizer for JavaScript language
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
text
|
||||
javascript
|
||||
parsing
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: kernel tools.test peg peg.javascript.ast peg.javascript.tokenizer accessors ;
|
||||
IN: peg.javascript.tokenizer.tests
|
||||
|
||||
\ tokenize-javascript must-infer
|
||||
|
||||
{
|
||||
V{
|
||||
T{ ast-number f 123 }
|
||||
";"
|
||||
T{ ast-string f "hello" }
|
||||
";"
|
||||
T{ ast-name f "foo" }
|
||||
"("
|
||||
T{ ast-name f "x" }
|
||||
")"
|
||||
";"
|
||||
}
|
||||
} [
|
||||
"123; 'hello'; foo(x);" tokenize-javascript ast>>
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences strings arrays math.parser peg peg.ebnf peg.javascript.ast ;
|
||||
IN: peg.javascript.tokenizer
|
||||
|
||||
#! Grammar for JavaScript. Based on OMeta-JS example from:
|
||||
#! http://jarrett.cs.ucla.edu/ometa-js/#JavaScript_Compiler
|
||||
|
||||
USE: prettyprint
|
||||
|
||||
EBNF: tokenize-javascript
|
||||
Letter = [a-zA-Z]
|
||||
Digit = [0-9]
|
||||
Digits = Digit+
|
||||
SingleLineComment = "//" (!("\n") .)* "\n" => [[ ignore ]]
|
||||
MultiLineComment = "/*" (!("*/") .)* "*/" => [[ ignore ]]
|
||||
Space = " " | "\t" | "\r" | "\n" | SingleLineComment | MultiLineComment
|
||||
Spaces = Space* => [[ ignore ]]
|
||||
NameFirst = Letter | "$" => [[ CHAR: $ ]] | "_" => [[ CHAR: _ ]]
|
||||
NameRest = NameFirst | Digit
|
||||
iName = NameFirst NameRest* => [[ first2 swap prefix >string ]]
|
||||
Keyword = ("break"
|
||||
| "case"
|
||||
| "catch"
|
||||
| "continue"
|
||||
| "default"
|
||||
| "delete"
|
||||
| "do"
|
||||
| "else"
|
||||
| "finally"
|
||||
| "for"
|
||||
| "function"
|
||||
| "if"
|
||||
| "in"
|
||||
| "instanceof"
|
||||
| "new"
|
||||
| "return"
|
||||
| "switch"
|
||||
| "this"
|
||||
| "throw"
|
||||
| "try"
|
||||
| "typeof"
|
||||
| "var"
|
||||
| "void"
|
||||
| "while"
|
||||
| "with") !(NameRest)
|
||||
Name = !(Keyword) iName => [[ ast-name boa ]]
|
||||
Number = Digits:ws '.' Digits:fs => [[ ws "." fs 3array concat >string string>number ast-number boa ]]
|
||||
| Digits => [[ >string string>number ast-number boa ]]
|
||||
|
||||
EscapeChar = "\\n" => [[ 10 ]]
|
||||
| "\\r" => [[ 13 ]]
|
||||
| "\\t" => [[ 9 ]]
|
||||
StringChars1 = (EscapeChar | !('"""') .)* => [[ >string ]]
|
||||
StringChars2 = (EscapeChar | !('"') .)* => [[ >string ]]
|
||||
StringChars3 = (EscapeChar | !("'") .)* => [[ >string ]]
|
||||
Str = '"""' StringChars1:cs '"""' => [[ cs ast-string boa ]]
|
||||
| '"' StringChars2:cs '"' => [[ cs ast-string boa ]]
|
||||
| "'" StringChars3:cs "'" => [[ cs ast-string boa ]]
|
||||
RegExpBody = (!("/" | "\n" | "\r") .)* => [[ >string ]]
|
||||
RegExp = "/" RegExpBody:r "/" => [[ r ast-regexp boa ]]
|
||||
Special = "(" | ")" | "{" | "}" | "[" | "]" | "," | ";"
|
||||
| "?" | ":" | "!==" | "!=" | "===" | "==" | "=" | ">="
|
||||
| ">" | "<=" | "<" | "++" | "+=" | "+" | "--" | "-="
|
||||
| "-" | "*=" | "*" | "/=" | "/" | "%=" | "%" | "&&="
|
||||
| "&&" | "||=" | "||" | "." | "!"
|
||||
Tok = Spaces (Name | Keyword | Number | Str | RegExp | Special )
|
||||
Toks = Tok* Spaces
|
||||
;EBNF
|
||||
|
||||
|
|
@ -0,0 +1,357 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: jni-internals
|
||||
USING: kernel alien arrays sequences ;
|
||||
|
||||
LIBRARY: jvm
|
||||
|
||||
TYPEDEF: int jint
|
||||
TYPEDEF: uchar jboolean
|
||||
TYPEDEF: void* JNIEnv
|
||||
|
||||
C-STRUCT: jdk-init-args
|
||||
{ "jint" "version" }
|
||||
{ "void*" "properties" }
|
||||
{ "jint" "check-source" }
|
||||
{ "jint" "native-stack-size" }
|
||||
{ "jint" "java-stack-size" }
|
||||
{ "jint" "min-heap-size" }
|
||||
{ "jint" "max-heap-size" }
|
||||
{ "jint" "verify-mode" }
|
||||
{ "char*" "classpath" }
|
||||
{ "void*" "vprintf" }
|
||||
{ "void*" "exit" }
|
||||
{ "void*" "abort" }
|
||||
{ "jint" "enable-class-gc" }
|
||||
{ "jint" "enable-verbose-gc" }
|
||||
{ "jint" "disable-async-gc" }
|
||||
{ "jint" "verbose" }
|
||||
{ "jboolean" "debugging" }
|
||||
{ "jint" "debug-port" } ;
|
||||
|
||||
C-STRUCT: JNIInvokeInterface
|
||||
{ "void*" "reserved0" }
|
||||
{ "void*" "reserved1" }
|
||||
{ "void*" "reserved2" }
|
||||
{ "void*" "DestroyJavaVM" }
|
||||
{ "void*" "AttachCurrentThread" }
|
||||
{ "void*" "DetachCurrentThread" }
|
||||
{ "void*" "GetEnv" }
|
||||
{ "void*" "AttachCurrentThreadAsDaemon" } ;
|
||||
|
||||
C-STRUCT: JavaVM
|
||||
{ "JNIInvokeInterface*" "functions" } ;
|
||||
|
||||
C-STRUCT: JNINativeInterface
|
||||
{ "void*" "reserved0" }
|
||||
{ "void*" "reserved1" }
|
||||
{ "void*" "reserved2" }
|
||||
{ "void*" "reserved3" }
|
||||
{ "void*" "GetVersion" }
|
||||
{ "void*" "DefineClass" }
|
||||
{ "void*" "FindClass" }
|
||||
{ "void*" "FromReflectedMethod" }
|
||||
{ "void*" "FromReflectedField" }
|
||||
{ "void*" "ToReflectedMethod" }
|
||||
{ "void*" "GetSuperclass" }
|
||||
{ "void*" "IsAssignableFrom" }
|
||||
{ "void*" "ToReflectedField" }
|
||||
{ "void*" "Throw" }
|
||||
{ "void*" "ThrowNew" }
|
||||
{ "void*" "ExceptionOccurred" }
|
||||
{ "void*" "ExceptionDescribe" }
|
||||
{ "void*" "ExceptionClear" }
|
||||
{ "void*" "FatalError" }
|
||||
{ "void*" "PushLocalFrame" }
|
||||
{ "void*" "PopLocalFrame" }
|
||||
{ "void*" "NewGlobalRef" }
|
||||
{ "void*" "DeleteGlobalRef" }
|
||||
{ "void*" "DeleteLocalRef" }
|
||||
{ "void*" "IsSameObject" }
|
||||
{ "void*" "NewLocalRef" }
|
||||
{ "void*" "EnsureLocalCapacity" }
|
||||
{ "void*" "AllocObject" }
|
||||
{ "void*" "NewObject" }
|
||||
{ "void*" "NewObjectV" }
|
||||
{ "void*" "NewObjectA" }
|
||||
{ "void*" "GetObjectClass" }
|
||||
{ "void*" "IsInstanceOf" }
|
||||
{ "void*" "GetMethodID" }
|
||||
{ "void*" "CallObjectMethod" }
|
||||
{ "void*" "CallObjectMethodV" }
|
||||
{ "void*" "CallObjectMethodA" }
|
||||
{ "void*" "CallBooleanMethod" }
|
||||
{ "void*" "CallBooleanMethodV" }
|
||||
{ "void*" "CallBooleanMethodA" }
|
||||
{ "void*" "CallByteMethod" }
|
||||
{ "void*" "CallByteMethodV" }
|
||||
{ "void*" "CallByteMethodA" }
|
||||
{ "void*" "CallCharMethod" }
|
||||
{ "void*" "CallCharMethodV" }
|
||||
{ "void*" "CallCharMethodA" }
|
||||
{ "void*" "CallShortMethod" }
|
||||
{ "void*" "CallShortMethodV" }
|
||||
{ "void*" "CallShortMethodA" }
|
||||
{ "void*" "CallIntMethod" }
|
||||
{ "void*" "CallIntMethodV" }
|
||||
{ "void*" "CallIntMethodA" }
|
||||
{ "void*" "CallLongMethod" }
|
||||
{ "void*" "CallLongMethodV" }
|
||||
{ "void*" "CallLongMethodA" }
|
||||
{ "void*" "CallFloatMethod" }
|
||||
{ "void*" "CallFloatMethodV" }
|
||||
{ "void*" "CallFloatMethodA" }
|
||||
{ "void*" "CallDoubleMethod" }
|
||||
{ "void*" "CallDoubleMethodV" }
|
||||
{ "void*" "CallDoubleMethodA" }
|
||||
{ "void*" "CallVoidMethod" }
|
||||
{ "void*" "CallVoidMethodV" }
|
||||
{ "void*" "CallVoidMethodA" }
|
||||
{ "void*" "CallNonvirtualObjectMethod" }
|
||||
{ "void*" "CallNonvirtualObjectMethodV" }
|
||||
{ "void*" "CallNonvirtualObjectMethodA" }
|
||||
{ "void*" "CallNonvirtualBooleanMethod" }
|
||||
{ "void*" "CallNonvirtualBooleanMethodV" }
|
||||
{ "void*" "CallNonvirtualBooleanMethodA" }
|
||||
{ "void*" "CallNonvirtualByteMethod" }
|
||||
{ "void*" "CallNonvirtualByteMethodV" }
|
||||
{ "void*" "CallNonvirtualByteMethodA" }
|
||||
{ "void*" "CallNonvirtualCharMethod" }
|
||||
{ "void*" "CallNonvirtualCharMethodV" }
|
||||
{ "void*" "CallNonvirtualCharMethodA" }
|
||||
{ "void*" "CallNonvirtualShortMethod" }
|
||||
{ "void*" "CallNonvirtualShortMethodV" }
|
||||
{ "void*" "CallNonvirtualShortMethodA" }
|
||||
{ "void*" "CallNonvirtualIntMethod" }
|
||||
{ "void*" "CallNonvirtualIntMethodV" }
|
||||
{ "void*" "CallNonvirtualIntMethodA" }
|
||||
{ "void*" "CallNonvirtualLongMethod" }
|
||||
{ "void*" "CallNonvirtualLongMethodV" }
|
||||
{ "void*" "CallNonvirtualLongMethodA" }
|
||||
{ "void*" "CallNonvirtualFloatMethod" }
|
||||
{ "void*" "CallNonvirtualFloatMethodV" }
|
||||
{ "void*" "CallNonvirtualFloatMethodA" }
|
||||
{ "void*" "CallNonvirtualDoubleMethod" }
|
||||
{ "void*" "CallNonvirtualDoubleMethodV" }
|
||||
{ "void*" "CallNonvirtualDoubleMethodA" }
|
||||
{ "void*" "CallNonvirtualVoidMethod" }
|
||||
{ "void*" "CallNonvirtualVoidMethodV" }
|
||||
{ "void*" "CallNonvirtualVoidMethodA" }
|
||||
{ "void*" "GetFieldID" }
|
||||
{ "void*" "GetObjectField" }
|
||||
{ "void*" "GetBooleanField" }
|
||||
{ "void*" "GetByteField" }
|
||||
{ "void*" "GetCharField" }
|
||||
{ "void*" "GetShortField" }
|
||||
{ "void*" "GetIntField" }
|
||||
{ "void*" "GetLongField" }
|
||||
{ "void*" "GetFloatField" }
|
||||
{ "void*" "GetDoubleField" }
|
||||
{ "void*" "SetObjectField" }
|
||||
{ "void*" "SetBooleanField" }
|
||||
{ "void*" "SetByteField" }
|
||||
{ "void*" "SetCharField" }
|
||||
{ "void*" "SetShortField" }
|
||||
{ "void*" "SetIntField" }
|
||||
{ "void*" "SetLongField" }
|
||||
{ "void*" "SetFloatField" }
|
||||
{ "void*" "SetDoubleField" }
|
||||
{ "void*" "GetStaticMethodID" }
|
||||
{ "void*" "CallStaticObjectMethod" }
|
||||
{ "void*" "CallStaticObjectMethodV" }
|
||||
{ "void*" "CallStaticObjectMethodA" }
|
||||
{ "void*" "CallStaticBooleanMethod" }
|
||||
{ "void*" "CallStaticBooleanMethodV" }
|
||||
{ "void*" "CallStaticBooleanMethodA" }
|
||||
{ "void*" "CallStaticByteMethod" }
|
||||
{ "void*" "CallStaticByteMethodV" }
|
||||
{ "void*" "CallStaticByteMethodA" }
|
||||
{ "void*" "CallStaticCharMethod" }
|
||||
{ "void*" "CallStaticCharMethodV" }
|
||||
{ "void*" "CallStaticCharMethodA" }
|
||||
{ "void*" "CallStaticShortMethod" }
|
||||
{ "void*" "CallStaticShortMethodV" }
|
||||
{ "void*" "CallStaticShortMethodA" }
|
||||
{ "void*" "CallStaticIntMethod" }
|
||||
{ "void*" "CallStaticIntMethodV" }
|
||||
{ "void*" "CallStaticIntMethodA" }
|
||||
{ "void*" "CallStaticLongMethod" }
|
||||
{ "void*" "CallStaticLongMethodV" }
|
||||
{ "void*" "CallStaticLongMethodA" }
|
||||
{ "void*" "CallStaticFloatMethod" }
|
||||
{ "void*" "CallStaticFloatMethodV" }
|
||||
{ "void*" "CallStaticFloatMethodA" }
|
||||
{ "void*" "CallStaticDoubleMethod" }
|
||||
{ "void*" "CallStaticDoubleMethodV" }
|
||||
{ "void*" "CallStaticDoubleMethodA" }
|
||||
{ "void*" "CallStaticVoidMethod" }
|
||||
{ "void*" "CallStaticVoidMethodV" }
|
||||
{ "void*" "CallStaticVoidMethodA" }
|
||||
{ "void*" "GetStaticFieldID" }
|
||||
{ "void*" "GetStaticObjectField" }
|
||||
{ "void*" "GetStaticBooleanField" }
|
||||
{ "void*" "GetStaticByteField" }
|
||||
{ "void*" "GetStaticCharField" }
|
||||
{ "void*" "GetStaticShortField" }
|
||||
{ "void*" "GetStaticIntField" }
|
||||
{ "void*" "GetStaticLongField" }
|
||||
{ "void*" "GetStaticFloatField" }
|
||||
{ "void*" "GetStaticDoubleField" }
|
||||
{ "void*" "SetStaticObjectField" }
|
||||
{ "void*" "SetStaticBooleanField" }
|
||||
{ "void*" "SetStaticByteField" }
|
||||
{ "void*" "SetStaticCharField" }
|
||||
{ "void*" "SetStaticShortField" }
|
||||
{ "void*" "SetStaticIntField" }
|
||||
{ "void*" "SetStaticLongField" }
|
||||
{ "void*" "SetStaticFloatField" }
|
||||
{ "void*" "SetStaticDoubleField" }
|
||||
{ "void*" "NewString" }
|
||||
{ "void*" "GetStringLength" }
|
||||
{ "void*" "GetStringChars" }
|
||||
{ "void*" "ReleaseStringChars" }
|
||||
{ "void*" "NewStringUTF" }
|
||||
{ "void*" "GetStringUTFLength" }
|
||||
{ "void*" "GetStringUTFChars" }
|
||||
{ "void*" "ReleaseStringUTFChars" }
|
||||
{ "void*" "GetArrayLength" }
|
||||
{ "void*" "NewObjectArray" }
|
||||
{ "void*" "GetObjectArrayElement" }
|
||||
{ "void*" "SetObjectArrayElement" }
|
||||
{ "void*" "NewBooleanArray" }
|
||||
{ "void*" "NewByteArray" }
|
||||
{ "void*" "NewCharArray" }
|
||||
{ "void*" "NewShortArray" }
|
||||
{ "void*" "NewIntArray" }
|
||||
{ "void*" "NewLongArray" }
|
||||
{ "void*" "NewFloatArray" }
|
||||
{ "void*" "NewDoubleArray" }
|
||||
{ "void*" "GetBooleanArrayElements" }
|
||||
{ "void*" "GetByteArrayElements" }
|
||||
{ "void*" "GetCharArrayElements" }
|
||||
{ "void*" "GetShortArrayElements" }
|
||||
{ "void*" "GetIntArrayElements" }
|
||||
{ "void*" "GetLongArrayElements" }
|
||||
{ "void*" "GetFloatArrayElements" }
|
||||
{ "void*" "GetDoubleArrayElements" }
|
||||
{ "void*" "ReleaseBooleanArrayElements" }
|
||||
{ "void*" "ReleaseByteArrayElements" }
|
||||
{ "void*" "ReleaseCharArrayElements" }
|
||||
{ "void*" "ReleaseShortArrayElements" }
|
||||
{ "void*" "ReleaseIntArrayElements" }
|
||||
{ "void*" "ReleaseLongArrayElements" }
|
||||
{ "void*" "ReleaseFloatArrayElements" }
|
||||
{ "void*" "ReleaseDoubleArrayElements" }
|
||||
{ "void*" "GetBooleanArrayRegion" }
|
||||
{ "void*" "GetByteArrayRegion" }
|
||||
{ "void*" "GetCharArrayRegion" }
|
||||
{ "void*" "GetShortArrayRegion" }
|
||||
{ "void*" "GetIntArrayRegion" }
|
||||
{ "void*" "GetLongArrayRegion" }
|
||||
{ "void*" "GetFloatArrayRegion" }
|
||||
{ "void*" "GetDoubleArrayRegion" }
|
||||
{ "void*" "SetBooleanArrayRegion" }
|
||||
{ "void*" "SetByteArrayRegion" }
|
||||
{ "void*" "SetCharArrayRegion" }
|
||||
{ "void*" "SetShortArrayRegion" }
|
||||
{ "void*" "SetIntArrayRegion" }
|
||||
{ "void*" "SetLongArrayRegion" }
|
||||
{ "void*" "SetFloatArrayRegion" }
|
||||
{ "void*" "SetDoubleArrayRegion" }
|
||||
{ "void*" "RegisterNatives" }
|
||||
{ "void*" "UnregisterNatives" }
|
||||
{ "void*" "MonitorEnter" }
|
||||
{ "void*" "MonitorExit" }
|
||||
{ "void*" "GetJavaVM" }
|
||||
{ "void*" "GetStringRegion" }
|
||||
{ "void*" "GetStringUTFRegion" }
|
||||
{ "void*" "GetPrimitiveArrayCritical" }
|
||||
{ "void*" "ReleasePrimitiveArrayCritical" }
|
||||
{ "void*" "GetStringCritical" }
|
||||
{ "void*" "ReleaseStringCritical" }
|
||||
{ "void*" "NewWeakGlobalRef" }
|
||||
{ "void*" "DeleteWeakGlobalRef" }
|
||||
{ "void*" "ExceptionCheck" }
|
||||
{ "void*" "NewDirectByteBuffer" }
|
||||
{ "void*" "GetDirectBufferAddress" }
|
||||
{ "void*" "GetDirectBufferCapacity" } ;
|
||||
|
||||
C-STRUCT: JNIEnv
|
||||
{ "JNINativeInterface*" "functions" } ;
|
||||
|
||||
FUNCTION: jint JNI_GetDefaultJavaVMInitArgs ( jdk-init-args* args ) ;
|
||||
FUNCTION: jint JNI_CreateJavaVM ( void** pvm, void** penv, void* args ) ;
|
||||
|
||||
: <jdk-init-args> ( -- jdk-init-args )
|
||||
"jdk-init-args" <c-object> HEX: 00010004 over set-jdk-init-args-version ;
|
||||
|
||||
: jni1 ( -- init-args int )
|
||||
<jdk-init-args> dup JNI_GetDefaultJavaVMInitArgs ;
|
||||
|
||||
: jni2 ( -- vm env int )
|
||||
f <void*> f <void*> [
|
||||
jni1 drop JNI_CreateJavaVM
|
||||
] 2keep rot dup 0 = [
|
||||
>r >r 0 swap void*-nth r> 0 swap void*-nth r>
|
||||
] when ;
|
||||
|
||||
: (destroy-java-vm)
|
||||
"int" { "void*" } "cdecl" alien-indirect ;
|
||||
|
||||
: (attach-current-thread)
|
||||
"int" { "void*" "void*" "void*" } "cdecl" alien-indirect ;
|
||||
|
||||
: (detach-current-thread)
|
||||
"int" { "void*" } "cdecl" alien-indirect ;
|
||||
|
||||
: (get-env)
|
||||
"int" { "void*" "void*" "int" } "cdecl" alien-indirect ;
|
||||
|
||||
: (attach-current-thread-as-daemon)
|
||||
"int" { "void*" "void*" "void*" } "cdecl" alien-indirect ;
|
||||
|
||||
: destroy-java-vm ( javavm -- int )
|
||||
dup JavaVM-functions JNIInvokeInterface-DestroyJavaVM (destroy-java-vm) ;
|
||||
|
||||
: (get-version)
|
||||
"jint" { "JNIEnv*" } "cdecl" alien-indirect ;
|
||||
|
||||
: get-version ( jnienv -- int )
|
||||
dup JNIEnv-functions JNINativeInterface-GetVersion (get-version) ;
|
||||
|
||||
: (find-class)
|
||||
"void*" { "JNINativeInterface*" "char*" } "cdecl" alien-indirect ;
|
||||
|
||||
: find-class ( name jnienv -- int )
|
||||
dup swapd JNIEnv-functions JNINativeInterface-FindClass (find-class) ;
|
||||
|
||||
: (get-static-field-id)
|
||||
"void*" { "JNINativeInterface*" "void*" "char*" "char*" } "cdecl" alien-indirect ;
|
||||
|
||||
: get-static-field-id ( class name sig jnienv -- int )
|
||||
dup >r >r 3array r> swap first3 r> JNIEnv-functions JNINativeInterface-GetStaticFieldID (get-static-field-id) ;
|
||||
|
||||
: (get-static-object-field)
|
||||
"void*" { "JNINativeInterface*" "void*" "void*" } "cdecl" alien-indirect ;
|
||||
|
||||
: get-static-object-field ( class id jnienv -- int )
|
||||
dup >r >r 2array r> swap first2 r> JNIEnv-functions JNINativeInterface-GetStaticObjectField (get-static-object-field) ;
|
||||
|
||||
: (get-method-id)
|
||||
"void*" { "JNINativeInterface*" "void*" "char*" "char*" } "cdecl" alien-indirect ;
|
||||
|
||||
: get-method-id ( class name sig jnienv -- int )
|
||||
dup >r >r 3array r> swap first3 r> JNIEnv-functions JNINativeInterface-GetMethodID (get-method-id) ;
|
||||
|
||||
: (new-string)
|
||||
"void*" { "JNINativeInterface*" "char*" "int" } "cdecl" alien-indirect ;
|
||||
|
||||
: new-string ( str jnienv -- str )
|
||||
dup >r >r dup length 2array r> swap first2 r> JNIEnv-functions JNINativeInterface-NewString (new-string) ;
|
||||
|
||||
: (call1)
|
||||
"void" { "JNINativeInterface*" "void*" "void*" "int" } "cdecl" alien-indirect ;
|
||||
|
||||
: call1 ( obj method-id jstr jnienv -- )
|
||||
dup >r >r 3array r> swap first3 r> JNIEnv-functions JNINativeInterface-CallObjectMethod (call1) ;
|
||||
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: jni
|
||||
USING: kernel jni-internals namespaces ;
|
||||
|
||||
! High level interface for JNI to be added here...
|
||||
|
||||
: test0 ( -- )
|
||||
jni2 drop nip "env" set ;
|
||||
|
||||
: test1 ( -- system )
|
||||
"java/lang/System" "env" get find-class ;
|
||||
|
||||
: test2 ( system -- system.out )
|
||||
dup "out" "Ljava/io/PrintStream;" "env" get get-static-field-id
|
||||
"env" get get-static-object-field ;
|
||||
|
||||
: test3 ( int system.out -- )
|
||||
"java/io/PrintStream" "env" get find-class ! jstr out class
|
||||
"println" "(I)V" "env" get get-method-id ! jstr out id
|
||||
rot "env" get call1 ;
|
||||
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
PROVIDE: libs/jni
|
||||
{ +files+ { "jni-internals.factor" "jni.factor" } } ;
|
||||
Loading…
Reference in New Issue