<commit_before>(import (scheme base)
	(scheme cxr)
	(picrin macro)
	(scheme write))

  ;;; utility functions
(define (reverse* l)
  ;; (reverse* '(a b c d . e)) => (e d c b a)
  (let loop ((a '())
	     (d l))
    (if (pair? d)
	(loop (cons (car d) a) (cdr d))
	(cons d a))))

(define (number->string n)
  ;; fixme
  (case n
    ((0) "0")
    ((1) "1")
    ((2) "2")
    ((3) "3")
    (else "hogee")))

(define (var->sym v)
  (let loop ((cnt 0)
	     (v v))
    (if (symbol? v)
	(string->symbol (string-append (symbol->string v) "/" (number->string cnt)))
	(loop (+ 1 cnt) (car v)))))

(define push-var list)

(define (every? pred l)
  (if (null? l)
      #t
      (and (pred (car l)) (every? pred (cdr l)))))

(define (flatten l)
  (cond
   ((null? l) '())
   ((pair? (car l))
    (append (flatten (car l)) (flatten (cdr l))))
   (else
    (cons (car l) (flatten (cdr l))))))

;;; main function
(define-syntax syntax-rules
  (er-macro-transformer
   (lambda (form r compare)
     (define _define (r 'define))
     (define _let (r 'let))
     (define _if (r 'if))
     (define _begin (r 'begin))
     (define _lambda (r 'lambda))
     (define _set! (r 'set!))
     (define _not (r 'not))
     (define _and (r 'and))
     (define _car (r 'car))
     (define _cdr (r 'cdr))
     (define _cons (r 'cons))
     (define _pair? (r 'pair?))
     (define _null? (r 'null?))
     (define _symbol? (r 'symbol?))
     (define _eqv? (r 'eqv?))
     (define _map (r 'map))
     (define _vector->list (r 'vector->list))
     (define _list->vector (r 'list->vector))
     (define _quote (r 'quote))
     (define _quasiquote (r 'quasiquote))
     (define _unquote (r 'unquote))
     (define _unquote-splicing (r 'unquote-splicing))
     (define _syntax-error (r 'syntax-error))
     (define _call/cc (r 'call/cc))
     (define _er-macro-transformer (r 'er-macro-transformer))

     (define (compile-match ellipsis literals pattern)
       (letrec ((compile-match-base
		 (lambda (pattern)
		   (cond ((compare pattern (r '_)) (values #f '()))
			 ((member pattern literals)
			  (values
			   `(,_if (,_and (,_symbol? expr) (cmp expr (rename ',pattern)))
				  #f
				  (exit #f))
			   '()))
			 ((eq? pattern ellipsis)
			  (values `(,_syntax-error "invalid pattern") '()))
			 ((symbol? pattern)
			  (values `(,_set! ,(var->sym pattern) expr) (list pattern)))
			 ((pair? pattern)
			  (compile-match-list pattern))
			 ((vector? pattern)
			  (compile-match-vector pattern))
			 (else
			  (values
			   `(,_if (,_not (,_eqv? ',pattern expr))
				  (exit #f))
			   '())))))

		(compile-match-list
		 (lambda (pattern)
		   (let loop ((pattern pattern)
			      (matches '())
			      (vars '())
			      (accessor 'expr))
		     (cond ;; (hoge)
		      ((not (pair? (cdr pattern)))
		       (let*-values (((match1 vars1) (compile-match-base (car pattern)))
				     ((match2 vars2) (compile-match-base (cdr pattern))))
			 (values
			  `(,_begin ,@(reverse matches)
				    (,_if (,_pair? ,accessor)
					  (,_begin
					   (,_let ((expr (,_car ,accessor)))
						  ,match1)
					   (,_let ((expr (,_cdr ,accessor)))
						  ,match2))
					  (exit #f)))
			  (append vars (append vars1 vars2)))))
		      ;; (hoge ... rest args)
		      ((eq? (cadr pattern) ellipsis)
		       (let-values (((match-r vars-r) (compile-match-list-reverse pattern)))<commit_msg>fix bug on matching string litral<commit_after>(import (scheme base)
	(scheme cxr)
	(picrin macro)
	(scheme write))

  ;;; utility functions
(define (reverse* l)
  ;; (reverse* '(a b c d . e)) => (e d c b a)
  (let loop ((a '())
	     (d l))
    (if (pair? d)
	(loop (cons (car d) a) (cdr d))
	(cons d a))))

(define (number->string n)
  ;; fixme
  (case n
    ((0) "0")
    ((1) "1")
    ((2) "2")
    ((3) "3")
    (else "hogee")))

(define (var->sym v)
  (let loop ((cnt 0)
	     (v v))
    (if (symbol? v)
	(string->symbol (string-append (symbol->string v) "/" (number->string cnt)))
	(loop (+ 1 cnt) (car v)))))

(define push-var list)

(define (every? pred l)
  (if (null? l)
      #t
      (and (pred (car l)) (every? pred (cdr l)))))

(define (flatten l)
  (cond
   ((null? l) '())
   ((pair? (car l))
    (append (flatten (car l)) (flatten (cdr l))))
   (else
    (cons (car l) (flatten (cdr l))))))

;;; main function
(define-syntax syntax-rules
  (er-macro-transformer
   (lambda (form r compare)
     (define _define (r 'define))
     (define _let (r 'let))
     (define _if (r 'if))
     (define _begin (r 'begin))
     (define _lambda (r 'lambda))
     (define _set! (r 'set!))
     (define _not (r 'not))
     (define _and (r 'and))
     (define _car (r 'car))
     (define _cdr (r 'cdr))
     (define _cons (r 'cons))
     (define _pair? (r 'pair?))
     (define _null? (r 'null?))
     (define _symbol? (r 'symbol?))
     (define _eqv? (r 'eqv?))
     (define _string=? (r 'string=?))
     (define _map (r 'map))
     (define _vector->list (r 'vector->list))
     (define _list->vector (r 'list->vector))
     (define _quote (r 'quote))
     (define _quasiquote (r 'quasiquote))
     (define _unquote (r 'unquote))
     (define _unquote-splicing (r 'unquote-splicing))
     (define _syntax-error (r 'syntax-error))
     (define _call/cc (r 'call/cc))
     (define _er-macro-transformer (r 'er-macro-transformer))

     (define (compile-match ellipsis literals pattern)
       (letrec ((compile-match-base
		 (lambda (pattern)
		   (cond ((compare pattern (r '_)) (values #f '()))
			 ((member pattern literals)
			  (values
			   `(,_if (,_and (,_symbol? expr) (cmp expr (rename ',pattern)))
				  #f
				  (exit #f))
			   '()))
			 ((eq? pattern ellipsis)
			  (values `(,_syntax-error "invalid pattern") '()))
			 ((symbol? pattern)
			  (values `(,_set! ,(var->sym pattern) expr) (list pattern)))
			 ((pair? pattern)
			  (compile-match-list pattern))
			 ((vector? pattern)
			  (compile-match-vector pattern))
			 ((string? pattern)
			  (values
			   `(,_if (,_not (,_string=? ',pattern expr))
				  (exit #f))
			   '()))
			 (else
			  (values
			   `(,_if (,_not (,_eqv? ',pattern expr))
				  (exit #f))
			   '())))))

		(compile-match-list
		 (lambda (pattern)
		   (let loop ((pattern pattern)
			      (matches '())
			      (vars '())
			      (accessor 'expr))
		     (cond ;; (hoge)
		      ((not (pair? (cdr pattern)))
		       (let*-values (((match1 vars1) (compile-match-base (car pattern)))
				     ((match2 vars2) (compile-match-base (cdr pattern))))
			 (values
			  `(,_begin ,@(reverse matches)
				    (,_if (,_pair? ,accessor)
					  (,_begin
					   (,_let ((expr (,_car ,accessor)))
						  ,match1)
					   (,_let ((expr (,_cdr ,accessor)))
						  ,match2))
					  (exit #f)))
			  (append vars (append vars1 vars2)))))
		      ;; (hoge ... rest args)
		      ((eq? (cadr pattern) ellipsis)
		       (let-values (((match-r vars-r) (compile-match-list-reverse pattern)))
{'fraction_non_alphanumeric': 0.19539895165987187, 'fraction_numerical': 0.0052417006406523005, 'mean_word_length': 2.546205472379969, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6238853', 'n_tokens_mistral': 2803, 'n_tokens_neox': 2476, 'n_words': 740}