#lang racket
(require compatibility/mlist)

;;
; cooperative trheading from website
;;

; thread-queue : list[continuation]
(define thread-queue '())

; halt : continuation
(define halt #f)

; void : -> void
(define (void) (if #f #t #f))

; current-continuation : -> continuation
(define (current-continuation)
  (call-with-current-continuation
   (lambda (cc)
     (cc cc))))

; spawn : (-> anything) -> void
(define (spawn thunk)
  (let ((cc (current-continuation)))
    (if (procedure? cc)
        (set! thread-queue (append thread-queue (list cc)))
        (begin (thunk)
               (quit)))))

; yield : value -> void
(define (yield)
  (let ((cc (current-continuation)))
    (if (and (procedure? cc) (pair? thread-queue))
        (let ((next-thread (car thread-queue)))
          (set! thread-queue (append (cdr thread-queue) (list cc)))
          (next-thread 'resume))
        (void))))

; quit : -> ...
(define (quit)
  (if (pair? thread-queue)
      (let ((next-thread (car thread-queue)))
        (set! thread-queue (cdr thread-queue))
        (next-thread 'resume))
      (halt)))

; start-threads : -> ...
(define (start-threads)
  (let ((cc (current-continuation)))
    (if cc
        (begin
          (set! halt (lambda () (cc #f)))
          (if (null? thread-queue)
              (void)
              (begin
                (let ((next-thread (car thread-queue)))
                  (set! thread-queue (cdr thread-queue))
                  (next-thread 'resume)))))
        (void))))


;;
; Frequency table helper functions
;;

;; initializes empty frequency table,
;  keys: prime numbers
;  values: frequency
(define freq-table
  (mlist (mcons 0 0)))

(define (reset-freq-table)
  (set! freq-table  (mlist (mcons 0 0))))

;; finds the prime pair and grabs the frequency
(define (lookup-freq prime)
  (mcdr (massoc prime freq-table)))

;; update frequency +1
(define (set-freq prime)
  (set-mcdr! (massoc prime freq-table) (+ 1 (lookup-freq prime))))
;; include a new prime into mutable pairs list
(define (include-prime prime)
  (set! freq-table (mappend freq-table (mlist (mcons prime 1)))))
;; decides whether to set-freq or make new prime
(define (update-table prime)
  (if (massoc prime freq-table)
      (set-freq prime)
      (include-prime prime)))


(define (iter-factors factor-list)
  (cond
    ((null? factor-list) (display "")) ;(display "done ") (display freq-table))
    (else
     (let ((fact (car factor-list))
           (rest (cdr factor-list)))
       (update-table fact)
       (iter-factors rest)))))


;;
; Factorization threading example
;;

;; PARAMS
(define t-limit 6) ;limits how many integers get factored
(define t-count 0) ;running count of how many factored so far
(define t-done-list '())

;; METHODS
(define (make-f-thread name)
  (letrec ((loop
            (lambda ()
              (cond ((null? c-int-list)
                     (display "terminating thread ") (display name) (newline)
                     (quit))
                    (else
                     (display "in thread ") (display name)
                     (let ((int (car c-int-list)))
                       (display "; integer = ") (display int) (newline)
                       (set! c-int-list (cdr c-int-list))
                       (cond ((integer? int)
                              (iter-factors (t-factor int int))
                              (loop))
                             (else
                              (display "ERROR Non-integer passed")))))))))
    loop))

(define (t-factor number raw)
  (define (*t-factor divisor number)
    (if (<= t-limit t-count) (quit) (display ""))
    (if (> (* divisor divisor) number)
        (begin
          (set! t-count (+ t-count 1))
          (set! t-done-list (append t-done-list `(,raw)))
          (list number))
        (if (= (modulo number divisor) 0)
            (cons divisor (*t-factor divisor (/ number divisor)))
            (begin
              (yield)
              (*t-factor (+ divisor 1) number)))))
  (*t-factor 2 number))


;;
; Regular factorization example
;;


;; PARAMS
(define r-limit 6) ;limits how many integers get factored
(define r-count 0) ;running count of how many factored so far
(define r-done-list '())

;; METHODS

(define (r-factor number raw)
  (define (*r-factor divisor number)
    (if (> (* divisor divisor) number)
        (begin
          (set! r-done-list (append r-done-list `(,raw)))
          (list number))
        (if (= (modulo number divisor) 0)
            (cons divisor (*r-factor divisor (/ number divisor)))
            (*r-factor (+ divisor 1) number))))
  (*r-factor 2 number))

(define (regular-run int-list)
  (cond ((null? int-list) (display "")) ;when not null OR unless null
        ((<= r-limit r-count) (display "reached limit") (newline))

        (else
         (let ((int (car int-list))
               (rest (cdr int-list)))
           (cond ((integer? int)
                  (set! r-count (+ r-count 1))
                  (iter-factors (r-factor int int))
                  (regular-run rest))
                 (else (display "Error must only pass integers")))))))



;;
; Run examples
;;


(define c-int-list
  '(13412301912340922
    32432142
    113421341
    1324012
    132409
    019239384
    01939
    2
    12309485
    4102
    109817724
    1098129
    103928734
    0918217))

;;
; threaded example
;;
(spawn (make-f-thread 'a))
(spawn (make-f-thread 'b))
(spawn (make-f-thread 'c))
(spawn (make-f-thread 'd))
(define t-start-time (current-inexact-milliseconds))
(start-threads)
(define t-end-time (current-inexact-milliseconds))
(display "Threading runtime: ") (display (- t-end-time t-start-time)) (newline)
(display (mcdr freq-table)) (newline)
(newline)

;;
; non threaded example
;;

(set! c-int-list
      '(13412301912340922
        3243214210
        113421341
        1324012
        132409
        019239384
        01939
        2
        12309485
        4102
        109817724
        1098129
        103928734
        0918217))

(reset-freq-table)
(define r-start-time (current-inexact-milliseconds))
(regular-run c-int-list)
(define r-end-time (current-inexact-milliseconds))
(display "Regular runtime: ") (display (- r-end-time r-start-time))
(newline) (display (mcdr freq-table)) (newline)


;;
;
;;

(display "threadtime - regtime = ")
(display (- t-end-time t-start-time)) (display " - ") (display (- r-end-time r-start-time))
(display " = ") (display (- (- t-end-time t-start-time) (- r-end-time r-start-time)))



(newline)
(display t-done-list)
(newline)
(display r-done-list)