<commit_before>(module parser racket
  (require parser-tools/lex
           parser-tools/yacc
           (prefix-in : parser-tools/lex-sre)
           syntax/readerr
           racket/class
           racket/contract
           racket/format
           "ast-node.rkt"
           "ast-node-expr.rkt"
           "ast-node-stmt.rkt"
           "ast-node-target.rkt")
        
  (provide/contract
   (build-ast (input-port? . -> . (listof (is-a?/c ast-node%))))
   (build-ast-from-file (string? . -> . (listof (is-a?/c ast-node%)))))
  (provide build-ast-from-port
           filter-unready-port
           ready-to-submit?
           colorizer-lexer)

  
  (define (build-ast ip)
    (port-count-lines! ip)
    (let ((get-token (make-lexer)))
      (p (lambda ()
           (get-token ip)))))
  
  (define (build-ast-from-file name)
    (with-input-from-file name
      (lambda ()
        (file-path name)
        (build-ast (current-input-port)))
      #:mode 'text))

  (define (build-ast-from-port port name)
    (file-path name)
    (build-ast port))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define (filter-unready-port in)
    (let loop ([chars (list)])
      (if (and (char-ready? in)
               (not (eof-object? (peek-char in))))
          (loop (cons (read-char in) chars))
          (open-input-string (apply string (reverse chars))))))
  
  (define (collect-tokens port)
    (let ([lexer (make-lexer)])
      (let loop ([collected (list)])
        (let ([token (lexer port)])
          (if (eq? (position-token-token token) 'EOF)
              (reverse collected)
              (loop (cons token collected)))))))
  
  (define (complete-statement? port)
    (let* ([tokens (collect-tokens port)]
           [tokens (for/list ([tok tokens]
                              #:break (and (eq? (position-token-token tok) 'NEWLINE)
                                           (= (position-offset (position-token-start-pos tok))
                                              (position-offset (position-token-end-pos tok)))))
                     tok)])
      (cond
        [(empty? tokens) #t]
        [(eq? (position-token-token (last tokens)) ':) #f]
        [(eq? (position-token-token (last tokens)) '|\|) #f]
        [(let ([indents (for/sum ([tok tokens])
                          (if (eq? (position-token-token tok) 'INDENT) 1 0))]
               [dedents (for/sum ([tok tokens])
                          (if (eq? (position-token-token tok) 'DEDENT) 1 0))])
           (< dedents indents)) #f]
        [else #t])))
         
  (define (ready-to-submit? port whitespace?)
    (and whitespace?
         (complete-statement? (filter-unready-port port))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define build-position-token make-position-token)
  
  (define-lex-abbrevs
   (nu-line (:or (:: #\return #\newline) #\newline))
   (py-blank (:or #\space #\tab #\page))
   (comment (:: #\# (:* (:~ #\return #\newline))))
   (letter (:or (:/ #\A #\Z) (:/ #\a #\z)))
   (digit (:/ #\0 #\9))
   (decimal-integer (:or "0" 
                       (:: (:/ "1" "9") (:* digit))))
   (oct-integer (:: "0" (:+ (:/ "0" "7"))))
   (hex-integer (:: "0" (:or #\x "X") (:+ (:or digit (:/ "A" "F") (:/ "a" "f")))))
   (float (:or point-float exponent-float))
   (point-float (:or (:: (:?  int-part) fraction)
                   (:: int-part ".")))
   (exponent-float (:: (:or int-part point-float) exponent))
   (int-part (:+ digit))
   (fraction (:: "." (:+ digit)))
   (exponent (:: (:or #\e "E") (:?  (:or #\+ #\-)) (:+ digit)))
   (string-literal (:: string-prefix (:or short-string1
                                         short-string2
                                         long-string1
                                         long-string2)))
   (string-prefix (:: (:?  (:or #\u #\U)) (:?  (:or #\r #\R))))
   (short-string1 (:: "'" (:* short-string-item1) "'"))
   (short-string2 (:: #\" (:* short-string-item2) #\"))
   (long-string1 (:: "'''" (:* (:or long-string-item1
                                (:: #\' long-string-item1)
                                (:: "''" long-string-item1)))
                  "'''"))
   (long-string2 (:: "\"\"\"" (:* (:or long-string-item2
                                (:: #\" long-string-item2)
                                (:: "\"\"" long-string-item2)))
                  "\"\"\""))
   (short-string-item1 (:or short-string-char1 escape-seq))
   (short-string-item2 (:or short-string-char2 escape-seq))
   (long-string-item1 (:or long-string-char1 escape-seq))
   (long-string-item2 (:or long-string-char2 escape-seq))
   (short-string-char1 (:~ #\\ #\return #\newline #\'))
   (short-string-char2 (:~ #\\ #\return #\newline #\"))
   (long-string-char1 (:~ #\\ #\'))
   (long-string-char2 (:~ #\\ #\"))
   (escape-seq (:: #\\ (:/ #\000 #\377)))
   (special-keyword (:or "and"      "del"       "for"       "is"        "raise"
                         "assert"    "elif"      "from"      "lambda"    "return"   
                         "break"     "else"      "global"    "not"       "try"      
                         "class"     "except"    "if"        "or"        "while"    
                         "continue"  "exec"      "import"    "pass"      "yield"    
                         "def"       "finally"   "in"        "print"
                         "as" "cpyimport"))
   (binary-operator (:or #\+       #\-       #\*       "**"      #\/       "//"      #\%
                         "<<"      ">>"      #\&       #\|       #\^       #\~
                         #\<       #\>       "<="      ">="      "=="      "!="      "<>"))
   (misc-operator (:or #\, #\; #\. #\`
                       #\:       #\=       "+="      "-="      "*="      "/="      "//="     "%="
                       "|="      "&="      "^="      ">>="     "<<="     "**=")))

  (define (translate-string str sp ep)
    (let-values (((raw? unicode? quote-length)
                  (let ((m (regexp-match "^(u|U)?(r|R)?('''|'|\"\"\"|\")" str)))
                    (values (cadr m) (caddr m) (string-length (cadddr m))))))
      (when unicode?
        (raise-read-error
         "Unicode strings are not supported"
         (file-path)
         (and sp (position-line sp))
         (and sp (position-col sp))
         (and sp (position-offset sp))
         (and sp (- (position-offset ep) (position-offset sp)))))
      (let ((raw-str (substring str
                                (+ (if raw? 1 0) quote-length)
                                (- (string-length str) quote-length))))
        (cond
          (raw? raw-str)
          (else
           (let ((in (open-input-string raw-str))
                 (out (open-output-string)))
             (let loop ()
               (let ((m (regexp-match "\\\\\n|\\\\\\\\|\\\\'|\\\\\"|\\\\0|\\\\a|\\\\b|\\\\f|\\\\n|\\\\r|\\\\t|\\\\v|\\\\[0-3][0-7][0-7]|\\\\x([0-9]|[a-f]|[A-F])([0-9]|[a-f]|[A-F])"
                                      in 0 #f out)))
                 (cond
                   (m (display 
                       (cond
                         ((string=? (~a (car m)) "\\\n") "")
                         ((string=? (~a (car m)) "\\\\") #\\)
                         ((string=? (~a (car m)) "\\'") #\')
                         ((string=? (~a (car m)) "\\\"") #\")
                         ((string=? (~a (car m)) "\\0") #\000)
                         ((string=? (~a (car m)) "\\a") #\007)
                         ((string=? (~a (car m)) "\\b") #\010)
                         ((string=? (~a (car m)) "\\f") #\014)
                         ((string=? (~a (car m)) "\\n") #\012)
                         ((string=? (~a (car m)) "\\r") #\015)
                         ((string=? (~a (car m)) "\\t") #\011)
                         ((string=? (~a (car m)) "\\v") #\013)
                         ((char=? #\x (string-ref (~a (car m)) 1))
                          (integer->char (string->number (substring (~a (car m)) 2 4) 16)))
                         (else
                          (integer->char (string->number (substring (~a (car m)) 1 4) 8))))
                       out)
                      (loop)))))
             (get-output-string out)))))))
    
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define colorizer-lexer
    (lexer
     ;; whitespace
     [(:+ (:or nu-line py-blank)) (color-token 'white-space)]
     ;; comments
     [comment (color-token 'comment)]
     ;; backslash
     [#\\ (color-token 'other)]
     ;; keywords (def, return, if, etc.)
     [special-keyword (color-token 'hash-colon-keyword)]
     [(:or binary-operator misc-operator) (color-token 'other)]
     ;; parenthesis
     [(:or "(" ")" "[" "]" "{" "}") (color-token 'parenthesis (string->symbol lexeme))]
     ;; identifiers
     [(:: (:or letter "_") (:* (:or letter digit "_"))) (color-token 'symbol)]
     ;; string literals
     [string-literal (color-token 'string)]
     ;; number literals
     [(:: (:or decimal-integer oct-integer hex-integer)
          (:? (:or #\l "L")))
      (color-token 'constant)]
     [float (color-token 'constant)]
     [(:: (:or float int-part) (:or #\j "J")) (color-token 'constant)]
     ;; incomplete string literals
     [(:: string-prefix "'" (:* short-string-item1))
      (color-token 'error)]
     [(:: string-prefix #\" (:* short-string-item2))
      (color-token 'error)]
     [(:: string-prefix "'''" (:* (:or long-string-item1
                                       (:: #\' long-string-item1)
                                       (:: "''" long-string-item1))))
      (color-token 'error)]
     [(:: string-prefix "\"\"\"" (:* (:or long-string-item2
                                          (:: #\" long-string-item2)
                                          (:: "\"\"" long-string-item2))))
      (color-token 'error)]
     ;; misc
     [(eof) (values lexeme 'eof #f #f #f)]
     [(special) (color-token 'error)]
     [(special-comment) (color-token 'error)]
     [any-char (color-token 'error)]))
  
  (define-syntax (color-token stx)
    (syntax-case stx ()
      [(_ category)
       #'(color-token category #f)]
      [(_ category paren)
       (with-syntax ([lexeme    (datum->syntax stx 'lexeme)]
                     [start-pos (datum->syntax stx 'start-pos)]
                     [end-pos   (datum->syntax stx 'end-pos)])
         #'(values lexeme category paren (position-offset start-pos) (position-offset end-pos)))]))
     
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
       
  (define (make-lexer)
    (letrec (
             ;; Keep track of indentation levels for INDENT/DEDENT token generation
             (indent-stack '(0))
             
             ;; Keep track of nesting for implicit line joining
             (p-depth 0)
             (sq-depth 0)
             (c-depth 0)
             (reached-eof #f)
             (last-pos #f)
             (OPAREN (lambda () (set! p-depth (add1 p-depth)) '|(|))
             (CPAREN (lambda () (set! p-depth (sub1 p-depth)) '|)|))
             (OBRACKET (lambda () (set! sq-depth (add1 sq-depth)) '|[|))
             (CBRACKET (lambda () (set! sq-depth (sub1 sq-depth)) '|]|))
             (OBRACE (lambda () (set! c-depth (add1 c-depth)) '|{|))
             (CBRACE (lambda () (set! c-depth (sub1 c-depth)) '|}|))
             
             
             ;; true iff the last token returned was NEWLINE
             (line-start #t)

             ;; the number of DEDENT tokens left to return in a multiple DEDENT line start
             (num-dedents 0)

             ;; Read the spaces at the beginning of the line
             ;; lex-whitespace: input-port -> int
             (lex-whitespace
              (lambda (ip)
                (let loop ((num 0)
                           (count 0))
                  (let ((char (peek-char-or-special ip num)))
                    (cond
                      ((eof-object? char)
                       (read-string num ip)
                       0)
                      ((eq? char #\tab)
                       (loop (add1 num) (+ count 8 (- (modulo count 8)))))
                      ((eq? char #\space)
                       (loop (add1 num) (add1 count)))
                      (else
                       (read-string num ip)
                       count))))))

;             ;; Skips the rest of the line
;             ;; skip-line: input-port -> void
;             [skip-line
;              (lambda (port)
;                (let loop ([char (read-char-or-special port)])
;                  (unless (or (eof-object? char)
;                              (eq? char #\newline))
;                    (loop (read-char-or-special port)))))]
             
             
             ;; The actual lexer
             ;; lex-token: input-port -> token
             (lex-token
              (lexer-src-pos

               ;; 2.1.5, 2.1.6
               ((:: nu-line (:* (:: (:* py-blank) (:?  comment) nu-line)))
                (cond
                  ((and (= 0 p-depth) (= 0 sq-depth) (= 0 c-depth))
                   (set! line-start #t)
                   (set! last-pos end-pos)
                   'NEWLINE)
                  (else
                   (return-without-pos (lex-token input-port)))))
               ;; 2.1.3
               (comment (return-without-pos (lex-token input-port)))
               ;; 2.1.4
               ((:: #\\ (:* py-blank) nu-line) (return-without-pos (lex-token input-port)))
               ;; 2.1.8
               ((:+ py-blank) (return-without-pos (lex-token input-port)))
               
               ;;2.3.1
               (special-keyword
                (string->symbol lexeme))
               ;; 2.3
               ((:: (:or letter "_") (:* (:or letter digit "_")))
                (token-NAME lexeme))
               
               
               ;; 2.4.1
               (string-literal (token-STRING (translate-string lexeme start-pos end-pos)))
               
               ;; 2.4.4
               (decimal-integer
                (token-NUMBER (cons 'int (string->number lexeme))))
               (oct-integer
                (token-NUMBER (cons 'int (string->number lexeme 8))))
               (hex-integer
                (token-NUMBER (cons 'int (string->number (substring lexeme 2 (string-length lexeme)) 16))))
               ((:: decimal-integer (:or #\l "L"))
                (token-NUMBER 
                 (cons 'long (string->number (substring lexeme 0 (sub1 (string-length lexeme)))))))
               ((:: oct-integer (:or #\l "L"))
                (token-NUMBER 
                 (cons 'long (string->number (substring lexeme 0 (sub1 (string-length lexeme))) 8))))
               ((:: hex-integer (:or #\l "L"))
                (token-NUMBER
                 (cons 'long (string->number (substring lexeme 2 (sub1 (string-length lexeme))) 16))))
               ;; 2.4.5
               (float
                (token-NUMBER (cons 'float (string->number lexeme))))
               
               ;; 2.4.6
               ((:: (:or float int-part) (:or #\j "J"))
                (token-NUMBER (cons 'complex (* +i (string->number (substring lexeme 0 (sub1 (string-length lexeme))))))))
               
               ;; 2.5
               (binary-operator
                (if (string=? "|" lexeme)
                    '\|
                    (string->symbol lexeme)))
               
               ;; 2.6
               ("(" (OPAREN))
               (")" (CPAREN))
               ("[" (OBRACKET))
               ("]" (CBRACKET))
               ("{" (OBRACE))
               ("}" (CBRACE))
               ((:or misc-operator #\\)
                (string->symbol lexeme))
               
               ;; ignore special objects such as images
               [(special) (return-without-pos (lex-token input-port))]

               ((eof)
                (cond
                  (reached-eof 'EOF)
                  (else
                   (set! reached-eof #t)
                   (set! line-start #t)
                   (set! last-pos end-pos)
                   'NEWLINE)))))
                 
             ;; Return the number of entries in l before n is reached and set the stack to
             ;; be the rest of l (after n)
             ;;count-dedent: int * int list -> int
             (count-dedent
              (lambda (n l)
                (cond
                  ((null? l) #f)
                  ((= n (car l)) 
                   (set! indent-stack l)
                   0)
                  ((< (car l) n)
                   (raise-read-error
                    "unmatching indentation"
                    (file-path)
                    (and last-pos (position-line last-pos))
                    (and last-pos (position-col last-pos))
                    (and last-pos (position-offset last-pos))
                    n))
                  (else
                   (add1 (count-dedent n (cdr l)))))))
             ;; get-token: input-port -> token
             (get-token
              (lambda (ip)
                (cond
                  ;; There are still DEDENTS to do
                  ((> num-dedents 0) 
                   (set! num-dedents (sub1 num-dedents))
;                   (printf "PARSER: there are still DEDENTS to do~n")
                   (build-position-token 'DEDENT last-pos last-pos))
                  ;; We are at the start of a line
                  (line-start
                   (let ((indent-num (lex-whitespace ip)))
                     (cond
                       ;; Same indentation level as last line, find the first token on the line
                       ((= indent-num (car indent-stack))
                        (set! line-start #f)
;                        (printf "PARSER: same indentation level as last line~n")
                        (get-token ip))
                       ;; indented from last line
                       ((> indent-num (car indent-stack))
                        (set! line-start #f)
                        (set! indent-stack (cons indent-num indent-stack))
;                        (printf "PARSER: indented from last line~n")
                        (build-position-token 'INDENT last-pos last-pos))
                       (else
                        (set! line-start #f)
;                        (printf "PARSER: else~n")
                        (set! num-dedents (sub1 (count-dedent indent-num indent-stack)))
                        (build-position-token 'DEDENT last-pos last-pos)))))
                  (else
                   (lex-token ip))))))
      get-token))
  
  
  (define (err token-ok token-name token-value src-start src-end)
    (raise-read-error
     (if token-ok
         (format "parse error with token: ~a, value: ~a" token-name token-value)
         (format "unrecognized token: ~a, value: ~a" token-name token-value))
     (file-path)
     (position-line src-start)
     (position-col src-start)
     (position-offset src-start)
     (- (position-offset src-end) (position-offset src-start))))

  (define (is-subscription? x)
    (and (not (list? x)) (not (eq? '... x))))

  (define (is-simple-slice? x)
    (and (list? x) (= 2 (length x))))<commit_msg>User-friendly messages for syntax errors.<commit_after>(module parser racket
  (require parser-tools/lex
           parser-tools/yacc
           (prefix-in : parser-tools/lex-sre)
           syntax/readerr
           racket/class
           racket/contract
           racket/format
           "ast-node.rkt"
           "ast-node-expr.rkt"
           "ast-node-stmt.rkt"
           "ast-node-target.rkt")
        
  (provide/contract
   (build-ast (input-port? . -> . (listof (is-a?/c ast-node%))))
   (build-ast-from-file (string? . -> . (listof (is-a?/c ast-node%)))))
  (provide build-ast-from-port
           filter-unready-port
           ready-to-submit?
           colorizer-lexer)

  
  (define (build-ast ip)
    (port-count-lines! ip)
    (let ((get-token (make-lexer)))
      (p (lambda ()
           (get-token ip)))))
  
  (define (build-ast-from-file name)
    (with-input-from-file name
      (lambda ()
        (file-path name)
        (build-ast (current-input-port)))
      #:mode 'text))

  (define (build-ast-from-port port name)
    (file-path name)
    (build-ast port))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define (filter-unready-port in)
    (let loop ([chars (list)])
      (if (and (char-ready? in)
               (not (eof-object? (peek-char in))))
          (loop (cons (read-char in) chars))
          (open-input-string (apply string (reverse chars))))))
  
  (define (collect-tokens port)
    (let ([lexer (make-lexer)])
      (let loop ([collected (list)])
        (let ([token (lexer port)])
          (if (eq? (position-token-token token) 'EOF)
              (reverse collected)
              (loop (cons token collected)))))))
  
  (define (complete-statement? port)
    (let* ([tokens (collect-tokens port)]
           [tokens (for/list ([tok tokens]
                              #:break (and (eq? (position-token-token tok) 'NEWLINE)
                                           (= (position-offset (position-token-start-pos tok))
                                              (position-offset (position-token-end-pos tok)))))
                     tok)])
      (cond
        [(empty? tokens) #t]
        [(eq? (position-token-token (last tokens)) ':) #f]
        [(eq? (position-token-token (last tokens)) '|\|) #f]
        [(let ([indents (for/sum ([tok tokens])
                          (if (eq? (position-token-token tok) 'INDENT) 1 0))]
               [dedents (for/sum ([tok tokens])
                          (if (eq? (position-token-token tok) 'DEDENT) 1 0))])
           (< dedents indents)) #f]
        [else #t])))
         
  (define (ready-to-submit? port whitespace?)
    (and whitespace?
         (complete-statement? (filter-unready-port port))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define build-position-token make-position-token)
  
  (define-lex-abbrevs
   (nu-line (:or (:: #\return #\newline) #\newline))
   (py-blank (:or #\space #\tab #\page))
   (comment (:: #\# (:* (:~ #\return #\newline))))
   (letter (:or (:/ #\A #\Z) (:/ #\a #\z)))
   (digit (:/ #\0 #\9))
   (decimal-integer (:or "0" 
                       (:: (:/ "1" "9") (:* digit))))
   (oct-integer (:: "0" (:+ (:/ "0" "7"))))
   (hex-integer (:: "0" (:or #\x "X") (:+ (:or digit (:/ "A" "F") (:/ "a" "f")))))
   (float (:or point-float exponent-float))
   (point-float (:or (:: (:?  int-part) fraction)
                   (:: int-part ".")))
   (exponent-float (:: (:or int-part point-float) exponent))
   (int-part (:+ digit))
   (fraction (:: "." (:+ digit)))
   (exponent (:: (:or #\e "E") (:?  (:or #\+ #\-)) (:+ digit)))
   (string-literal (:: string-prefix (:or short-string1
                                         short-string2
                                         long-string1
                                         long-string2)))
   (string-prefix (:: (:?  (:or #\u #\U)) (:?  (:or #\r #\R))))
   (short-string1 (:: "'" (:* short-string-item1) "'"))
   (short-string2 (:: #\" (:* short-string-item2) #\"))
   (long-string1 (:: "'''" (:* (:or long-string-item1
                                (:: #\' long-string-item1)
                                (:: "''" long-string-item1)))
                  "'''"))
   (long-string2 (:: "\"\"\"" (:* (:or long-string-item2
                                (:: #\" long-string-item2)
                                (:: "\"\"" long-string-item2)))
                  "\"\"\""))
   (short-string-item1 (:or short-string-char1 escape-seq))
   (short-string-item2 (:or short-string-char2 escape-seq))
   (long-string-item1 (:or long-string-char1 escape-seq))
   (long-string-item2 (:or long-string-char2 escape-seq))
   (short-string-char1 (:~ #\\ #\return #\newline #\'))
   (short-string-char2 (:~ #\\ #\return #\newline #\"))
   (long-string-char1 (:~ #\\ #\'))
   (long-string-char2 (:~ #\\ #\"))
   (escape-seq (:: #\\ (:/ #\000 #\377)))
   (special-keyword (:or "and"      "del"       "for"       "is"        "raise"
                         "assert"    "elif"      "from"      "lambda"    "return"   
                         "break"     "else"      "global"    "not"       "try"      
                         "class"     "except"    "if"        "or"        "while"    
                         "continue"  "exec"      "import"    "pass"      "yield"    
                         "def"       "finally"   "in"        "print"
                         "as" "cpyimport"))
   (binary-operator (:or #\+       #\-       #\*       "**"      #\/       "//"      #\%
                         "<<"      ">>"      #\&       #\|       #\^       #\~
                         #\<       #\>       "<="      ">="      "=="      "!="      "<>"))
   (misc-operator (:or #\, #\; #\. #\`
                       #\:       #\=       "+="      "-="      "*="      "/="      "//="     "%="
                       "|="      "&="      "^="      ">>="     "<<="     "**=")))

  (define (translate-string str sp ep)
    (let-values (((raw? unicode? quote-length)
                  (let ((m (regexp-match "^(u|U)?(r|R)?('''|'|\"\"\"|\")" str)))
                    (values (cadr m) (caddr m) (string-length (cadddr m))))))
      (when unicode?
        (raise-read-error
         "Unicode strings are not supported"
         (file-path)
         (and sp (position-line sp))
         (and sp (position-col sp))
         (and sp (position-offset sp))
         (and sp (- (position-offset ep) (position-offset sp)))))
      (let ((raw-str (substring str
                                (+ (if raw? 1 0) quote-length)
                                (- (string-length str) quote-length))))
        (cond
          (raw? raw-str)
          (else
           (let ((in (open-input-string raw-str))
                 (out (open-output-string)))
             (let loop ()
               (let ((m (regexp-match "\\\\\n|\\\\\\\\|\\\\'|\\\\\"|\\\\0|\\\\a|\\\\b|\\\\f|\\\\n|\\\\r|\\\\t|\\\\v|\\\\[0-3][0-7][0-7]|\\\\x([0-9]|[a-f]|[A-F])([0-9]|[a-f]|[A-F])"
                                      in 0 #f out)))
                 (cond
                   (m (display 
                       (cond
                         ((string=? (~a (car m)) "\\\n") "")
                         ((string=? (~a (car m)) "\\\\") #\\)
                         ((string=? (~a (car m)) "\\'") #\')
                         ((string=? (~a (car m)) "\\\"") #\")
                         ((string=? (~a (car m)) "\\0") #\000)
                         ((string=? (~a (car m)) "\\a") #\007)
                         ((string=? (~a (car m)) "\\b") #\010)
                         ((string=? (~a (car m)) "\\f") #\014)
                         ((string=? (~a (car m)) "\\n") #\012)
                         ((string=? (~a (car m)) "\\r") #\015)
                         ((string=? (~a (car m)) "\\t") #\011)
                         ((string=? (~a (car m)) "\\v") #\013)
                         ((char=? #\x (string-ref (~a (car m)) 1))
                          (integer->char (string->number (substring (~a (car m)) 2 4) 16)))
                         (else
                          (integer->char (string->number (substring (~a (car m)) 1 4) 8))))
                       out)
                      (loop)))))
             (get-output-string out)))))))
    
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define colorizer-lexer
    (lexer
     ;; whitespace
     [(:+ (:or nu-line py-blank)) (color-token 'white-space)]
     ;; comments
     [comment (color-token 'comment)]
     ;; backslash
     [#\\ (color-token 'other)]
     ;; keywords (def, return, if, etc.)
     [special-keyword (color-token 'hash-colon-keyword)]
     [(:or binary-operator misc-operator) (color-token 'other)]
     ;; parenthesis
     [(:or "(" ")" "[" "]" "{" "}") (color-token 'parenthesis (string->symbol lexeme))]
     ;; identifiers
     [(:: (:or letter "_") (:* (:or letter digit "_"))) (color-token 'symbol)]
     ;; string literals
     [string-literal (color-token 'string)]
     ;; number literals
     [(:: (:or decimal-integer oct-integer hex-integer)
          (:? (:or #\l "L")))
      (color-token 'constant)]
     [float (color-token 'constant)]
     [(:: (:or float int-part) (:or #\j "J")) (color-token 'constant)]
     ;; incomplete string literals
     [(:: string-prefix "'" (:* short-string-item1))
      (color-token 'error)]
     [(:: string-prefix #\" (:* short-string-item2))
      (color-token 'error)]
     [(:: string-prefix "'''" (:* (:or long-string-item1
                                       (:: #\' long-string-item1)
                                       (:: "''" long-string-item1))))
      (color-token 'error)]
     [(:: string-prefix "\"\"\"" (:* (:or long-string-item2
                                          (:: #\" long-string-item2)
                                          (:: "\"\"" long-string-item2))))
      (color-token 'error)]
     ;; misc
     [(eof) (values lexeme 'eof #f #f #f)]
     [(special) (color-token 'error)]
     [(special-comment) (color-token 'error)]
     [any-char (color-token 'error)]))
  
  (define-syntax (color-token stx)
    (syntax-case stx ()
      [(_ category)
       #'(color-token category #f)]
      [(_ category paren)
       (with-syntax ([lexeme    (datum->syntax stx 'lexeme)]
                     [start-pos (datum->syntax stx 'start-pos)]
                     [end-pos   (datum->syntax stx 'end-pos)])
         #'(values lexeme category paren (position-offset start-pos) (position-offset end-pos)))]))
     
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
       
  (define (make-lexer)
    (letrec (
             ;; Keep track of indentation levels for INDENT/DEDENT token generation
             (indent-stack '(0))
             
             ;; Keep track of nesting for implicit line joining
             (p-depth 0)
             (sq-depth 0)
             (c-depth 0)
             (reached-eof #f)
             (last-pos #f)
             (OPAREN (lambda () (set! p-depth (add1 p-depth)) '|(|))
             (CPAREN (lambda () (set! p-depth (sub1 p-depth)) '|)|))
             (OBRACKET (lambda () (set! sq-depth (add1 sq-depth)) '|[|))
             (CBRACKET (lambda () (set! sq-depth (sub1 sq-depth)) '|]|))
             (OBRACE (lambda () (set! c-depth (add1 c-depth)) '|{|))
             (CBRACE (lambda () (set! c-depth (sub1 c-depth)) '|}|))
             
             
             ;; true iff the last token returned was NEWLINE
             (line-start #t)

             ;; the number of DEDENT tokens left to return in a multiple DEDENT line start
             (num-dedents 0)

             ;; Read the spaces at the beginning of the line
             ;; lex-whitespace: input-port -> int
             (lex-whitespace
              (lambda (ip)
                (let loop ((num 0)
                           (count 0))
                  (let ((char (peek-char-or-special ip num)))
                    (cond
                      ((eof-object? char)
                       (read-string num ip)
                       0)
                      ((eq? char #\tab)
                       (loop (add1 num) (+ count 8 (- (modulo count 8)))))
                      ((eq? char #\space)
                       (loop (add1 num) (add1 count)))
                      (else
                       (read-string num ip)
                       count))))))

;             ;; Skips the rest of the line
;             ;; skip-line: input-port -> void
;             [skip-line
;              (lambda (port)
;                (let loop ([char (read-char-or-special port)])
;                  (unless (or (eof-object? char)
;                              (eq? char #\newline))
;                    (loop (read-char-or-special port)))))]
             
             
             ;; The actual lexer
             ;; lex-token: input-port -> token
             (lex-token
              (lexer-src-pos

               ;; 2.1.5, 2.1.6
               ((:: nu-line (:* (:: (:* py-blank) (:?  comment) nu-line)))
                (cond
                  ((and (= 0 p-depth) (= 0 sq-depth) (= 0 c-depth))
                   (set! line-start #t)
                   (set! last-pos end-pos)
                   'NEWLINE)
                  (else
                   (return-without-pos (lex-token input-port)))))
               ;; 2.1.3
               (comment (return-without-pos (lex-token input-port)))
               ;; 2.1.4
               ((:: #\\ (:* py-blank) nu-line) (return-without-pos (lex-token input-port)))
               ;; 2.1.8
               ((:+ py-blank) (return-without-pos (lex-token input-port)))
               
               ;;2.3.1
               (special-keyword
                (string->symbol lexeme))
               ;; 2.3
               ((:: (:or letter "_") (:* (:or letter digit "_")))
                (token-NAME lexeme))
               
               
               ;; 2.4.1
               (string-literal (token-STRING (translate-string lexeme start-pos end-pos)))
               
               ;; 2.4.4
               (decimal-integer
                (token-NUMBER (cons 'int (string->number lexeme))))
               (oct-integer
                (token-NUMBER (cons 'int (string->number lexeme 8))))
               (hex-integer
                (token-NUMBER (cons 'int (string->number (substring lexeme 2 (string-length lexeme)) 16))))
               ((:: decimal-integer (:or #\l "L"))
                (token-NUMBER 
                 (cons 'long (string->number (substring lexeme 0 (sub1 (string-length lexeme)))))))
               ((:: oct-integer (:or #\l "L"))
                (token-NUMBER 
                 (cons 'long (string->number (substring lexeme 0 (sub1 (string-length lexeme))) 8))))
               ((:: hex-integer (:or #\l "L"))
                (token-NUMBER
                 (cons 'long (string->number (substring lexeme 2 (sub1 (string-length lexeme))) 16))))
               ;; 2.4.5
               (float
                (token-NUMBER (cons 'float (string->number lexeme))))
               
               ;; 2.4.6
               ((:: (:or float int-part) (:or #\j "J"))
                (token-NUMBER (cons 'complex (* +i (string->number (substring lexeme 0 (sub1 (string-length lexeme))))))))
               
               ;; 2.5
               (binary-operator
                (if (string=? "|" lexeme)
                    '\|
                    (string->symbol lexeme)))
               
               ;; 2.6
               ("(" (OPAREN))
               (")" (CPAREN))
               ("[" (OBRACKET))
               ("]" (CBRACKET))
               ("{" (OBRACE))
               ("}" (CBRACE))
               ((:or misc-operator #\\)
                (string->symbol lexeme))
               
               ;; ignore special objects such as images
               [(special) (return-without-pos (lex-token input-port))]

               [(eof)
                (cond
                  (reached-eof 'EOF)
                  (else
                   (set! reached-eof #t)
                   (set! line-start #t)
                   (set! last-pos end-pos)
                   'NEWLINE))]
               
               [any-char
                (raise-read-error
                 (format "invalid character '~a'" lexeme)
                 (file-path)
                 (position-line start-pos)
                 (position-col start-pos)
                 (position-offset start-pos)
                 (- (position-offset end-pos) (position-offset start-pos)))]))
                 
             ;; Return the number of entries in l before n is reached and set the stack to
             ;; be the rest of l (after n)
             ;;count-dedent: int * int list -> int
             (count-dedent
              (lambda (n l)
                (cond
                  ((null? l) #f)
                  ((= n (car l)) 
                   (set! indent-stack l)
                   0)
                  ((< (car l) n)
                   (raise-read-error
                    "unmatching indentation"
                    (file-path)
                    (and last-pos (position-line last-pos))
                    (and last-pos (position-col last-pos))
                    (and last-pos (position-offset last-pos))
                    n))
                  (else
                   (add1 (count-dedent n (cdr l)))))))
             ;; get-token: input-port -> token
             (get-token
              (lambda (ip)
                (cond
                  ;; There are still DEDENTS to do
                  ((> num-dedents 0) 
                   (set! num-dedents (sub1 num-dedents))
;                   (printf "PARSER: there are still DEDENTS to do~n")
                   (build-position-token 'DEDENT last-pos last-pos))
                  ;; We are at the start of a line
                  (line-start
                   (let ((indent-num (lex-whitespace ip)))
                     (cond
                       ;; Same indentation level as last line, find the first token on the line
                       ((= indent-num (car indent-stack))
                        (set! line-start #f)
;                        (printf "PARSER: same indentation level as last line~n")
                        (get-token ip))
                       ;; indented from last line
                       ((> indent-num (car indent-stack))
                        (set! line-start #f)
                        (set! indent-stack (cons indent-num indent-stack))
;                        (printf "PARSER: indented from last line~n")
                        (build-position-token 'INDENT last-pos last-pos))
                       (else
                        (set! line-start #f)
;                        (printf "PARSER: else~n")
                        (set! num-dedents (sub1 (count-dedent indent-num indent-stack)))
                        (build-position-token 'DEDENT last-pos last-pos)))))
                  (else
                   (lex-token ip))))))
      get-token))
  
  
  (define (err token-ok token-name token-value src-start src-end)
    (raise-read-error
     (if token-ok
         (format "invalid or incomplete syntax")
         (format "unrecognized token ~a (value: ~a)" token-name token-value))
     (file-path)
     (position-line src-start)
     (position-col src-start)
     (position-offset src-start)
     (- (position-offset src-end) (position-offset src-start))))

  (define (is-subscription? x)
    (and (not (list? x)) (not (eq? '... x))))

  (define (is-simple-slice? x)
    (and (list? x) (= 2 (length x))))
{'fraction_non_alphanumeric': 0.18469390398714994, 'fraction_numerical': 0.009378481307805902, 'mean_word_length': 1.2511226453607045, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 73, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 68, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1913783', 'n_tokens_mistral': 12268, 'n_tokens_neox': 11264, 'n_words': 2628}