Merge branch 'master' of git://double.co.nz/git/factor

db4
Doug Coleman 2008-06-20 17:38:03 -05:00
commit fd1d1387a4
25 changed files with 1120 additions and 67 deletions

View File

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

View File

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

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

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