From 16e97e4e005ebd1d3270d8c84f8e04667a8733ed Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Wed, 21 Mar 2018 09:34:08 +0100
Subject: merge

---
 modules/language/python/module/collections.scm | 89 ++++++++++++++++++++++++++
 1 file changed, 89 insertions(+)

(limited to 'modules/language/python/module')

diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm
index c4d5d2a..65c9159 100644
--- a/modules/language/python/module/collections.scm
+++ b/modules/language/python/module/collections.scm
@@ -565,6 +565,95 @@
 			(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))  
-- 
cgit v1.2.3