<commit_before>#lang racket/base

(require rackunit)
(require parser-tools/lex
         (prefix-in : parser-tools/lex-sre))
(require racket/match
         (for-syntax racket/base
                     syntax/parse))

(define-tokens honu-tokens (number identifier string))

(define-empty-tokens honu-empty-tokens
                     [eof fail whitespace
                      left-parens right-parens
                      left-bracket right-bracket
                      left-brace right-brace
                      block-comment
                      end-of-line-comment])

(define-lex-abbrev digit (:/ #\0 #\9))
(define-lex-abbrev identifier-first-character (:or (:/ #\a #\z)
                                                   (:/ #\A #\Z)))
(define-lex-abbrev identifier-character (:or identifier-first-character
                                             digit))
(define-lex-abbrev identifier (:: identifier-first-character
                                  (:* identifier-character)))
(define-lex-abbrev number (:+ digit))
(define-lex-abbrev string-character (:or (:: #\\ any-char)
                                         (:~ #\")))
(define-lex-abbrev string (:: #\" (:* string-character) #\"))
(define-lex-abbrev block-comment (:: "/*"
                                     (complement (:: any-string "*/" any-string))
                                     "*/"))

(define-lex-abbrev line-comment (:: (:or "#" "//")
                                    (:* (:~ "\n"))
                                    ;; we might hit eof before a \n
                                    (:? "\n")))

(define (replace-escapes string)
  (define replacements '([#px"\\\\n" "\n"]
                         [#px"\\\\t" "\t"]))
  (for/fold ([string string])
            ([replace replacements])
    (define pattern (car replace))
    (define with (cadr replace))
    (regexp-replace* pattern string with)))

(define honu-lexer
  (lexer-src-pos
    [(eof) (token-eof)]
    [line-comment (token-whitespace)]
    #;
    [(:or "#" "//") (token-end-of-line-comment)]
    ["\n" (token-whitespace)]
    [number (token-number (string->number lexeme))]
    #;
    [block-comment (token-whitespace)]
    ["/*" (token-block-comment)]
    ["." (token-identifier '|.|)]
    ["," (token-identifier '|,|)]
    ["!" (token-identifier '!)]
    ["=" (token-identifier '=)]
    ["*" (token-identifier '*)]
    ["/" (token-identifier '/)]
    ["+" (token-identifier '+)]
    [";" (token-identifier '|;|)]
    ;; strip the quotes from the resulting string
    ;; TODO: find a more optimal way
    [string (let ()
              (define raw (substring (substring lexeme 1)
                                     0 (- (string-length lexeme) 2)))
              (token-string (replace-escapes raw)))]
    ["(" (token-left-parens)]  [")" (token-right-parens)]
    ["[" (token-left-bracket)] ["]" (token-right-bracket)]
    ["{" (token-left-brace)]   ["}" (token-right-brace)]
    [identifier (token-identifier (string->symbol lexeme))]
    [(union " " "\t") (token-whitespace)]))

(define-syntax (define-token? stx)
  (syntax-parse stx
    [(_ name)
     (define name? (datum->syntax #'name (string->symbol
                                           (format "token-~a?"
                                                 (symbol->string
                                                   (syntax->datum #'name))))
                                  #'name))
     (with-syntax ([name? name?])
       #'(define (name? token)
           (equal? 'name (token-name token))))]))

(define-syntax-rule (define-tokens? name ...)
                    (begin
                      (define-token? name) ...))

(define-tokens? eof whitespace end-of-line-comment number string
                block-comment
                identifier left-parens right-parens
                left-bracket right-bracket
                left-brace right-brace)

(define (read-until-end-of-line input)
  (define (finish? what)
    (or (eof-object? what)
	(= (char->integer #\newline) what)))
  (let loop ()
    (define what (read-byte input))
    (when (not (finish? what))
      (loop))))

(define (read-block-comment port)
  (define comment-lexer
    (lexer
      ["/*" 'nest]
      ["*/" 'done]
      [(eof) eof]
      [any-char 'continue]))

  (define (finish? what)
    (or (eq? 'done what)
        (eof-object? what)))

  (let loop ([nesting 1])
    (define what (comment-lexer port))
    (cond
      [(eq? what 'nest) (loop (add1 nesting))]
      [(eq? what 'done) (when (> nesting 1)
                          (loop (sub1 nesting)))]
      [(eof-object? what) (void)]
      [else (loop nesting)])))

;; read characters from a port and return a stream of tokens
(define (read-tokens port)
  (let loop ([tokens '()])
    (define next (honu-lexer port))
    ;; (printf "next ~a\n" next)
    (match next
	   [(struct* position-token ([token (? token-eof?)] [start-pos start] [end-pos end]))
	    ;; (printf "done lexing\n")
	    (reverse tokens)]
	   [(struct* position-token ([token (? token-end-of-line-comment?)]
				     [start-pos start]
				     [end-pos end]))
	    (read-until-end-of-line port)
	    (loop tokens)]
       [(struct* position-token ([token (? token-block-comment?)]
				     [start-pos start]
				     [end-pos end]))
        (read-block-comment port)
	    (loop tokens)]
	   [(struct* position-token ([token (? token-whitespace?)] [start-pos start] [end-pos end]))
	    (loop tokens)]
       [else (loop (cons next tokens))]
       #;
	   [(position-token token start end)
	    ;; (printf "next is ~a eof? ~a\n" token (token-eof? token))
	    (loop (cons token tokens))])))

;; convert a string to a stream of tokens
(define (lex-string input)
  (read-tokens (open-input-string input)))<commit_msg>[honu] return a parse error if the lexer couldnt find any other matching regex<commit_after>#lang racket/base

(require rackunit)
(require parser-tools/lex
         (prefix-in : parser-tools/lex-sre))
(require racket/match
         (for-syntax racket/base
                     syntax/parse))

(define-tokens honu-tokens (number identifier string))

(define-empty-tokens honu-empty-tokens
                     [eof fail whitespace
                      left-parens right-parens
                      parse-error
                      left-bracket right-bracket
                      left-brace right-brace
                      block-comment
                      end-of-line-comment])

(define-lex-abbrev digit (:/ #\0 #\9))
(define-lex-abbrev identifier-first-character (:or (:/ #\a #\z)
                                                   (:/ #\A #\Z)))
(define-lex-abbrev identifier-character (:or identifier-first-character
                                             digit))
(define-lex-abbrev identifier (:: identifier-first-character
                                  (:* identifier-character)))
(define-lex-abbrev number (:+ digit))
(define-lex-abbrev string-character (:or (:: #\\ any-char)
                                         (:~ #\")))
(define-lex-abbrev string (:: #\" (:* string-character) #\"))
(define-lex-abbrev block-comment (:: "/*"
                                     (complement (:: any-string "*/" any-string))
                                     "*/"))

(define-lex-abbrev line-comment (:: (:or "#" "//")
                                    (:* (:~ "\n"))
                                    ;; we might hit eof before a \n
                                    (:? "\n")))

(define (replace-escapes string)
  (define replacements '([#px"\\\\n" "\n"]
                         [#px"\\\\t" "\t"]))
  (for/fold ([string string])
            ([replace replacements])
    (define pattern (car replace))
    (define with (cadr replace))
    (regexp-replace* pattern string with)))

(provide honu-lexer)
(define honu-lexer
  (lexer-src-pos
    [(eof) (token-eof)]
    [line-comment (token-whitespace)]
    #;
    [(:or "#" "//") (token-end-of-line-comment)]
    ["\n" (token-whitespace)]
    [number (token-number (string->number lexeme))]
    #;
    [block-comment (token-whitespace)]
    ["/*" (token-block-comment)]
    ["." (token-identifier '|.|)]
    ["," (token-identifier '|,|)]
    ["!" (token-identifier '!)]
    ["=" (token-identifier '=)]
    ["*" (token-identifier '*)]
    ["/" (token-identifier '/)]
    ["+" (token-identifier '+)]
    [";" (token-identifier '|;|)]
    ;; strip the quotes from the resulting string
    ;; TODO: find a more optimal way
    [string (let ()
              (define raw (substring (substring lexeme 1)
                                     0 (- (string-length lexeme) 2)))
              (token-string (replace-escapes raw)))]
    ["(" (token-left-parens)]  [")" (token-right-parens)]
    ["[" (token-left-bracket)] ["]" (token-right-bracket)]
    ["{" (token-left-brace)]   ["}" (token-right-brace)]
    [identifier (token-identifier (string->symbol lexeme))]
    [(union " " "\t") (token-whitespace)]
    [any-char (token-parse-error)]))

(define-syntax (define-token? stx)
  (syntax-parse stx
    [(_ name)
     (define name? (datum->syntax #'name (string->symbol
                                           (format "token-~a?"
                                                 (symbol->string
                                                   (syntax->datum #'name))))
                                  #'name))
     (with-syntax ([name? name?])
       #'(begin
           (provide name?)
           (define (name? token)
             (equal? 'name (token-name token)))))]))

(define-syntax-rule (define-tokens? name ...)
                    (begin
                      (define-token? name) ...))

(define-tokens? eof whitespace end-of-line-comment number string
                block-comment parse-error
                identifier left-parens right-parens
                left-bracket right-bracket
                left-brace right-brace)

(define (read-until-end-of-line input)
  (define (finish? what)
    (or (eof-object? what)
        (= (char->integer #\newline) what)))
  (let loop ()
    (define what (read-byte input))
    (when (not (finish? what))
      (loop))))

(define (read-block-comment port)
  (define comment-lexer
    (lexer
      ["/*" 'nest]
      ["*/" 'done]
      [(eof) eof]
      [any-char 'continue]))

  (define (finish? what)
    (or (eq? 'done what)
        (eof-object? what)))

  (let loop ([nesting 1])
    (define what (comment-lexer port))
    (cond
      [(eq? what 'nest) (loop (add1 nesting))]
      [(eq? what 'done) (when (> nesting 1)
                          (loop (sub1 nesting)))]
      [(eof-object? what) (void)]
      [else (loop nesting)])))

;; read characters from a port and return a stream of tokens
(define (read-tokens port)
  (let loop ([tokens '()])
    (define next (honu-lexer port))
    ;; (printf "next ~a\n" next)
    (match next
      [(struct* position-token ([token (? token-eof?)] [start-pos start] [end-pos end]))
       ;; (printf "done lexing\n")
       (reverse tokens)]
      [(struct* position-token ([token (? token-end-of-line-comment?)]
                                 [start-pos start]
                                 [end-pos end]))
       (read-until-end-of-line port)
       (loop tokens)]
       [(struct* position-token ([token (? token-block-comment?)]
                                 [start-pos start]
                                 [end-pos end]))
        (read-block-comment port)
        (loop tokens)]
       [(struct* position-token ([token (? token-whitespace?)] [start-pos start] [end-pos end]))
        (loop tokens)]
       [else (loop (cons next tokens))]
       #;
       [(position-token token start end)
        ;; (printf "next is ~a eof? ~a\n" token (token-eof? token))
        (loop (cons token tokens))])))

;; convert a string to a stream of tokens
(define (lex-string input)
  (read-tokens (open-input-string input)))
{'fraction_non_alphanumeric': 0.16875105627851952, 'fraction_numerical': 0.001521041068108839, 'mean_word_length': 1.7370490286771507, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 46, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '488531', 'n_tokens_mistral': 3700, 'n_tokens_neox': 3432, 'n_words': 825}