Fix conflict

db4
Slava Pestov 2008-06-25 04:07:37 -05:00
commit 590ccc49e1
25 changed files with 1118 additions and 65 deletions

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: kernel tools.test peg peg.ebnf words math math.parser 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 IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [ { T{ ebnf-non-terminal f "abc" } } [
@ -164,23 +165,23 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ 6 } [ { 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 ] unit-test
{ 6 } [ { 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 ] unit-test
{ 10 } [ { 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 ] unit-test
{ f } [ { 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 ] unit-test
{ 3 } [ { 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 ] unit-test
{ f } [ { f } [
@ -251,7 +252,7 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ t } [ { 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 ] unit-test
EBNF: primary EBNF: primary
@ -365,3 +366,153 @@ main = Primary
"ab c ab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call ast>> "ab c ab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call ast>>
] unit-test ] 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

View File

@ -1,14 +1,45 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! 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 quotations vectors namespaces math assocs continuations peg
peg.parsers unicode.categories multiline combinators.lib peg.parsers unicode.categories multiline combinators.lib
splitting accessors effects sequences.deep peg.search splitting accessors effects sequences.deep peg.search
combinators.short-circuit ; combinators.short-circuit ;
IN: peg.ebnf 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-non-terminal symbol ;
TUPLE: ebnf-terminal symbol ; TUPLE: ebnf-terminal symbol ;
TUPLE: ebnf-foreign word rule ;
TUPLE: ebnf-any-character ; TUPLE: ebnf-any-character ;
TUPLE: ebnf-range pattern ; TUPLE: ebnf-range pattern ;
TUPLE: ebnf-ensure group ; TUPLE: ebnf-ensure group ;
@ -19,6 +50,7 @@ TUPLE: ebnf-repeat0 group ;
TUPLE: ebnf-repeat1 group ; TUPLE: ebnf-repeat1 group ;
TUPLE: ebnf-optional group ; TUPLE: ebnf-optional group ;
TUPLE: ebnf-whitespace group ; TUPLE: ebnf-whitespace group ;
TUPLE: ebnf-tokenizer elements ;
TUPLE: ebnf-rule symbol elements ; TUPLE: ebnf-rule symbol elements ;
TUPLE: ebnf-action parser code ; TUPLE: ebnf-action parser code ;
TUPLE: ebnf-var parser name ; TUPLE: ebnf-var parser name ;
@ -27,6 +59,7 @@ TUPLE: ebnf rules ;
C: <ebnf-non-terminal> ebnf-non-terminal C: <ebnf-non-terminal> ebnf-non-terminal
C: <ebnf-terminal> ebnf-terminal C: <ebnf-terminal> ebnf-terminal
C: <ebnf-foreign> ebnf-foreign
C: <ebnf-any-character> ebnf-any-character C: <ebnf-any-character> ebnf-any-character
C: <ebnf-range> ebnf-range C: <ebnf-range> ebnf-range
C: <ebnf-ensure> ebnf-ensure C: <ebnf-ensure> ebnf-ensure
@ -37,12 +70,17 @@ C: <ebnf-repeat0> ebnf-repeat0
C: <ebnf-repeat1> ebnf-repeat1 C: <ebnf-repeat1> ebnf-repeat1
C: <ebnf-optional> ebnf-optional C: <ebnf-optional> ebnf-optional
C: <ebnf-whitespace> ebnf-whitespace C: <ebnf-whitespace> ebnf-whitespace
C: <ebnf-tokenizer> ebnf-tokenizer
C: <ebnf-rule> ebnf-rule C: <ebnf-rule> ebnf-rule
C: <ebnf-action> ebnf-action C: <ebnf-action> ebnf-action
C: <ebnf-var> ebnf-var C: <ebnf-var> ebnf-var
C: <ebnf-semantic> ebnf-semantic C: <ebnf-semantic> ebnf-semantic
C: <ebnf> ebnf 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 ) : syntax ( string -- parser )
#! Parses the string, ignoring white space, and #! Parses the string, ignoring white space, and
#! does not put the result in the AST. #! does not put the result in the AST.
@ -53,6 +91,25 @@ C: <ebnf> ebnf
#! begin and end. #! begin and end.
[ syntax ] 2dip syntax pack ; [ 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 ) : 'identifier' ( -- parser )
#! Return a parser that parses an identifer delimited by #! Return a parser that parses an identifer delimited by
#! a quotation character. The quotation can be single #! a quotation character. The quotation can be single
@ -61,7 +118,7 @@ C: <ebnf> ebnf
[ [
[ CHAR: " = not ] satisfy repeat1 "\"" "\"" surrounded-by , [ CHAR: " = not ] satisfy repeat1 "\"" "\"" surrounded-by ,
[ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by , [ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,
] choice* [ >string ] action ; ] choice* [ >string replace-escapes ] action ;
: 'non-terminal' ( -- parser ) : 'non-terminal' ( -- parser )
#! A non-terminal is the name of another rule. It can #! A non-terminal is the name of another rule. It can
@ -88,6 +145,8 @@ C: <ebnf> ebnf
[ dup CHAR: ? = ] [ dup CHAR: ? = ]
[ dup CHAR: : = ] [ dup CHAR: : = ]
[ dup CHAR: ~ = ] [ dup CHAR: ~ = ]
[ dup CHAR: < = ]
[ dup CHAR: > = ]
} 0|| not nip } 0|| not nip
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ; ] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;
@ -96,6 +155,24 @@ C: <ebnf> ebnf
#! and it represents the literal value of the identifier. #! and it represents the literal value of the identifier.
'identifier' [ <ebnf-terminal> ] action ; '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 ) : 'any-character' ( -- parser )
#! A parser to match the symbol for any character match. #! A parser to match the symbol for any character match.
[ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ; [ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ;
@ -114,11 +191,18 @@ C: <ebnf> ebnf
#! The latter indicates that it is the beginning of a #! The latter indicates that it is the beginning of a
#! new rule. #! new rule.
[ [
[ [
'non-terminal' , [
'terminal' , 'non-terminal' ,
'range-parser' , 'terminal' ,
'any-character' , '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* , ] choice* ,
[ [
"=" syntax ensure-not , "=" syntax ensure-not ,
@ -126,6 +210,8 @@ C: <ebnf> ebnf
] choice* , ] choice* ,
] seq* [ first ] action ; ] seq* [ first ] action ;
DEFER: 'action'
: 'element' ( -- parser ) : 'element' ( -- parser )
[ [
[ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action , [ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
@ -193,14 +279,18 @@ DEFER: 'choice'
: ('sequence') ( -- parser ) : ('sequence') ( -- parser )
#! A sequence of terminals and non-terminals, including #! A sequence of terminals and non-terminals, including
#! groupings of those. #! groupings of those.
[ [
'ensure-not' sp , [
'ensure' sp , 'ensure-not' sp ,
'element' sp , 'ensure' sp ,
'group' sp , 'element' sp ,
'repeat0' sp , 'group' sp ,
'repeat1' sp , 'repeat0' sp ,
'optional' sp , 'repeat1' sp ,
'optional' sp ,
] choice*
[ dup , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
,
] choice* ; ] choice* ;
: 'action' ( -- parser ) : 'action' ( -- parser )
@ -223,18 +313,25 @@ DEFER: 'choice'
: 'actioned-sequence' ( -- parser ) : 'actioned-sequence' ( -- parser )
[ [
[ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 <ebnf-action> ] action , [ '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' , 'sequence' ,
] choice* ; ] choice* ;
: 'choice' ( -- parser ) : '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 dup length 1 = [ first ] [ <ebnf-choice> ] if
] action ; ] action ;
: 'tokenizer' ( -- parser )
[
"tokenizer" syntax ,
"=" syntax ,
">" token ensure-not ,
[ "default" token sp , 'choice' , ] choice* ,
] seq* [ first <ebnf-tokenizer> ] action ;
: 'rule' ( -- parser ) : 'rule' ( -- parser )
[ [
"tokenizer" token ensure-not ,
'non-terminal' [ symbol>> ] action , 'non-terminal' [ symbol>> ] action ,
"=" syntax , "=" syntax ,
">" token ensure-not , ">" token ensure-not ,
@ -242,7 +339,7 @@ DEFER: 'choice'
] seq* [ first2 <ebnf-rule> ] action ; ] seq* [ first2 <ebnf-rule> ] action ;
: 'ebnf' ( -- parser ) : 'ebnf' ( -- parser )
'rule' sp repeat1 [ <ebnf> ] action ; [ 'tokenizer' sp , 'rule' sp , ] choice* repeat1 [ <ebnf> ] action ;
GENERIC: (transform) ( ast -- parser ) GENERIC: (transform) ( ast -- parser )
@ -260,11 +357,23 @@ SYMBOL: ignore-ws
M: ebnf (transform) ( ast -- parser ) M: ebnf (transform) ( ast -- parser )
rules>> [ (transform) ] map peek ; 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 ) M: ebnf-rule (transform) ( ast -- parser )
dup elements>> dup elements>>
(transform) [ (transform) [
swap symbol>> set swap symbol>> dup get { [ tuple? ] [ delegate parser? ] } 1&& [
"Rule '" over append "' defined more than once" append throw
] [
set
] if
] keep ; ] keep ;
M: ebnf-sequence (transform) ( ast -- parser ) M: ebnf-sequence (transform) ( ast -- parser )
@ -280,7 +389,7 @@ M: ebnf-choice (transform) ( ast -- parser )
options>> [ (transform) ] map choice ; options>> [ (transform) ] map choice ;
M: ebnf-any-character (transform) ( ast -- parser ) M: ebnf-any-character (transform) ( ast -- parser )
drop any-char ; drop tokenizer any>> call ;
M: ebnf-range (transform) ( ast -- parser ) M: ebnf-range (transform) ( ast -- parser )
pattern>> range-pattern ; pattern>> range-pattern ;
@ -310,23 +419,29 @@ M: ebnf-whitespace (transform) ( ast -- parser )
GENERIC: build-locals ( code ast -- code ) GENERIC: build-locals ( code ast -- code )
M: ebnf-sequence build-locals ( code ast -- code ) M: ebnf-sequence build-locals ( code ast -- code )
elements>> dup [ ebnf-var? ] filter empty? [ #! Note the need to filter out this ebnf items that
drop #! leave nothing in the AST
] [ elements>> filter-hidden dup length 1 = [
[ first build-locals
"USING: locals sequences ; [let* | " % ] [
dup length swap [ dup [ ebnf-var? ] filter empty? [
dup ebnf-var? [ drop
name>> % ] [
" [ " % # " over nth ] " % [
] [ "USING: locals sequences ; [let* | " %
2drop dup length swap [
] if dup ebnf-var? [
] 2each name>> %
" | " % " [ " % # " over nth ] " %
% ] [
" ]" % 2drop
] "" make ] if
] 2each
" | " %
%
" nip ]" %
] "" make
] if
] if ; ] if ;
M: ebnf-var build-locals ( code ast -- ) M: ebnf-var build-locals ( code ast -- )
@ -335,29 +450,50 @@ M: ebnf-var build-locals ( code ast -- )
name>> % " [ dup ] " % name>> % " [ dup ] " %
" | " % " | " %
% %
" ]" % " nip ]" %
] "" make ; ] "" make ;
M: object build-locals ( code ast -- ) M: object build-locals ( code ast -- )
drop ; 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 ) M: ebnf-action (transform) ( ast -- parser )
[ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals
string-lines parse-lines action ; string-lines parse-lines check-action-effect action ;
M: ebnf-semantic (transform) ( ast -- parser ) 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 ; string-lines parse-lines semantic ;
M: ebnf-var (transform) ( ast -- parser ) M: ebnf-var (transform) ( ast -- parser )
parser>> (transform) ; parser>> (transform) ;
M: ebnf-terminal (transform) ( ast -- parser ) 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 ( name -- * )
[ [
"Parser " % % " not found." % "Parser '" % % "' not found." %
] "" make throw ; ] "" make throw ;
M: ebnf-non-terminal (transform) ( ast -- parser ) M: ebnf-non-terminal (transform) ( ast -- parser )
@ -385,20 +521,12 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
parse-result-ast transform dup dup parser [ main swap at compile ] with-variable parse-result-ast transform dup dup parser [ main swap at compile ] with-variable
[ compiled-parse ] curry [ with-scope ] curry ; [ compiled-parse ] curry [ with-scope ] curry ;
: replace-escapes ( string -- string ) : [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip parsed reset-tokenizer ; parsing
[
"\\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:
CREATE-WORD dup reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string
";EBNF" parse-multiline-string replace-escapes ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop
ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop ; parsing reset-tokenizer ; parsing
: rule ( name word -- parser )
#! Given an EBNF word produced from EBNF: return the EBNF rule
"ebnf-parser" word-prop at ;

View File

@ -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 ;

View File

@ -0,0 +1 @@
Chris Double

View File

@ -0,0 +1 @@
Abstract Syntax Tree for JavaScript parser

View File

@ -0,0 +1,3 @@
text
javascript
parsing

View File

@ -0,0 +1 @@
Chris Double

View File

@ -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." } ;

View File

@ -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

View File

@ -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* ;

View File

@ -0,0 +1 @@
Chris Double

View File

@ -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

View File

@ -0,0 +1,143 @@
! 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 "*" Unary:y => [[ x y "*" ast-binop boa ]]
| MulExpr:x "/" Unary:y => [[ x y "/" ast-binop boa ]]
| MulExpr:x "%" Unary: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" PrimExpr:n "(" Args:as ")" => [[ n as ast-new boa ]]
| "new" PrimExpr:n => [[ n f 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

View File

@ -0,0 +1 @@
JavaScript Parser

View File

@ -0,0 +1,3 @@
text
javascript
parsing

View File

@ -0,0 +1 @@
JavaScript parser

View File

@ -0,0 +1,3 @@
text
javascript
parsing

View File

@ -0,0 +1 @@
Chris Double

View File

@ -0,0 +1 @@
Tokenizer for JavaScript language

View File

@ -0,0 +1,3 @@
text
javascript
parsing

View File

@ -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

View File

@ -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

View File

@ -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) ;

View File

@ -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 ;

View File

@ -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" } } ;