;; JavaScriptの変数表現をパースするように
;; rfc.jsonを改造
; 文字列表現 "..." '....' の二種類ある。
;;;
;;; json.scm - JSON (RFC4627) Parser
;;;
;;; Copyright (c) 2006 Rui Ueyama (rui314@gmail.com)
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; 2. Redistributions in binary form must reproduce the above copyright
;;; notice, this list of conditions and the following disclaimer in the
;;; documentation and/or other materials provided with the distribution.
;;;
;;; 3. Neither the name of the authors nor the names of its contributors
;;; may be used to endorse or promote products derived from this
;;; software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; http://www.ietf.org/rfc/rfc4627.txt
;; NOTE: This module depends on parser.peg, whose API is not officially
;; fixed. Hence do not take this code as an example of parser.peg;
;; this will likely to be rewritten once parser.peg's API is changed.
(define-module js-object
(use gauche.parameter)
(use gauche.sequence)
(use gauche.generator)
(use parser.peg)
(use srfi-13)
(use srfi-14)
(use srfi-43)
(export <js-parse-error>
parse-js parse-js-string
parse-js*
js-array-handler js-object-handler js-special-handler
js-parser ;experimental
))
(select-module js-object)
;; NB: We have <js-parse-error> independent from <parse-error> for
;; now, since parser.peg's interface may be changed later.
(define-condition-type <js-parse-error> <error> #f
(position) ;stream position
(objects)) ;offending object(s) or messages
(define-condition-type <js-construct-error> <error> #f
(object)) ;offending object
(define js-array-handler (make-parameter list->vector))
(define js-object-handler (make-parameter identity))
(define js-special-handler (make-parameter identity))
(define (build-array elts) ((js-array-handler) elts))
(define (build-object pairs) ((js-object-handler) pairs))
(define (build-special symbol) ((js-special-handler) symbol))
;;;============================================================
;;; Parser
;;;
(define %ws ($skip-many ($one-of #[ \t\r\n])))
(define %begin-array ($seq ($char #\[) %ws))
(define %begin-object ($seq ($char #\{) %ws))
(define %end-array ($seq ($char #\]) %ws))
(define %end-object ($seq ($char #\}) %ws))
(define %name-separator ($seq ($char #\:) %ws))
(define %value-separator ($seq ($char #\,) %ws))
(define %special
($fmap ($ build-special $ string->symbol $ rope-finalize $)
($or ($string "false") ($string "true") ($string "null"))))
(define %value
($lazy
($fmap (^[v _] v) ($or %special %object %array %number %string) %ws)))
(define %array
($fmap (^[_0 lis _1] (build-array (rope-finalize lis)))
%begin-array ($sep-by %value %value-separator) %end-array))
(define %number
(let* ([%sign ($or ($do [($char #\-)] ($return -1))
($do [($char #\+)] ($return 1))
($return 1))]
[%digits ($fmap ($ string->number $ list->string $) ($many digit 1))]
[%int %digits]
[%frac ($do [($char #\.)]
[d ($many digit 1)]
($return (string->number (apply string #\0 #\. d))))]
[%exp ($fmap (^[_ s d] (* s d)) ($one-of #[eE]) %sign %digits)])
($fmap (^[sign int frac exp]
(let1 mantissa (+ int frac)
(* sign (if exp (exact->inexact mantissa) mantissa)
(if exp (expt 10 exp) 1))))
%sign %int ($or %frac ($return 0)) ($or %exp ($return #f)))))
(define (make-string q)
(let* ([%quote ($char q)]
[%escape ($char #\\)]
[%hex4 ($fmap (^s (string->number (list->string s) 16))
($many hexdigit 4 4))]
[%special-char
($do %escape
($or ($char q)
($char #\\)
($char #\/)
($do [($char #\b)] ($return #\x08))
($do [($char #\f)] ($return #\page))
($do [($char #\n)] ($return #\newline))
($do [($char #\r)] ($return #\return))
($do [($char #\t)] ($return #\tab))
($do [($char #\u)] (c %hex4) ($return (ucs->char c)))))]
[%unescaped ($none-of (char-set q) )]
[%body-char ($or %special-char %unescaped)]
[%string-body ($->rope ($many %body-char))])
($between %quote %string-body %quote)))
; 文字列はシングルクオートとダブルクオート
(define %string ($or (make-string #\') (make-string #\") ) )
(define %word ($->rope ($do [h ($one-of #[A-Za-z_$])]
[t ($many-chars #[A-Za-z0-9_$])]
($return (cons h t)))))
; objectのキーは引用符つき、と引用符なしを許す。
(define %key ($or %word %string))
(define %object
(let1 %member ($do [k %key] %ws
%name-separator
[v %value]
($return (cons k v)))
($between %begin-object
($fmap ($ build-object $ rope-finalize $)
($sep-by %member %value-separator))
%end-object)))
; 文字列、Object、配列をパース
(define js-parser ($seq %ws ($or eof %string %object %array)))
;; entry point
(define (parse-js :optional (port (current-input-port)))
(guard (e [(<parse-error> e)
;; not to expose parser.peg's <parse-error>.
(error <js-parse-error>
:position (~ e'position) :objects (~ e'objects)
:message (~ e'message))])
(peg-parse-port js-parser port)))
(define (parse-js-string str)
(call-with-input-string str (cut parse-js <>)))
(define (parse-js* :optional (port (current-input-port)))
(guard (e [(<parse-error> e)
;; not to expose parser.peg's <parse-error>.
(error <js-parse-error>
:position (~ e'position) :objects (~ e'objects)
:message (~ e'message))])
(generator->list (peg-parser->generator js-parser port))))
koguro
Gaucheでの解決策じゃないんですが、そのページのデータだと副作用がなさそうなので、JS処理系に食わせてしまったらどうでしょう。
齊藤
ナイスアイデア!!
Tag: parser.peg