(define-module (deliberate utils)
  #:use-module (srfi srfi-1)
  #:use-module (goblins)
  #:use-module (goblins actor-lib methods)
  #:export (^attenuated ^cell const-list group-by range reorder string-count zip))

;; Constructor for ^cell
;; Stores a single updatable value
;;
;; Parameters:
;;   value: The value to store
;;
;; Messages:
;;   get: returns the current value
;;   set new-value: updates object to store new-value
;;
(define (^cell bcom value)
  (methods
   ((get) value)
   ((set new-value) (bcom (^cell bcom new-value)))
   ))

;; Constructor for ^attenuated
;; Attenuates another goblins object
;;
;; Parameters:
;;   obj: Object to attenuate
;;   allowed: List of messages that will be delegated to obj, others will
;;     raise an error
;;
(define (^attenuated _bcom obj allowed)
  (lambda (message)
    (if (memq message allowed)
	($ obj message)
	(error (format #f "Message not permitted: [~a]" message))
	)))

;; Return a list of given length with each element equal to a given value
(define (const-list length value)
  (if (= length 0)
      '()
      (cons value (const-list (- length 1) value))))

;; Return a list of integers in the half-open interval [low, high)
(define (range low high)
  (if (eq? low high)
      '()
      (cons low (range (+ 1 low) high))))

;; Combine lists component-wise
;; Similar to python zip()
;;
;; Parameters:
;;   args: Any number of lists
;;
;; Returns:
;;   A list. The nth element is a list of the
;;   nth elements of each argument
;;
(define (zip . args)
  (if (or (nil? args) (memq '() args))
      '()
      (cons (map car args)
	    (apply zip (map cdr args)))))

;; Reorder one list by another
;; A reordering is applied to lst such that the same reordering would
;; Put rank in asending oder.
;;
;; Parameters:
;;   lst: The list to reorder
;;   ranks: The list to sort by
;;
;; Returns:
;;   A reordered copy of lst
;;
(define (reorder lst ranks)
  (let* ((pairs (zip lst ranks))
	 (ranked-pairs
	  (filter (lambda (pair) (not (eq? #f (cadr pair))))
		  pairs))
	 (sorted-pairs
	   (sort ranked-pairs (lambda (a b) (< (cadr a) (cadr b))))))
    (map car sorted-pairs)))

;; TODO
;;
(define (group-by-helper sorted)
  (if (nil? sorted)
      '()
      (let ((elt (car (car sorted))))
	(define-values (group rest)
	  (span (lambda (x) (equal? (car x) elt)) sorted))
	(cons (cons elt (map cdr group))
	      (group-by-helper rest)))))

;; TODO
;;
(define (group-by proc lst)
  (let* ((annotated (map (lambda (x) (cons (proc x) x)) lst))
	 (sorted (sort annotated (lambda (x y) (string< (car x) (car y))))))
    (group-by-helper sorted)))

;; Counts the number of times each string appears in a list
;;
;; Parameters:
;;   values: The list
;;
;; Returns:
;;   An alist of the form ((string1 . count1) ...)
;;
(define (string-count values)
  (let ((sorted (sort values string<)))
    (string-count-sorted sorted)))

;; Same as string-count but assumes parameter is sorted
(define (string-count-sorted sorted)
  (if (nil? sorted)
      '()
      (let* ((elt (car sorted))
	     (total-length (length sorted))
	     (rest (find-tail (lambda (x) (not (equal? x elt))) sorted))
	     (rest-length (if rest (length rest) 0)))
	(cons (cons elt (- total-length rest-length))
	      (string-count-sorted rest)))))