Mistivia 4 місяців тому
батько
коміт
7870c8f6e6
2 змінених файлів з 85 додано та 85 видалено
  1. 8 8
      README.md
  2. 77 77
      trait.scm

+ 8 - 8
README.md

@@ -5,8 +5,8 @@ A trait/typeclass system for Scheme.
 ## Example
 
     (import trait)
-	
-	(define-record point x y)
+    
+    (define-record point x y)
     
     (define-trait Eq
       ;; fallback to equal? by default
@@ -17,15 +17,15 @@ A trait/typeclass system for Scheme.
     
     (define-trait-impl (Eq symbol?)
       (same? eq?))
-	
-	(define-trait-impl (Eq point?)
-	  (same? (lambda (a b) (and (point? b)
-	                            (= (point-x a) (point-x b))
-	                            (= (point-y a) (point-y b))))))
+    
+    (define-trait-impl (Eq point?)
+      (same? (lambda (a b) (and (point? b)
+                                (= (point-x a) (point-x b))
+                                (= (point-y a) (point-y b))))))
     
     (display (list (same? 'a 'a)
                    (same? 1 1)
                    (same? 1 2)
                    (same? (list 1 2) (list 1 2))
                    (same? (cons 3 4) (cons 3 4))
-				   (same? (make-point 1 2) (make-point 3 4))))
+                   (same? (make-point 1 2) (make-point 3 4))))

+ 77 - 77
trait.scm

