<commit_before>;;; cogen-ctors
;;; definitions that implement constructors
;;; example:
;;; (defdata type-name (nil) (cons car cdr))
;;; defines a datatype with two constructors, the nullary "nil" and
;;; the binary "cons", the selectors of the latter being "car" and "cdr"
(define-syntax defdata
  (lambda (x r c)
    (let ((%begin (r 'begin))
	  (%car (r 'car))
	  (%define (r 'define))
	  (%equal? (r 'equal?))
	  (%if (r 'if))
	  (%list (r 'list))
	  (%list-ref (r 'list-ref)))
    (cons %begin
	  (apply append
	  (map (lambda (ctor-decl)
		 (let* ((ctor-name (car ctor-decl))
			(ctor-test (string->symbol (string-append
						    (symbol->string
						     ctor-name) "?"))))
		 (cons
		  `(,%define
		    ,ctor-decl
		    (,%list ',(car ctor-decl)
			    ,@(cdr ctor-decl)))
		  (cons
		   `(,%define (,ctor-test arg)
			      (,%equal? (,%car arg) ',ctor-name))
		  (let loop ((sels (cdr ctor-decl)) (i 1))
		    (if (null? sels)
			'()
			(cons
			 `(,%define
			   (,(car sels) x)
			   (,%if (,ctor-test x)
				 (,%list-ref x ,i)
				 (error "bad selector ~A applied to ~S" ',(car sels) x)))
			 (loop (cdr sels) (+ i 1)))))))))
	       (cddr x)))))))
;;;
;;;(define-syntax defctor
;;;  (lambda (x r c)
;;;    `(,(r 'define)
;;;      ,(cadr x)
;;;      (,(r 'list) ,@(cddr x))))) 
;;;
;;; define-syntax does not work as a single expression must expand to
;;; another single expression
;;; no there was a format error, furthermore the form (begin <define>
;;; ...) is explicitly allowed for (essential syntax)!

(define (ctors-make-test ctor)
  (string->symbol (string-append (symbol->string ctor) "?")))

(define (ctors-generate-define defconstr-clause)
  (map (lambda (ctor-decl)
	 (cons
	  `(define ,ctor-decl (list ',(car ctor-decl) ,@(cdr ctor-decl)))
	  (let loop ((sels (cdr ctor-decl)) (i 1))
	    (if (null? sels)
		'()
		(cons
		 `(define (,(car sels) x) (list-ref x ,i))
		 (loop (cdr sels) (+ i 1)))))))
       (cdr defconstr-clause))) <commit_msg>defdata -> define-data.<commit_after>;;; cogen-ctors
;;; definitions that implement constructors
;;; example:
;;; (define-data type-name (nil) (cons car cdr))
;;; defines a datatype with two constructors, the nullary "nil" and
;;; the binary "cons", the selectors of the latter being "car" and "cdr"
(define-syntax define-data
  (lambda (x r c)
    (let ((%begin (r 'begin))
	  (%car (r 'car))
	  (%define (r 'define))
	  (%equal? (r 'equal?))
	  (%if (r 'if))
	  (%list (r 'list))
	  (%list-ref (r 'list-ref)))
    (cons %begin
	  (apply append
	  (map (lambda (ctor-decl)
		 (let* ((ctor-name (car ctor-decl))
			(ctor-test (string->symbol (string-append
						    (symbol->string
						     ctor-name) "?"))))
		 (cons
		  `(,%define
		    ,ctor-decl
		    (,%list ',(car ctor-decl)
			    ,@(cdr ctor-decl)))
		  (cons
		   `(,%define (,ctor-test arg)
			      (,%equal? (,%car arg) ',ctor-name))
		  (let loop ((sels (cdr ctor-decl)) (i 1))
		    (if (null? sels)
			'()
			(cons
			 `(,%define
			   (,(car sels) x)
			   (,%if (,ctor-test x)
				 (,%list-ref x ,i)
				 (error "bad selector ~A applied to ~S" ',(car sels) x)))
			 (loop (cdr sels) (+ i 1)))))))))
	       (cddr x)))))))
;;;
;;;(define-syntax defctor
;;;  (lambda (x r c)
;;;    `(,(r 'define)
;;;      ,(cadr x)
;;;      (,(r 'list) ,@(cddr x))))) 
;;;
;;; define-syntax does not work as a single expression must expand to
;;; another single expression
;;; no there was a format error, furthermore the form (begin <define>
;;; ...) is explicitly allowed for (essential syntax)!

(define (ctors-make-test ctor)
  (string->symbol (string-append (symbol->string ctor) "?")))

(define (ctors-generate-define defconstr-clause)
  (map (lambda (ctor-decl)
	 (cons
	  `(define ,ctor-decl (list ',(car ctor-decl) ,@(cdr ctor-decl)))
	  (let loop ((sels (cdr ctor-decl)) (i 1))
	    (if (null? sels)
		'()
		(cons
		 `(define (,(car sels) x) (list-ref x ,i))
		 (loop (cdr sels) (+ i 1)))))))
       (cdr defconstr-clause))) 
{'fraction_non_alphanumeric': 0.21161616161616162, 'fraction_numerical': 0.00202020202020202, 'mean_word_length': 2.9530938123752497, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 14, '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': '178473', 'n_tokens_mistral': 1669, 'n_tokens_neox': 1462, 'n_words': 449}