merge
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 21 Mar 2018 08:34:08 +0000 (09:34 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 21 Mar 2018 08:34:08 +0000 (09:34 +0100)
modules/language/python/module/collections.scm

index c4d5d2a324890b38d841ef28ba65fad2f0bccda0..65c9159104e3e0321b1237d721d738fbe001a23a 100644 (file)
                        (min (py-get self elem 0) count)))
       ((ref self '_keep_positive)))))
 
+(def (namedtuple typename field_names
+                (= verbose #f)
+                (= rename  #f)
+                (= module  None))
+
+     (define-syntax-rule (v x)
+       (let ((xx x))
+        (if verbose
+            (begin
+              (set! verbose xx)
+              xx)
+            xx)))
+     
+     (let ((seen (py-set)))
+       (if (string? field_names)
+          (set! field_names = (string-split field_names #\,)))
+       (set! field_names (py-list (py-map scm-str field_names)))
+       (set! typename (scm-str typename))
+       (if rename
+          (for ((index name : (enumerate field_names))) ()
+               (if (or (not (py-identifier? name))
+                       (iskeyword name)
+                       (py-startswith name "_")
+                       (in name seen))
+                   (py-set! field_names index (format #f "_~a"index)))
+               (py-add seen name)))
+
+       (for ((name : (+ (pylist (list typename)) field_names))) ()
+           (if (not (string? name))
+               (raise TypeError "Type names and field names must be strings"))
+           (if (not (py-isidentifier name))
+               (raise ValueError
+                      (+ "Type names and field names must be valid "
+                         (format #f "identifiers: ~a" name))))
+           (if (iskeyword name)
+               (raise ValueError
+                      (+ "Type names and field names cannot be a "
+                         (format #f "keyword: ~a" name)))))
+       
+       (set! seen (py-set))
+       (for ((name : field_names)) ()
+           (if (and (py-startswith name "_") (not rename))
+               (raise ValueError
+                      (+ "Field names cannot start with an underscore: "
+                         name)))
+           (if (in name seen)
+               (raise ValueError
+                      (+ "Encountered duplicate field name: "
+                         name)))
+           (py-add seen name))
+
+       (set! field_names (map string->symbol (to-list field-names)))
+       
+       (make-p-class (string->symbol typename) (list)
+        (lambda (dict)
+           (py-add! dict '__init__
+                    (eval (v `(lam
+                               (self
+                                ,@(map (lambda (key) `(= ,key #f))
+                                       field_names))
+                           
+                               ,@(map (lambda (key) `(set self ',key ,key))
+                                      field_names))
+                             mod)))
+           
+           (py_add! dict '__getitem__
+                    (lambda (self i)
+                      (if (number? i)
+                          (ref self (list-ref field_names i))
+                          (ref self (scm-sym i)))))
+           
+           (py_add! dict '__setitem__
+                    (lambda (self i val)
+                      (if (number? i)
+                          (set self (list-ref field_names i) val)
+                          (set self (scm-sym i) val))))
+           
+           (if (eq? module None)
+               (set! module (module-name (current-module)))
+               (if (string? (scm-str module))
+                   (set! module
+                         (+ '(language python module)
+                            (map scm-sym
+                                 (string-split module #\.))))))            
+           
+           (py-add! dict '__module__ module)
+
+           (if verbose (pretty-print verbose))))))
+
 (define-python-class UserDict   (dict))
 (define-python-class UserString (pystring))
 (define-python-class UserList   (py-list))