@@ -1,32 +1,32 @@
 (module trait (trait?
-	       define-trait
-	       define-trait-impl
-	       with-type
-	       with-type-of
-	       ;; functions below are supposed to be used only in
-	       ;; code generated by macros
-	       __create_trait
-	       __trait-get-func
-	       __trait-reg-func
-	       __trait-select-func
-	       __trait-select-func-of		   
-	       __trait-reg-func-to-cls)
+               define-trait
+               define-trait-impl
+               with-type
+               with-type-of
+               ;; functions below are supposed to be used only in
+               ;; code generated by macros
+               __create_trait
+               __trait-get-func
+               __trait-reg-func
+               __trait-select-func
+               __trait-select-func-of
+               __trait-reg-func-to-cls)
   (import scheme
-	  (chicken base)
-	  (chicken syntax)
-	  srfi-69)
+          (chicken base)
+          (chicken syntax)
+          srfi-69)
 
   (define-syntax define-macro
     (er-macro-transformer
      (lambda (exp r c)
        (let ((def (cadr exp))
-  	   (body (cddr exp)))
+             (body (cddr exp)))
          `(define-syntax ,(car def)
-  	  (er-macro-transformer
-  	   (lambda (e2 r2 c2)
-  	     (define (transform-func ,@(cdr def))
-  	       ,@body)
-  	     (apply transform-func (cdr e2)))))))))
+            (er-macro-transformer
+             (lambda (e2 r2 c2)
+               (define (transform-func ,@(cdr def))
+                 ,@body)
+               (apply transform-func (cdr e2)))))))))
   ;; body
   (define-record trait name func-names func-table)
   
@@ -38,40 +38,40 @@
   (define (__trait-select-func pred func name)
     (define cls (hash-table-ref func-to-class-table func))
     (define func-list (hash-table-ref (trait-func-table cls)
-				      name))
+                                      name))
     (define (find-in lst)
       (if (null? lst)
-	  '()
-	  (if (or (eq? pred (caar lst))
-		  (null? (caar lst)))
-	      (cdar lst)
-	      (find-in (cdr lst)))))
+          '()
+          (if (or (eq? pred (caar lst))
+                  (null? (caar lst)))
+              (cdar lst)
+              (find-in (cdr lst)))))
     (find-in func-list))
   
   (define (__create_trait name func-names default-funcs)
     (let ((table (make-hash-table)))
       (define cls (make-trait name func-names table))
       (define (init-table func-names)
-	(if (null? func-names)
-	    '()
-	    (let ()
-  	      (hash-table-set! (trait-func-table cls)
-  			       (car func-names)
-  			       '())
-	      (init-table (cdr func-names)))))
+        (if (null? func-names)
+            '()
+            (let ()
+              (hash-table-set! (trait-func-table cls)
+                               (car func-names)
+                               '())
+              (init-table (cdr func-names)))))
       (init-table func-names)
       cls))
 
   (define (__trait-get-func cls func-sym obj)
     (define func-list (hash-table-ref (trait-func-table cls)
-				      func-sym))
+                                      func-sym))
     (define (find-in lst)
       (if (null? lst)
-	  '()
-	  (if (or (null? (caar lst))
-		  ((caar lst) obj))
-	      (cdar lst)
-	      (find-in (cdr lst)))))
+          '()
+          (if (or (null? (caar lst))
+                  ((caar lst) obj))
+              (cdar lst)
+              (find-in (cdr lst)))))
     (find-in func-list))
 
   (define (__trait-select-func-of obj func name)
@@ -81,40 +81,40 @@
   (define (__trait-reg-func cls func-sym pred func)
     (define func-table (trait-func-table cls))
     (hash-table-set! func-table
-		     func-sym
-		     (cons (cons pred func)
-			   (hash-table-ref func-table func-sym))))
+                     func-sym
+                     (cons (cons pred func)
+                           (hash-table-ref func-table func-sym))))
   
   (define-macro (define-trait name . body)
     (let ()
       (define (func-def-tr entry)
-	(define args (gensym))
-	`(begin
-	   (define (,(car entry) . ,args)
-	     (apply (__trait-get-func ,name
-	  			      (quote ,(car entry))
-	  			      (car ,args))
-	  	    ,args))
-	   (__trait-reg-func-to-cls ,(car entry) ,name)))
+        (define args (gensym))
+        `(begin
+           (define (,(car entry) . ,args)
+             (apply (__trait-get-func ,name
+                                      (quote ,(car entry))
+                                      (car ,args))
+                    ,args))
+           (__trait-reg-func-to-cls ,(car entry) ,name)))
       (define (default-func-register-tr entry)
-	`(__trait-reg-func ,name
-			   (quote ,(car entry))
-			   '()
-			   ,(if (null? (cdr entry))
-				'(quote ())
-				(cadr entry))))
+        `(__trait-reg-func ,name
+                           (quote ,(car entry))
+                           '()
+                           ,(if (null? (cdr entry))
+                                '(quote ())
+                                (cadr entry))))
       (define (define-trait-tr name . body)
-	`(begin
-	   (define ,name
-	     (__create_trait (quote ,name)
-			     (quote ,(map car body))
-			     (quote ,(map (lambda (x)
-					    (if (null? (cdr x))
-						'()
-						(cadr x)))
-					  body))))
-	   ,@(map func-def-tr body)
-	   ,@(map default-func-register-tr body)))
+        `(begin
+           (define ,name
+             (__create_trait (quote ,name)
+                             (quote ,(map car body))
+                             (quote ,(map (lambda (x)
+                                            (if (null? (cdr x))
+                                                '()
+                                                (cadr x)))
+                                          body))))
+           ,@(map func-def-tr body)
+           ,@(map default-func-register-tr body)))
       (define form (apply define-trait-tr (cons name body)))
       ;; (display form) (newline)
       form))
@@ -122,15 +122,15 @@
   (define-macro (define-trait-impl name . body)
     (let ()
       (define (define-trait-impl-tr name . body)
-	(define cls (car name))
-	(define pred (cadr name))
-	(define (reg-func-tr entry)
-	  `(__trait-reg-func ,cls
-			     (quote ,(car entry))
-			     ,pred
-			     ,(cadr entry)))
-	`(begin
-	   ,@(map reg-func-tr body)))
+        (define cls (car name))
+        (define pred (cadr name))
+        (define (reg-func-tr entry)
+          `(__trait-reg-func ,cls
+                             (quote ,(car entry))
+                             ,pred
+                             ,(cadr entry)))
+        `(begin
+           ,@(map reg-func-tr body)))
       (define form (apply define-trait-impl-tr (cons name body)))
       ;; (display form) (newline)
       form))