<commit_before>;;; rascl-parser.scm -- A parser for the rascl egg.
;;;   Copyright  2015 by <NAME> <<EMAIL>>
;;;   This program is open-source software, released under the
;;;   BSD license. See the accompanying LICENSE file for details.

(module rascl-parser
        *
        (import scheme chicken)
        (import data-structures)
        (use comparse)
        (use srfi-14)

(define whitespace
  (one-or-more (in char-set:whitespace)))

(define reserved
  (let ((cs:reserved (string->char-set "#:,{}[]\n")))
    (in cs:reserved)))

(define newline~
  (is #\newline))

(define eol
  (any-of newline~ end-of-input))

(define comment
  (preceded-by (is #\#)
               (maybe whitespace)
               (as-string (zero-or-more (none-of* newline~ item)))))

(define line-end
  (sequence (maybe comment) eol))

(define separator
  (sequence (maybe whitespace) (any-of (is #\,) line-end) (maybe whitespace)))

(define escape-sequence
  (let ((cs:esc (list->char-set '(#\alarm #\vtab #\page #\newline #\tab #\backspace))))
    (preceded-by (is #\\) (as-string (in cs:esc)))))

(define qstring-content
  (zero-or-more (any-of escape-sequence
                        (none-of* (is #\") item))))

(define qstring
  (enclosed-by (is #\") (as-string qstring-content) (is #\")))

(define ustring
  (followed-by (as-string (one-or-more (none-of* reserved line-end item)))
               (any-of reserved line-end)))

(define string~
  (any-of qstring ustring))

(define hex-int
  (bind (preceded-by (char-seq "0x") (as-string (one-or-more (in char-set:hex-digit))))
        (lambda (s) (result (conc "#x" s))))) 

(define dec-int
  (as-string (sequence (maybe (is #\-)) (one-or-more (in char-set:digit)))))

(define oct-int
  (let ((cs:oct-digit (string->char-set "01234567")))
    (bind (preceded-by (char-seq "0o") (as-string (one-or-more (in cs:oct-digit))))
          (lambda (s) (result (conc "#o" s))))))

(define integer
  (bind (any-of hex-int dec-int oct-int)
        (lambda (s) (result (string->number s)))))

(define float
  (sequence (maybe (is #\-))
            (any-of (sequence (one-or-more (in char-set:digit)) (is #\.)
                              (zero-or-more (in char-set:digit)))
                    (sequence (zero-or-more (in char-set:digit)) (is #\.)
                              (one-or-more (in char-set:digit))))))

(define number
  (any-of integer float))

(define boolean
  (let ((cs:t (string->char-set "Tt"))
        (cs:r (string->char-set "Rr"))
        (cs:u (string->char-set "Uu"))
        (cs:e (string->char-set "Ee"))
        (cs:f (string->char-set "Ff"))
        (cs:a (string->char-set "Aa"))
        (cs:l (string->char-set "Ll"))
        (cs:s (string->char-set "Ss")))
    (bind (as-string
            (any-of (sequence (in cs:t) (in cs:r) (in cs:u) (in cs:e))
                    (sequence (in cs:f) (in cs:a) (in cs:l) (in cs:s) (in cs:e))))
          (lambda (b)
            (result
              (cond
                ((string-ci=? b "true") #t)
                ((string-ci=? b "false") #f)))))))


(define dict-key string~)

; (define dict-value item)

(define dict-entry
  (sequence dict-key (maybe whitespace) (is #\:) (maybe whitespace) dict-value))

(define dict-content
  (sequence (maybe whitespace)
            (maybe (sequence dict-entry (zero-or-more (sequence separator dict-entry))))
            (maybe whitespace)))

(define dict
  (enclosed-by (is #\{) dict-content (is #\})))

(define int-list-content
  (sequence integer (zero-or-more (preceded-by separator integer))))

(define float-list-content
  (sequence float (zero-or-more (preceded-by separator float)))) 

(define number-list-content
  (sequence number (zero-or-more (preceded-by separator number))))

(define boolean-list-content
  (sequence boolean (zero-or-more (preceded-by separator boolean))))

(define string-list-content
  (sequence string~ (zero-or-more (preceded-by separator string~))))

(define list-content
  (bind (any-of int-list-content
                float-list-content
                number-list-content
                boolean-list-content
                string-list-content)
        (lambda (lst) (result (flatten lst)))))

(define list~
  (enclosed-by (is #\[)
               (any-of list-content (maybe whitespace))
               (is #\])))

(define dict-value
  (any-of integer float number boolean string~ list~ dict))

(define file-content
  (sequence dict-content end-of-input))


) ; END MODULE

#|
{
  open RasclParser

  exception LexerError of string

  let sym_or_recurse symopt act =
    match symopt with
    | Some s -> s
    | None -> act
<commit_msg>Another attempt to define mutually recursive parsers.<commit_after>;;; rascl-parser.scm -- A parser for the rascl egg.
;;;   Copyright  2015 by <NAME> <<EMAIL>>
;;;   This program is open-source software, released under the
;;;   BSD license. See the accompanying LICENSE file for details.

(module rascl-parser
        *
        (import scheme chicken)
        (import data-structures)
        (use utils)
        (use comparse)
        (use srfi-14)

(define whitespace
  (one-or-more (in char-set:whitespace)))

(define reserved
  (let ((cs:reserved (string->char-set "#:,{}[]\n")))
    (in cs:reserved)))

(define newline~
  (is #\newline))

(define eol
  (any-of newline~ end-of-input))

(define comment
  (preceded-by (is #\#)
               (maybe whitespace)
               (as-string (zero-or-more (none-of* newline~ item)))))

(define line-end
  (sequence (maybe comment) eol))

(define separator
  (sequence (maybe whitespace) (any-of (is #\,) line-end) (maybe whitespace)))

(define escape-sequence
  (let ((cs:esc (list->char-set '(#\alarm #\vtab #\page #\newline #\tab #\backspace))))
    (preceded-by (is #\\) (as-string (in cs:esc)))))

(define qstring-content
  (zero-or-more (any-of escape-sequence
                        (none-of* (is #\") item))))

(define qstring
  (enclosed-by (is #\") (as-string qstring-content) (is #\")))

(define ustring
  (followed-by (as-string (one-or-more (none-of* reserved line-end item)))
               (any-of reserved line-end)))

(define string~
  (any-of qstring ustring))

(define hex-int
  (bind (preceded-by (char-seq "0x") (as-string (one-or-more (in char-set:hex-digit))))
        (lambda (s) (result (conc "#x" s))))) 

(define dec-int
  (as-string (sequence (maybe (is #\-)) (one-or-more (in char-set:digit)))))

(define oct-int
  (let ((cs:oct-digit (string->char-set "01234567")))
    (bind (preceded-by (char-seq "0o") (as-string (one-or-more (in cs:oct-digit))))
          (lambda (s) (result (conc "#o" s))))))

(define integer
  (bind (any-of hex-int dec-int oct-int)
        (lambda (s) (result (string->number s)))))

(define float
  (sequence (maybe (is #\-))
            (any-of (sequence (one-or-more (in char-set:digit)) (is #\.)
                              (zero-or-more (in char-set:digit)))
                    (sequence (zero-or-more (in char-set:digit)) (is #\.)
                              (one-or-more (in char-set:digit))))))

(define number
  (any-of integer float))

(define boolean
  (let ((cs:t (string->char-set "Tt"))
        (cs:r (string->char-set "Rr"))
        (cs:u (string->char-set "Uu"))
        (cs:e (string->char-set "Ee"))
        (cs:f (string->char-set "Ff"))
        (cs:a (string->char-set "Aa"))
        (cs:l (string->char-set "Ll"))
        (cs:s (string->char-set "Ss")))
    (bind (as-string
            (any-of (sequence (in cs:t) (in cs:r) (in cs:u) (in cs:e))
                    (sequence (in cs:f) (in cs:a) (in cs:l) (in cs:s) (in cs:e))))
          (lambda (b)
            (result
              (cond
                ((string-ci=? b "true") #t)
                ((string-ci=? b "false") #f)))))))


(define int-list-content
  (sequence integer (zero-or-more (preceded-by separator integer))))

(define float-list-content
  (sequence float (zero-or-more (preceded-by separator float)))) 

(define number-list-content
  (sequence number (zero-or-more (preceded-by separator number))))

(define boolean-list-content
  (sequence boolean (zero-or-more (preceded-by separator boolean))))

(define string-list-content
  (sequence string~ (zero-or-more (preceded-by separator string~))))

(define list-content
  (bind (any-of int-list-content
                float-list-content
                number-list-content
                boolean-list-content
                string-list-content)
        (lambda (lst) (result (flatten lst)))))

(define list~
  (enclosed-by (is #\[)
               (any-of list-content (maybe whitespace))
               (is #\])))

(define dict-key string~)

; (define-values (dict dict-content dict-entry dict-value)
;   (letrec ((dict~
;              (lambda ()
;              (enclosed-by (is #\{) dict-content~ (is #\})))
;              )
;            (dict-content~
;              (lambda ()
;              (sequence (maybe whitespace)
;                        (maybe (sequence dict-entry~
;                                         (zero-or-more (sequence separator
;                                                                 dict-entry~))))
;                        (maybe whitespace)))
;              )
;            (dict-entry~
;              (lambda ()
;              (sequence dict-key
;                        (maybe whitespace)
;                        (is #\:)
;                        (maybe whitespace)
;                        dict-value~))
;              )
;            (dict-value~
;              (lambda ()
;              (any-of integer float number boolean string~ list~ dict~)))
;              ; (any-of integer float number boolean string~ list~)))
;            )
;     (values (dict~) (dict-content~) (dict-entry~) (dict-value~))))

(define dict #f)
(define dict-content #f)
(define dict-entry #f)
(define dict-value #f)

(letrec ((dict~
           (lambda ()
           (enclosed-by (is #\{) (dict-content~) (is #\})))
           )
         (dict-content~
           (lambda ()
           (sequence (maybe whitespace)
                     (maybe (sequence (dict-entry~)
                                      (zero-or-more (sequence separator
                                                              (dict-entry~)))))
                     (maybe whitespace)))
           )
         (dict-entry~
           (lambda ()
           (sequence dict-key
                     (maybe whitespace)
                     (is #\:)
                     (maybe whitespace)
                     (dict-value~)))
           )
         (dict-value~
           (lambda ()
           (any-of integer float number boolean string~ list~ (dict~))))
           ; (any-of integer float number boolean string~ list~)))
         )
  (set! dict (dict~))
  (set! dict-content (dict-content~))
  (set! dict-entry (dict-entry~))
  (set! dict-value (dict-value~)))

; (define-values (dict dict-content dict-entry dict-value)
;   (let ()
;     (define dict~
;       (enclosed-by (is #\{) dict-content~ (is #\})))
;     (define dict-content~
;       (sequence (maybe whitespace)
;                 (maybe (sequence dict-entry~
;                                  (zero-or-more (sequence separator
;                                                          dict-entry~))))
;                 (maybe whitespace)))
;     (define dict-entry~
;       (sequence dict-key
;                 (maybe whitespace)
;                 (is #\:)
;                 (maybe whitespace)
;                 dict-value~))
;     (define dict-value~
;       (any-of integer float number boolean string~ list~ dict~))
;     (values dict~ dict-content~ dict-entry~ dict-value~)))

; (define dict-value
;   ; (any-of integer float number boolean string~ list~ dict~)))
;   (any-of integer float number boolean string~ list~))
; 
; (define dict-entry
;   (sequence dict-key
;             (maybe whitespace)
;             (is #\:)
;             (maybe whitespace)
;             dict-value))
; 
; (define dict-content
;   (sequence (maybe whitespace)
;             (maybe (sequence dict-entry
;                              (zero-or-more (sequence separator dict-entry))))
;             (maybe whitespace)))
; 
; (define dict
;   (enclosed-by (is #\{) dict-content (is #\})))

(define (parse-rascl-file filename)
  (with-input-from-file filename
    (lambda ()
      (parse dict-content (read-all (current-input-port))))))

) ; END MODULE

#|
{
  open RasclParser

  exception LexerError of string

  let sym_or_recurse symopt act =
    match symopt with
    | Some s -> s
    | None -> act

{'fraction_non_alphanumeric': 0.1650943396226415, 'fraction_numerical': 0.0025583626479053407, 'mean_word_length': 2.01131439576312, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4178804', 'n_tokens_mistral': 4109, 'n_tokens_neox': 3973, 'n_words': 1034}