<commit_before>;; Serialize module
;;
;; Please don't use this module for production:-)
;; Bytecode will change in future version.
;;
;; $Id: serialize.scm,v 1.7 2006/01/10 13:07:43 tahara Exp $

(define-module kahua.serialize
  (export serialize-string deserialize-string extension-register)
  )

(select-module kahua.serialize)

;;TODO
;;special slot accessor

;; code
(define MARK #\#)
(define STOP #\.)

(define APPLY #\a)
(define CONS #\c)
(define DEFROST #\d)
(define INST #\i)
(define PUT  #\p)
(define GET  #\g)
(define SETCDR #\r)
(define SLOTSET #\s)
(define VECTORSET #\v)

(define BOOL #\B)
(define CHAR #\C)
(define NUMBER #\I)
(define NIL  #\N)
(define PAIR #\P)
(define STRING #\S)
(define VECTOR #\V)
(define SYMBOL #\Y)


;;memorization
(define *memo* (make-hash-table))
(define (memo-initialize) (set! *memo* (make-hash-table)))
(define (memo-append object)
  (let ((length (hash-table-num-entries *memo*)))
    (hash-table-put! *memo* object length)
    length))
(define (memo-exists? object)
  (hash-table-exists? *memo* object))
(define (memo-index object)
  (hash-table-get *memo* object))
(define (memo-put index object)
  (hash-table-put! *memo* index object))
(define (memo-get index)
  (hash-table-get *memo* index))
  

;;extention dispatcher
(define *extension-table* (make-hash-table))
(define (extension-register class dumper loader . args)
  (let-optionals* args ((builder #f))
		  (hash-table-put! *extension-table*
				   class (list dumper builder loader))))
(define (extension-get class) (hash-table-get *extension-table* class))
(define (extension-dumper ext) (car ext))
(define (extension-builder ext) (cadr ext))
(define (extension-loader ext) (caddr ext))
(define (serializable? obj)
  (call/cc (lambda (c)
	     (for-each (lambda (class)
			 (if (is-a? obj class)
			     (c #t)))
		       (hash-table-keys *extension-table*))
	     #f)))

;; serializer
(define (serialize port object)
  (memo-initialize)
  (with-output-to-port port
    (lambda ()
      (%serialize object)
      (display "."))))

(define (%serialize o)
    (cond ((pair? o) (save-pair o))
	  ((number? o) (save-number o))
	  ((symbol? o) (save-symbol o))
	  ((string? o) (save-string o))
	  ((char? o) (save-char o))
	  ((null? o) (save-nil o))
	  ((boolean? o) (save-bool o))
	  ((vector? o) (save-vector o))<commit_msg>replace literal "." to STOP.<commit_after>;; Serialize module
;;
;; Please don't use this module for production:-)
;; Bytecode will change in future version.
;;
;; $Id: serialize.scm,v 1.8 2006/01/10 15:30:43 tahara Exp $

(define-module kahua.serialize
  (export serialize-string deserialize-string extension-register)
  )

(select-module kahua.serialize)

;;TODO
;;special slot accessor

;; code
(define MARK #\#)
(define STOP #\.)

(define APPLY #\a)
(define CONS #\c)
(define DEFROST #\d)
(define INST #\i)
(define PUT  #\p)
(define GET  #\g)
(define SETCDR #\r)
(define SLOTSET #\s)
(define VECTORSET #\v)

(define BOOL #\B)
(define CHAR #\C)
(define NUMBER #\I)
(define NIL  #\N)
(define PAIR #\P)
(define STRING #\S)
(define VECTOR #\V)
(define SYMBOL #\Y)


;;memorization
(define *memo* (make-hash-table))
(define (memo-initialize) (set! *memo* (make-hash-table)))
(define (memo-append object)
  (let ((length (hash-table-num-entries *memo*)))
    (hash-table-put! *memo* object length)
    length))
(define (memo-exists? object)
  (hash-table-exists? *memo* object))
(define (memo-index object)
  (hash-table-get *memo* object))
(define (memo-put index object)
  (hash-table-put! *memo* index object))
(define (memo-get index)
  (hash-table-get *memo* index))
  

;;extention dispatcher
(define *extension-table* (make-hash-table))
(define (extension-register class dumper loader . args)
  (let-optionals* args ((builder #f))
		  (hash-table-put! *extension-table*
				   class (list dumper builder loader))))
(define (extension-get class) (hash-table-get *extension-table* class))
(define (extension-dumper ext) (car ext))
(define (extension-builder ext) (cadr ext))
(define (extension-loader ext) (caddr ext))
(define (serializable? obj)
  (call/cc (lambda (c)
	     (for-each (lambda (class)
			 (if (is-a? obj class)
			     (c #t)))
		       (hash-table-keys *extension-table*))
	     #f)))

;; serializer
(define (serialize port object)
  (memo-initialize)
  (with-output-to-port port
    (lambda ()
      (%serialize object)
      (display STOP))))

(define (%serialize o)
    (cond ((pair? o) (save-pair o))
	  ((number? o) (save-number o))
	  ((symbol? o) (save-symbol o))
	  ((string? o) (save-string o))
	  ((char? o) (save-char o))
	  ((null? o) (save-nil o))
	  ((boolean? o) (save-bool o))
	  ((vector? o) (save-vector o))
{'fraction_non_alphanumeric': 0.18113772455089822, 'fraction_numerical': 0.006843455945252352, 'mean_word_length': 3.8117283950617282, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, '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': '6779754', 'n_tokens_mistral': 1821, 'n_tokens_neox': 1738, 'n_words': 497}