parallelism.scm 1.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556
  1. (library (parallelism)
  2. (export run-in-parallel
  3. map-indexed
  4. parallel-map)
  5. (import
  6. (except (rnrs base) let-values map)
  7. (only (guile)
  8. lambda* λ)
  9. (ice-9 futures)
  10. (srfi srfi-1))
  11. (define map-indexed
  12. (λ (proc lst)
  13. "Map PROC to all elements of LST, but also give the index of
  14. each element to the mapped PROC as an argument. PROC is
  15. called (proc elem index)."
  16. (let iter ([ind 0] [lst° lst])
  17. (cond
  18. [(null? lst°) '()]
  19. [else
  20. (cons (proc (car lst°) ind)
  21. (iter (+ ind 1) (cdr lst°)))]))))
  22. (define run-in-parallel
  23. (λ (segments map-indexed-proc reduce-proc reduce-init)
  24. "Use futures to run a procedure in parallel, if
  25. multiple cores are available. Take a list of SEGMENTS as
  26. input, which are ranges of values to work on. MAP-PROC is
  27. applied to the SEGMENTS using map. When the MAP-PROC calls
  28. for all segments finished and returned values, the
  29. REDUCE-PROC is applied to the map result using reduce and
  30. the REDUCE-INIT argument."
  31. (let ([futures
  32. (map-indexed
  33. (λ (seg ind)
  34. (make-future
  35. ;; Need to wrap in a thunk, to not
  36. ;; immediately start evaluating.
  37. (λ () (map-indexed-proc seg ind))))
  38. segments)])
  39. (let ([segment-results (map touch futures)])
  40. (reduce reduce-proc
  41. reduce-init
  42. segment-results)))))
  43. (define parallel-map
  44. (λ (map-indexed-proc lst)
  45. "Parallelized version of map, if multiple cores are
  46. available."
  47. (let ([futures
  48. (map-indexed (λ (elem ind)
  49. (make-future (λ () (map-indexed-proc elem ind))))
  50. lst)])
  51. (let ([results (map touch futures)])
  52. results)))))