diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index faaa63f4bd..2269af6625 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -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= 'b' +;EBNF + +EBNF: parser3 +foo= 'c' +;EBNF + +EBNF: parser4 +foo= '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 = 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 \ No newline at end of file diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index e3d44585a7..0bf07f2687 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -1,14 +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 combinators.short-circuit ; 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 ; @@ -19,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 ; @@ -27,6 +59,7 @@ TUPLE: ebnf rules ; C: ebnf-non-terminal C: ebnf-terminal +C: ebnf-foreign C: ebnf-any-character C: ebnf-range C: ebnf-ensure @@ -37,12 +70,17 @@ C: ebnf-repeat0 C: ebnf-repeat1 C: ebnf-optional C: ebnf-whitespace +C: ebnf-tokenizer C: ebnf-rule C: ebnf-action C: ebnf-var C: ebnf-semantic C: 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. @@ -53,6 +91,25 @@ C: 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 @@ -61,7 +118,7 @@ C: 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 @@ -88,6 +145,8 @@ C: ebnf [ dup CHAR: ? = ] [ dup CHAR: : = ] [ dup CHAR: ~ = ] + [ dup CHAR: < = ] + [ dup CHAR: > = ] } 0|| not nip ] satisfy repeat1 [ >string ] action ; @@ -96,6 +155,24 @@ C: ebnf #! and it represents the literal value of the identifier. 'identifier' [ ] 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 + [ + "" syntax , + ] seq* [ first2 ] action ; + : 'any-character' ( -- parser ) #! A parser to match the symbol for any character match. [ CHAR: . = ] satisfy [ drop ] action ; @@ -114,11 +191,18 @@ C: 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 ] action , + [ dup , "+" token hide , ] seq* [ first ] action , + [ dup , "?[" token ensure-not , "?" token hide , ] seq* [ first ] action , + , ] choice* , [ "=" syntax ensure-not , @@ -126,6 +210,8 @@ C: ebnf ] choice* , ] seq* [ first ] action ; +DEFER: 'action' + : 'element' ( -- parser ) [ [ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 ] action , @@ -193,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 ] action , + , ] choice* ; : 'action' ( -- parser ) @@ -223,18 +313,25 @@ DEFER: 'choice' : 'actioned-sequence' ( -- parser ) [ [ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 ] action , - [ 'sequence' , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , "=>" syntax , 'action' , ] seq* [ first3 >r r> ] action , - [ 'sequence' , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 ] action , 'sequence' , ] choice* ; : 'choice' ( -- parser ) - 'actioned-sequence' sp "|" token sp list-of [ + 'actioned-sequence' sp repeat1 [ dup length 1 = [ first ] [ ] if ] action "|" token sp list-of [ dup length 1 = [ first ] [ ] if ] action ; +: 'tokenizer' ( -- parser ) + [ + "tokenizer" syntax , + "=" syntax , + ">" token ensure-not , + [ "default" token sp , 'choice' , ] choice* , + ] seq* [ first ] action ; + : 'rule' ( -- parser ) [ + "tokenizer" token ensure-not , 'non-terminal' [ symbol>> ] action , "=" syntax , ">" token ensure-not , @@ -242,7 +339,7 @@ DEFER: 'choice' ] seq* [ first2 ] action ; : 'ebnf' ( -- parser ) - 'rule' sp repeat1 [ ] action ; + [ 'tokenizer' sp , 'rule' sp , ] choice* repeat1 [ ] action ; GENERIC: (transform) ( ast -- parser ) @@ -260,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 ) @@ -280,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 ; @@ -310,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 -- ) @@ -335,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 ) @@ -385,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 define-declared "ebnf-parser" set-word-prop ; parsing + reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string + ebnf>quot swapd 1 1 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 ; \ No newline at end of file diff --git a/extra/peg/javascript/ast/ast.factor b/extra/peg/javascript/ast/ast.factor new file mode 100644 index 0000000000..b857dc51bb --- /dev/null +++ b/extra/peg/javascript/ast/ast.factor @@ -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 ; diff --git a/extra/peg/javascript/ast/authors.txt b/extra/peg/javascript/ast/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/peg/javascript/ast/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/peg/javascript/ast/summary.txt b/extra/peg/javascript/ast/summary.txt new file mode 100644 index 0000000000..543a2e6373 --- /dev/null +++ b/extra/peg/javascript/ast/summary.txt @@ -0,0 +1 @@ +Abstract Syntax Tree for JavaScript parser diff --git a/extra/peg/javascript/ast/tags.txt b/extra/peg/javascript/ast/tags.txt new file mode 100644 index 0000000000..c2aac2932f --- /dev/null +++ b/extra/peg/javascript/ast/tags.txt @@ -0,0 +1,3 @@ +text +javascript +parsing diff --git a/extra/peg/javascript/authors.txt b/extra/peg/javascript/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/peg/javascript/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/peg/javascript/javascript-docs.factor b/extra/peg/javascript/javascript-docs.factor new file mode 100644 index 0000000000..5fdc3e8587 --- /dev/null +++ b/extra/peg/javascript/javascript-docs.factor @@ -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." } ; diff --git a/extra/peg/javascript/javascript-tests.factor b/extra/peg/javascript/javascript-tests.factor new file mode 100644 index 0000000000..0d6899714d --- /dev/null +++ b/extra/peg/javascript/javascript-tests.factor @@ -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 \ No newline at end of file diff --git a/extra/peg/javascript/javascript.factor b/extra/peg/javascript/javascript.factor new file mode 100644 index 0000000000..8fe0538eae --- /dev/null +++ b/extra/peg/javascript/javascript.factor @@ -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* ; diff --git a/extra/peg/javascript/parser/authors.txt b/extra/peg/javascript/parser/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/peg/javascript/parser/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/peg/javascript/parser/parser-tests.factor b/extra/peg/javascript/parser/parser-tests.factor new file mode 100644 index 0000000000..fd0e27b6d4 --- /dev/null +++ b/extra/peg/javascript/parser/parser-tests.factor @@ -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 + diff --git a/extra/peg/javascript/parser/parser.factor b/extra/peg/javascript/parser/parser.factor new file mode 100644 index 0000000000..b7df9908da --- /dev/null +++ b/extra/peg/javascript/parser/parser.factor @@ -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 = +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 \ No newline at end of file diff --git a/extra/peg/javascript/parser/summary.txt b/extra/peg/javascript/parser/summary.txt new file mode 100644 index 0000000000..bae5a461d2 --- /dev/null +++ b/extra/peg/javascript/parser/summary.txt @@ -0,0 +1 @@ +JavaScript Parser diff --git a/extra/peg/javascript/parser/tags.txt b/extra/peg/javascript/parser/tags.txt new file mode 100644 index 0000000000..c2aac2932f --- /dev/null +++ b/extra/peg/javascript/parser/tags.txt @@ -0,0 +1,3 @@ +text +javascript +parsing diff --git a/extra/peg/javascript/summary.txt b/extra/peg/javascript/summary.txt new file mode 100644 index 0000000000..12f092dcf7 --- /dev/null +++ b/extra/peg/javascript/summary.txt @@ -0,0 +1 @@ +JavaScript parser diff --git a/extra/peg/javascript/tags.txt b/extra/peg/javascript/tags.txt new file mode 100644 index 0000000000..c2aac2932f --- /dev/null +++ b/extra/peg/javascript/tags.txt @@ -0,0 +1,3 @@ +text +javascript +parsing diff --git a/extra/peg/javascript/tokenizer/authors.txt b/extra/peg/javascript/tokenizer/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/peg/javascript/tokenizer/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/peg/javascript/tokenizer/summary.txt b/extra/peg/javascript/tokenizer/summary.txt new file mode 100644 index 0000000000..ce94386ed9 --- /dev/null +++ b/extra/peg/javascript/tokenizer/summary.txt @@ -0,0 +1 @@ +Tokenizer for JavaScript language diff --git a/extra/peg/javascript/tokenizer/tags.txt b/extra/peg/javascript/tokenizer/tags.txt new file mode 100644 index 0000000000..c2aac2932f --- /dev/null +++ b/extra/peg/javascript/tokenizer/tags.txt @@ -0,0 +1,3 @@ +text +javascript +parsing diff --git a/extra/peg/javascript/tokenizer/tokenizer-tests.factor b/extra/peg/javascript/tokenizer/tokenizer-tests.factor new file mode 100644 index 0000000000..509ff4a0fe --- /dev/null +++ b/extra/peg/javascript/tokenizer/tokenizer-tests.factor @@ -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 diff --git a/extra/peg/javascript/tokenizer/tokenizer.factor b/extra/peg/javascript/tokenizer/tokenizer.factor new file mode 100644 index 0000000000..195184a16c --- /dev/null +++ b/extra/peg/javascript/tokenizer/tokenizer.factor @@ -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 + diff --git a/unmaintained/jni/jni-internals.factor b/unmaintained/jni/jni-internals.factor new file mode 100644 index 0000000000..49bc57b108 --- /dev/null +++ b/unmaintained/jni/jni-internals.factor @@ -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" HEX: 00010004 over set-jdk-init-args-version ; + +: jni1 ( -- init-args int ) + dup JNI_GetDefaultJavaVMInitArgs ; + +: jni2 ( -- vm env int ) + f f [ + 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) ; + diff --git a/unmaintained/jni/jni.factor b/unmaintained/jni/jni.factor new file mode 100644 index 0000000000..86e1670c50 --- /dev/null +++ b/unmaintained/jni/jni.factor @@ -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 ; + \ No newline at end of file diff --git a/unmaintained/jni/load.factor b/unmaintained/jni/load.factor new file mode 100644 index 0000000000..f5fd45c8d9 --- /dev/null +++ b/unmaintained/jni/load.factor @@ -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" } } ;