/parse-js.ss
Scheme | 694 lines | 370 code | 230 blank | 94 comment | 0 complexity | d9a870b5e6d2c82b12954b8549900cc9 MD5 | raw file
Possible License(s): GPL-3.0
- ;; ydiff - a language-aware tool for comparing programs
- ;; Copyright (C) 2011 Yin Wang (yinwang0@gmail.com)
- ;; This program is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; This program is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
- (load "parsec.ss")
- ;-------------------------------------------------------------
- ; scanner settings
- ;-------------------------------------------------------------
- (define *delims* (list "(" ")" "[" "]" "{" "}" "," "`" ";"))
- (define *operators*
- (list
- ">>>="
- "<<=" ">>=" ">>>" "===" "!=="
- "==" "!=" ">=" "<=" "&&" "||" ">>" "<<" "++" "--"
- "+=" "-=" "*=" "/=" "%=" "&=" "^=" "|="
- "=" "+" "-" "*" "/" "%" "~" "!" ":" "?" "." ">" "<"
- ))
- (define *line-comment* (list "//"))
- (define *comment-start* "/*")
- (define *comment-end* "*/")
- (define *quotation-marks* '(#\" #\'))
- (define *significant-whitespaces*
- (list #\newline #\linefeed #\u2028 #\u2029))
- (define alpha?
- (predor char-alphabetic?
- (lambda (x) (char=? x #\$))))
- ;-------------------------------------------------------------
- ; primitive parsers
- ;-------------------------------------------------------------
- (:: $identifier
- ($pred
- (lambda (t)
- (and (Token? t)
- (id? (Token-text t))))))
- (:: $numeral-literal
- ($pred
- (lambda (t)
- (and (Token? t)
- (numeral? (Token-text t))))))
- (:: $string-literal ($pred Str?))
- (:: $newline ($pred Newline?))
- (:: $comment ($pred Comment?))
- ;; delimeters
- (:: |,| (@_ ","))
- (:: |;| (@~ ";"))
- (:: |:| (@_ ":"))
- (:: |(| (@~ "("))
- (:: |)| (@~ ")"))
- (:: |[| (@~ "["))
- (:: |]| (@~ "]"))
- (:: |{| (@~ "{"))
- (:: |}| (@~ "}"))
- ;; $glob^ and $*^ needed to define |\n|, because the
- ;; definition of |\n| must not contain any call to @seq
- ;; otherwise the parser will go into infinite loop
- (:: |\n| ($glob^ (@*^ $newline)))
- (:: |;\n| (@or |;| |\n|))
- ;; Redefine sequence to get over newlines
- (define old-seq @seq)
- (define @seq
- (lambda ps
- (let ([psj (join ps |\n|)])
- (apply old-seq `(,|\n| ,@psj ,|\n|)))))
- ;; ($eval (@seq ($$ "foo") ($$ "bar"))
- ;; (scan "
- ;; foo
- ;; bar "))
- ;-------------------------------------------------------------
- ; compound parsers
- ;-------------------------------------------------------------
- (::= $program 'program
- (@* $statement))
- (:: $statement
- (@or $statement-block
- $empty-statement
- $function-definition
- $variable-statement
- $with-statement
- $if-statement
- $switch-statement
- $do-while-statement
- $while-statement
- $for-statement
- $for-in-statement
- $continue-statement
- $break-statement
- $try-statement
- $throw-statement
- $return-statement
- $labelled-statement
- $expression-statement
- ))
- (::= $statement-block 'block
- |{| (@* $statement) |}|
- )
- (:: $empty-statement |;|)
- (::= $function-definition 'function
- ($$ "function") (@= 'name $identifier) $formal-parameter-list
- $function-body)
- ;; function-expression can be unnamed
- (::= $function-expression 'function
- ($$ "function") (@= 'name (@? $identifier)) $formal-parameter-list
- $function-body)
- (::= $formal-parameter-list 'parameters
- (@or (@... |(| (@? (@.@ $identifier |,|)) |)| )
- $identifier))
- (::= $function-body 'body
- $statement-block
- )
- ;;---------------- variable statement -----------------
- (::= $variable-statement 'variable-declaration
- ($$ "var") (@.@ $variable-declaration |,|) |;\n|
- )
- (::= $variable-declaration 'variable-declaration
- $identifier (@? $initializer))
- (::= $initializer 'initializer
- (@... ($$ "=") $assignment-expression))
- ;;--------------------------------------------
- (::= $with-statement 'with
- ($$ "with") (@= 'obj |(| $expression |)|)
- $statement
- )
- ;;--------------------------------------------
- (::= $if-statement 'if
- ($$ "if") (@= 'test |(| $expression |)|) $statement
- (@? (@= 'else ($$ "else") $statement
- )))
- ;;--------------------------------------------
- (::= $do-while-statement 'do-while
- ($$ "do") $statement
- (@= 'while-do ($$ "while") (@= 'test |(| $expression |)| ))
- |;\n|
- )
- ;;--------------------------------------------
- (::= $while-statement 'while
- ($$ "while") (@= 'test |(| $expression |)| )
- $statement
- )
- ;;--------------------------------------------
- (::= $for-statement 'for
- ($$ "for") (@= 'iter
- |(| (@? $for-initaliser) |;|
- (@? $expression) |;|
- (@? $expression)
- |)|
- )
- $statement
- )
- (::= $for-initaliser 'for-initializer
- (@or (@= 'variable-declaration
- ($$ "var") (@.@ $variable-declaration |,|))
- $expression
- ))
- ;;--------------------------------------------
- (::= $for-in-statement 'for-in
- ($$ "for") (@= 'iter
- |(| (@? $for-in-initalizer) ($$ "in") $expression |)|)
- $statement
- )
- (::= $for-in-initalizer 'for-in-initializer
- (@or (@= 'variable-declaration
- ($$ "var") (@.@ $variable-declaration |,|))
- $expression
- ))
- ;;--------------------------------------------
- (::= $continue-statement 'continue
- ($$ "continue") (@= 'label (@? $identifier)) |;\n|
- )
- ;;--------------------------------------------
- (::= $break-statement 'break
- ($$ "break") (@= 'label (@? $identifier)) |;\n|
- )
- ;;--------------------------------------------
- (::= $return-statement 'return
- ($$ "return") (@= 'value (@? $expression)) |;\n|
- )
- ;;--------------------------------------------
- (::= $labelled-statement 'labelled-statement
- $identifier |:| $statement
- )
- ;;--------------------------------------------
- (::= $switch-statement 'switch-statement
- ($$ "switch") |(| $expression |)|
- |{| (@* $case-clause)
- (@? $default-clause
- (@* $case-clause))
- |}|
- )
- (::= $case-clause 'case-clause
- ($$ "case") $expression |:| (@* $statement)
- )
- (::= $default-clause 'default
- ($$ "default") |:| (@* $statement)
- )
- ;;--------------------------------------------
- (::= $throw-statement 'throw
- ($$ "throw") $expression |;\n|
- )
- ;;--------------------------------------------
- (::= $try-statement 'try
- ($$ "try") $statement-block
- (@or $finally-clause
- (@... $catch-clause (@? $finally-clause)))
- )
- (::= $catch-clause 'catch
- ($$ "catch") |(| $identifier |)| $statement-block
- )
- (::= $finally-clause 'finally
- ($$ "finally") $statement-block
- )
- ;;--------------------------------------------
- (::= $expression-statement 'expression-statement
- $expression |;\n|
- )
- ;-------------------------------------------------------------
- ; expressions
- ;-------------------------------------------------------------
- ;; utility for constructing operators
- (define op
- (lambda (s)
- (@= 'op ($$ s))))
- (:: $expression
- $comma-expression)
- ;; 18. comma
- ;;--------------------------------------------
- (::= $comma-expression 'comma
- (@.@ $assignment-expression |,|))
- ;; 16. assignment
- ;;--------------------------------------------
- (:: $assignment-expression
- (@or (@= 'assignment
- $conditional-expression
- $assignment-operator
- $assignment-expression)
- $conditional-expression
- ))
- (:: $assignment-operator
- (@or (op "=")
- (op "*=")
- (op "/=")
- (op "%=")
- (op "+=")
- (op "-=")
- (op "<<=")
- (op ">>=")
- (op ">>>=")
- (op "&=")
- (op "^=")
- (op "|=")
- ))
- ;; 15. ?: Ternary conditional
- ;;--------------------------------------------
- (:: $conditional-expression
- (@or (@= 'conditional-expression
- (@= 'test $logical-or-expression)
- (@~ "?") (@= 'then $conditional-expression)
- (@~ ":") (@= 'else $conditional-expression))
- $logical-or-expression
- ))
- ; ($eval $conditional-expression (scan "x > 0? x-1 : x"))
- ;; 14. || Logical OR
- ;;--------------------------------------------
- (:: $logical-or-expression
- (@or (@infix-left 'binop
- $logical-and-expression
- (op "||"))
- $logical-and-expression
- ))
- ; ($eval $logical-or-expression (scan "x || y"))
- ;; 13. && Logical AND
- ;;--------------------------------------------
- (:: $logical-and-expression
- (@or (@infix-left 'binop
- $bitwise-or-expression
- (op "&&"))
- $bitwise-or-expression
- ))
- ;; 12. | Bitwise OR (inclusive or)
- ;;--------------------------------------------
- (:: $bitwise-or-expression
- (@or (@infix-left 'binop
- $bitwise-xor-expression
- (op "|"))
- $bitwise-xor-expression
- ))
- ;; 11. ^ Bitwise XOR (exclusive or)
- ;;--------------------------------------------
- (:: $bitwise-xor-expression
- (@or (@infix-left 'binop
- $bitwise-and-expression
- (op "^"))
- $bitwise-and-expression
- ))
- ;; 10. & Bitwise AND
- ;;--------------------------------------------
- (:: $bitwise-and-expression
- (@or (@infix-left 'binop
- $equality-expression
- (op "&"))
- $equality-expression
- ))
- ;; 9. equality
- ;;--------------------------------------------
- (:: $equality-expression
- (@or (@infix-left 'binop
- $relational-expression
- $equality-operator)
- $relational-expression
- ))
- (:: $equality-operator
- (@or (op "==")
- (op "!=")
- (op "===")
- (op "!==")
- ))
- ;; 8. relational
- ;;--------------------------------------------
- (:: $relational-expression
- (@or (@infix-left 'binop
- $bitwise-shift-expression
- $relational-operator)
- $bitwise-shift-expression
- ))
- (:: $relational-operator
- (@or (op "<")
- (op "<=")
- (op ">")
- (op ">=")
- (op "instanceof")
- (op "in")
- ))
- ;; 7. bitwise shift
- ;;--------------------------------------------
- (:: $bitwise-shift-expression
- (@or (@infix-left 'binop
- $additive-expression
- $bitwise-shift-operator)
- $additive-expression
- ))
- (:: $bitwise-shift-operator
- (@or (op "<<")
- (op ">>")
- (op ">>>")
- ))
- ;; 6. additive
- ;;--------------------------------------------
- (:: $additive-expression
- (@or (@infix-left 'binop
- $multiplicative-expression
- $additive-operator)
- $multiplicative-expression
- ))
- (:: $additive-operator
- (@or (op "+")
- (op "-")))
- ;; ($eval $additive-expression (scan "x + y + z"))
- ;; 5. multiplicative
- ;;--------------------------------------------
- (:: $multiplicative-expression
- (@or (@infix-left 'binop
- $unary-expression
- $multiplicative-operator)
- $unary-expression))
- (:: $multiplicative-operator
- (@or (op "*")
- (op "/")
- (op "%")))
- ;; 3. prefix
- ;; 2. postfix
- ;;--------------------------------------------
- (:: $unary-expression
- $prefix-expression)
- (:: $prefix-expression
- (@or (@prefix 'prefix
- $postfix-expression
- $prefix-operator)
- $postfix-expression))
- (:: $postfix-expression
- (@or (@postfix 'postfix
- $primary-expression
- $postfix-operator)
- $primary-expression))
- (:: $prefix-operator
- (@or (op "new")
- (op "delete")
- (op "void")
- (op "typeof")
- (op "++")
- (op "--")
- (op "+")
- (op "-")
- (op "~")
- (op "!")
- ))
- (:: $postfix-operator
- (@or $index-suffix
- $property-reference-suffix
- $arguments
- (op "++")
- (op "--")))
- (::= $index-suffix 'index
- |[| $expression |]|
- )
- (::= $property-reference-suffix 'property
- (@_ ".") $identifier)
- (::= $arguments 'arguments
- |(| (@? (@.@ $assignment-expression |,|)) |)|
- )
- (::= $new-expression 'new
- ($$ "new") $postfix-expression)
- ;; 1. primary
- ;;--------------------------------------------
- (:: $primary-expression
- (@or $function-expression
- $identifier
- $literal
- (@= 'expression |(| $expression |)| )
- ))
- ;;-----------
- (::= $array-literal 'array-literal
- |[| (@? (@.@ $assignment-expression |,|)) |]|
- )
- ;;-----------
- (::= $object-literal 'object-literal
- |{| $property-name-value (@* |,| $property-name-value) |}|
- )
- (::= $property-name-value 'property-name-value
- $property-name |:| $assignment-expression)
- (:: $property-name
- (@or $identifier
- $string-literal
- $numeral-literal))
- ;;-----------
- (:: $literal
- (@or ($$ "null")
- ($$ "true")
- ($$ "false")
- (@= 'this ($$ "this"))
- $string-literal
- $numeral-literal
- $array-literal
- $object-literal
- ))
- ;-------------------------------------------------------------
- ; parse-js
- ;-------------------------------------------------------------
- (define parse-js
- (lambda (s)
- (first-val
- ($eval $program
- (filter (lambda (x) (not (Comment? x)))
- (scan s))))))
- ;-------------------------------------------------------------
- ; tests
- ;-------------------------------------------------------------
- ;; (parse-js (read-file "nav-div.js"))