summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/for.scm4
-rw-r--r--modules/language/python/list.scm45
-rw-r--r--modules/language/python/module/collections.scm17
-rw-r--r--modules/language/python/module/heapq.scm236
-rw-r--r--modules/language/python/module/python.scm32
-rw-r--r--modules/language/python/try.scm13
6 files changed, 306 insertions, 41 deletions
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index 8db5aa7..4541df2 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -77,7 +77,9 @@
(set! x x1)
... ...
(call-with-values
- #,(wrap-continue #'lp #'(code ...))
+ #,(wrap-continue
+ #'lp
+ #'((let ((x x) ... ...) code ...)))
(lambda (cc ... . q) (llp cc ...)))))
(lambda q fin))))))))))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 0cbd30a..b101da7 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -11,7 +11,7 @@
#:use-module (language python try)
#:use-module (language python exceptions)
#:use-module (language python persist)
- #:export (to-list to-pylist <py-list>
+ #:export (to-list to-pylist <py-list> py-list
pylist-append!
pylist-slice pylist-subset! pylist-reverse!
pylist-pop! pylist-count pylist-extend! len in
@@ -252,9 +252,7 @@
(vec (slot-ref o 'vec))
(N (vector-length vec)))
(if (< n N)
- (begin
- (vector-set! vec n val)
- (slot-set! o 'n (+ n 1)))
+ (vector-set! vec n val)
(let* ((N (* 2 N))
(vec2 (make-vector N)))
(let lp ((i 0))
@@ -540,6 +538,14 @@
(slot-set! out 'd 1)
out))
+(define-method (wrap-in (o <vector>))
+ (let ((out (make <py-list-iter>)))
+ (slot-set! out 'n (vector-length o))
+ (slot-set! out 'vec o)
+ (slot-set! out 'i 0)
+ (slot-set! out 'd 1)
+ out))
+
(define-method (py-reversed (o <py-list>))
(let ((out (make <py-list-iter>)))
(slot-set! out 'i (- (slot-ref o 'n) 1))
@@ -574,23 +580,9 @@
(next-method)))))
-(define-method (wrap-in (o <py-list-iter>))
- (let ((out (make <py-list-iter>)))
- (slot-set! out 'vec (slot-ref o 'vec))
- (slot-set! out 'i (slot-ref o 'i))
- (slot-set! out 'n (slot-ref o 'n))
- (slot-set! out 'd (slot-ref o 'd))
- out))
-
-(define-method (wrap-in (o <py-seq-iter>))
- (let ((out (make <py-seq-iter>)))
- (slot-set! out 'o (slot-ref o 'o))
- (slot-set! out 'i (slot-ref o 'i))
- (slot-set! out 'n (slot-ref o 'n))
- (slot-set! out 'd (slot-ref o 'd))
- out))
-
+(define-method (wrap-in (o <py-list-iter>)) o)
+(define-method (wrap-in (o <py-seq-iter>)) o)
(define-method (wrap-in (o <py-seq-iter> )) o)
@@ -832,6 +824,8 @@
(for ((x1 : o1) (x2 : o2)) ()
(if (< x1 x2)
(break #t))
+ (if (> x1 x2)
+ (break #f))
#:final
(< n1 n2))))
@@ -841,6 +835,9 @@
(for ((x1 : o1) (x2 : o2)) ()
(if (< x1 x2)
(break #t))
+ (if (> x1 x2)
+ (break #f))
+
#:final
(<= n1 n2))))
@@ -850,6 +847,9 @@
(for ((x1 : o1) (x2 : o2)) ()
(if (> x1 x2)
(break #t))
+ (if (< x1 x2)
+ (break #f))
+
#:final
(> n1 n2))))
@@ -859,6 +859,9 @@
(for ((x1 : o1) (x2 : o2)) ()
(if (> x1 x2)
(break #t))
+ (if (< x1 x2)
+ (break #f))
+
#:final
(>= n1 n2))))
@@ -932,3 +935,5 @@
(break #t))
#:final
#f))
+
+(define py-list list)
diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm
index bfb75fa..6e004a3 100644
--- a/modules/language/python/module/collections.scm
+++ b/modules/language/python/module/collections.scm
@@ -1,8 +1,19 @@
(define-module (language python module collections)
#:use-module (oop pf-objects)
#:use-module (language python module collections abc)
- #:export (ChainMap))
+ #:export (abc ChainMap))
+(define-python-class class-from-dict ()
+ (define __init__
+ (lambda (self d)
+ (for ((k v : d))
+ (set self k v)))))
+
+(define abc
+ (class-from-dict
+ (resolve-module (module-public-interface
+ '(language python module collections abc)))))
+
(define (u self)
(let ((s (set)))
(apply (ref s 'union) (ref self 'maps)))
@@ -143,14 +154,12 @@
(sorted ((ref self 'items) #:key (_itemgetter 1) #:reverse #t)
_heapq.nlargest(n ((ref self 'items)) #:key (_itemgetter 1))
-
+
-(define* (namedtuple typename field-names #key (verbose #f) (rename=#f)
-(module None))
diff --git a/modules/language/python/module/heapq.scm b/modules/language/python/module/heapq.scm
new file mode 100644
index 0000000..768aee2
--- /dev/null
+++ b/modules/language/python/module/heapq.scm
@@ -0,0 +1,236 @@
+(define-module (language python module heapq)
+ #:use-module (ice-9 control)
+ #:use-module (language python for)
+ #:use-module (language python yield)
+ #:use-module (language python try)
+ #:use-module (language python exceptions)
+ #:use-module (language python list)
+ #:use-module (language python def)
+ #:use-module (oop pf-objects)
+ #:use-module ((language python module python)
+ #:select (zip sorted range enumerate iter max min))
+ #:export (heappush heappop heapify heapreplace merge nlargest nsmallest
+ heappushpop))
+
+(define-syntax-rule (aif it p a b) (let ((it p)) (if it a b)))
+
+(define (heappush heap item)
+ (pylist-append! heap item)
+ (siftdown heap 0 (- (len heap) 1)))
+
+(define (heappop heap)
+ (let ((lastelt (pylist-pop! heap)))
+ (if (> (len heap) 0)
+ (let ((ret (pylist-ref heap 0)))
+ (pylist-set! heap 0 lastelt)
+ (siftup heap 0)
+ ret)
+ lastelt)))
+
+(define (heapreplace heap item)
+ (let ((ret (pylist-ref heap 0)))
+ (pylist-set! heap 0 item)
+ (siftup heap 0)
+ ret))
+
+(define (heapify x)
+ (let lp ((i (- (floor-quotient (len x) 2) 1)))
+ (if (>= i 0)
+ (begin
+ (siftup x i)
+ (lp (- i 1))))))
+
+(define (heappop_max heap)
+ (let ((lastelt (pylist-pop! heap)))
+ (if (> (len heap) 0)
+ (let ((ret (pylist-ref heap 0)))
+ (pylist-set! heap 0 lastelt)
+ (siftup_max heap 0)
+ ret)
+ lastelt)))
+
+(define (heapreplace_max heap item)
+ (let ((ret (pylist-ref heap 0)))
+ (pylist-set! heap 0 item)
+ (siftup_max heap 0)
+ ret))
+
+(define (heapify_max x)
+ (let lp ((i (- (floor-quotient (len x) 2) 1)))
+ (if (>= i 0)
+ (begin
+ (siftup_max x i)
+ (lp (- i 1))))))
+
+(define (siftdown heap startpos pos)
+ (define newitem (pylist-ref heap pos))
+
+ (let lp ((pos pos))
+ (if (> pos startpos)
+ (let ()
+ (define parentpos (ash (- pos 1) 1))
+ (define parent (pylist-ref heap parentpos))
+ (if (< newitem parent)
+ (begin
+ (pylist-set! heap pos parent)
+ (lp parentpos))
+ (pylist-set! heap pos newitem)))
+ (pylist-set! heap pos newitem))))
+
+(define (siftup heap pos)
+ (define endpos (len heap))
+ (define startpos pos)
+ (define newitem (pylist-ref heap pos))
+ (let lp ((pos pos) (childpos (+ (* 2 pos) 1)))
+ (if (< childpos endpos)
+ (let* ((rightpos (+ childpos 1))
+ (childpos
+ (if (and (< rightpos endpos)
+ (not (< (pylist-ref heap childpos)
+ (pylist-ref heap rightpos))))
+ rightpos
+ childpos)))
+ (pylist-set! heap pos (pylist-ref heap childpos))
+ (lp childpos (+ (* 2 childpos) 1)))
+ (begin
+ (pylist-set! heap pos newitem)
+ (siftdown heap startpos pos)))))
+
+(define (siftdown_max heap startpos pos)
+ (define newitem (pylist-ref heap pos))
+
+ (let lp ((pos pos))
+ (if (> pos startpos)
+ (let ()
+ (define parentpos (ash (- pos 1) 1))
+ (define parent (pylist-ref heap parentpos))
+ (if (< parent newitem)
+ (begin
+ (pylist-set! heap pos parent)
+ (lp parentpos))
+ (pylist-set! heap pos newitem)))
+ (pylist-set! heap pos newitem))))
+
+(define (siftup_max heap pos)
+ (define endpos (len heap))
+ (define startpos pos)
+ (define newitem (pylist-ref heap pos))
+ (let lp ((pos pos) (childpos (+ (* 2 pos) 1)))
+ (if (< childpos endpos)
+ (let* ((rightpos (+ childpos 1))
+ (childpos
+ (if (and (< rightpos endpos)
+ (not (< (pylist-ref heap rightpos)
+ (pylist-ref heap childpos))))
+ rightpos
+ childpos)))
+ (pylist-set! heap pos (pylist-ref heap childpos))
+ (lp childpos (+ (* 2 childpos) 1)))
+ (begin
+ (pylist-set! heap pos newitem)
+ (siftdown_max heap startpos pos)))))
+
+(def (merge (* iterables) (= key (lambda (x) x)) (= reverse #f))
+ ((make-generator ()
+ (lambda (yield)
+ (define h (py-list))
+ (define (h_append x) (pylist-append! h x))
+ (define-values (-heapify -heappop -heapreplace direction)
+ (if reverse
+ (values heapify_max
+ heappop_max
+ heapreplace_max
+ -1)
+ (values heapify
+ heappop
+ heapreplace
+ 1)))
+
+ (for ((order it : (enumerate (map iter iterables)))) ()
+ (define next- (aif x (ref it '__next__)
+ x
+ (lambda () (next it))))
+ (try
+ (lambda ()
+ (h_append (vector (key (next-))
+ (* order direction)
+ next-)))
+ (#:except StopIteration =>
+ (lambda x (-heappop h)))))
+
+ (-heapify h)
+ (let lp ()
+ (if (> (len h) 1)
+ (try
+ (lambda ()
+ (let lp ()
+ (let ((s (pylist-ref h 0)))
+ (yield (vector-ref s 0))
+ (vector-set! s 0 (key ((vector-ref s 2))))
+ (-heapreplace h s)
+ (lp))))
+ (#:except StopIteration =>
+ (lambda x (-heappop h) (lp))))))
+
+ (if (> (len h) 0)
+ (let* ((x (pylist-ref h 0))
+ (n (pylist-ref x 2)))
+ (let lp ((i (vector-ref x 0)))
+ (yield i)
+ (lp (n)))))))))
+
+
+
+
+(define-syntax-rule (mkn nsmallest heapify_max heapreplace_max q< ran o ++)
+ (define* (nsmallest n iterable #:key (key (lambda (x) x)))
+ (let/ec return
+ (if (equal? n 1)
+ (return
+ (let* ((sent (list 1))
+ (res (min (iter iterable) #:default sent #:key key)))
+ (if (eq? sent res)
+ '()
+ (list res)))))
+
+ (let ((size (try
+ (lambda () (len iterable))
+ (#:except (or TypeError AttributeError) =>
+ (lambda x #f)))))
+ (if (and size (>= n size))
+ (return (pylist-slice (sorted iterable #:key key) 0
+ ((@ (guile) min) n size)
+ 1))))
+
+ (let ((it (iter iterable))
+ (result (py-list)))
+
+ (for ((i elem : (zip (ran n) it))) ()
+ (pylist-append! result (vector (key elem) i elem)))
+
+ (if (= 0 (len result))
+ (return result))
+
+ (heapify_max result)
+
+ (for ((elem : it)) ((top (vector-ref (pylist-ref result 0) 0))
+ (order (o n)))
+ (let ((k (key elem)))
+ (if (q< k top)
+ (begin
+ (heapreplace_max result (vector k order elem))
+ (values (vector-ref (pylist-ref result 0) 0)
+ (++ order)))
+ (values top order))))
+ (pylist-sort! result)
+ (return
+ (let ((r (py-list)))
+ (for ((x : result)) ()
+ (pylist-append! r (vector-ref x 2)))
+ r))))))
+
+(mkn nsmallest heapify_max heapreplace_max < (lambda (n) (range n))
+ (lambda (n) n) (lambda (x) (+ x 1)))
+
+(mkn nlargest heapify heapreplace > (lambda (n) (range 0 (- n) -1))
+ (lambda (n) (- n)) (lambda (x) (- x 1)))
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 2ea57eb..8264fee 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -85,18 +85,18 @@
(define staticmethod static-method)
(define (enumerate l)
- (make-generator enumerate
- (lambda (yield)
+ ((make-generator ()
+ (lambda (yield)
(for ((x : l)) ((i 0))
(yield i x)
- (+ i 1)))))
+ (+ i 1))))))
(define (filter f l)
- (make-generator enumerate
- (lambda (yield)
- (for ((x : l)) ()
- (if (f x)
- (yield x))))))
+ ((make-generator ()
+ (lambda (yield)
+ (for ((x : l)) ()
+ (if (f x)
+ (yield x)))))))
(define miss ((@ (guile) list) 'miss))
@@ -174,7 +174,7 @@
(let lp ((l l))
(match l
((it)
- (for ((x : it)) ((s default) (b default))
+ (for ((x : it)) ((s miss) (b miss))
(if (eq? s miss)
(values (key x) x)
(let ((k (key x)))
@@ -183,7 +183,10 @@
(values s b))))
#:final
(if (eq? b miss)
- (raise ValueError "min does not work for zero length list")
+ (if (eq? default miss)
+ (raise ValueError
+ "min does not work for zero length list")
+ default)
b)))
(_ (lp ((@ (guile) list) l))))))
@@ -191,8 +194,8 @@
(let lp ((l l))
(match l
((it)
- (for ((x : it)) ((s default) (b default))
- (if (eq? default miss)
+ (for ((x : it)) ((s miss) (b miss))
+ (if (eq? s miss)
(values (key x) x)
(let ((k (key x)))
(if (> k s)
@@ -200,7 +203,10 @@
(values s b))))
#:final
(if (eq? b miss)
- (raise ValueError "min does not work for zero length list")
+ (if (eq? default miss)
+ (raise ValueError
+ "min does not work for zero length list")
+ default)
b)))
(_ (lp ((@ (guile) list) l))))))
diff --git a/modules/language/python/try.scm b/modules/language/python/try.scm
index a36263b..36d9b04 100644
--- a/modules/language/python/try.scm
+++ b/modules/language/python/try.scm
@@ -48,12 +48,19 @@
((_ E tag l)
(check E tag l))))
+(define (m code)
+ (let ((c code))
+ (lambda (k . l)
+ (if (eq? k StopIteration)
+ (apply c 'python k l)
+ (apply c k l)))))
+
(define-syntax handler
(syntax-rules (=>)
-
((handler ecx)
- (lambda (k tag . l)
- (handler ecx tag l)))
+ (m
+ (lambda (k tag . l)
+ (handler ecx tag l))))
((handler ((#:except E => lam) . ecx) tag l)
(if (check-exception E tag l)
generated by cgit v1.2.3 (git 2.46.0) at 2024-09-20 09:42:49 +0000