Last active
November 30, 2023 18:05
-
-
Save patham9/d1e09c2f346a9e17b5c8e946bb5a1421 to your computer and use it in GitHub Desktop.
Parallel amb
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(import (chicken process) (chicken string) (chicken file posix) amb) | |
(define-syntax amb-parallel | |
(syntax-rules () | |
((_ arg1 arg2) | |
(let-values (((pipefd0 pipefd1) (create-pipe))) | |
(let ((pid (process-fork))) | |
(begin (if (eq? pid 0) | |
(begin (file-write pipefd1 (string-append (->string arg1) "\n")) | |
(exit 0)) ;child is done | |
(begin (let ((res1 arg2) ;get to work before waiting for child to return result (else there is no point) | |
(res2 (read (open-input-string (car (string-split (car (file-read pipefd0 100)) "\n")))))) | |
(amb res1 res2)))))))))) | |
;example: | |
(define (test x) (list 2 x (+ 2 x))) | |
(display (amb-collect (amb-parallel (test 1) (test 2)))) | |
(newline) |
Thank you very much for your valuable comments @siiky!
I have improved the code accordingly:
(define-syntax hyperpose
(syntax-rules ()
((_ arg1 arg2)
(receive (pipefd0 pipefd1) (create-pipe)
(let ((pid (process-fork)))
(if (eq? pid 0)
(begin (write (->string arg1) (open-output-file* pipefd1))
(exit 0)) ;child is done
(let ((res1 arg2) ;get to work before waiting for child to return result (else there is no point)
(res2 (read (open-input-file* pipefd0))))
(list res1 res2))))))))
For completeness according to your newer comment: (amb-compatible version will come later)
(define-syntax hyperpose
(syntax-rules ()
((_ arg1 arg2)
(receive (pipefd0 pipefd1) (create-pipe)
(let ((pid (process-fork)))
(if (eq? pid 0)
(begin (write arg1 (open-output-file* pipefd1))
(exit 0)) ;child is done
(let* ((res1 arg2) ;get to work before waiting for child to return result (else there is no point)
(res2 (read (open-input-file* pipefd0))))
(list res1 res2))))))))
With amb:
(import (chicken process) (chicken file posix) amb amb-extras)
(define-syntax amb-parallel
(syntax-rules ()
((_ arg1 arg2)
(receive (pipefd0 pipefd1) (create-pipe)
(let ((pid (process-fork)))
(if (eq? pid 0)
(let ((pipefd1_port (open-output-file* pipefd1)))
(write (amb-collect arg2) pipefd1_port) ;we can't backtrack into parent so we collect all of this level's results
(close-output-port pipefd1_port)
(exit 0)) ;child is done
(let ((res1 (amb-collect arg1)) ;we cannot backtrack here either, the child counts on the parent, so we collect all of this level's results
(res2 (read (open-input-file* pipefd0)))) ;after we collected our results we can collect the result of the child
(if (and (eq? res1 '()) (eq? res2 '()))
((amb-failure-continuation))
(if (eq? res1 '())
(amb1 res2)
(if (eq? res2 '())
(amb1 res1)
(amb1 (append (list (amb1 res1)) (list (amb1 res2))))))))))))))
;example:
(define (test x) (list 2 x (+ 2 x)))
(display (amb-collect (amb-parallel (test 42) (amb-parallel (test 3) (test 1)))))
(newline)
Here a generalized version of amb-parallel which works with N arguments:
(import (chicken process) (chicken file posix) amb amb-extras)
(define-syntax amb-parallel
(syntax-rules ()
((_ arg1 arg2)
(receive (pipefd0 pipefd1) (create-pipe)
(let ((pid (process-fork)))
(if (eq? pid 0)
(let ((pipefd1_port (open-output-file* pipefd1)))
(write (amb-collect arg2) pipefd1_port) ;we can't backtrack into parent so we collect all of this level's results
(close-output-port pipefd1_port)
(exit 0)) ;child is done
(let* ((res1 (amb-collect arg1)) ;we cannot backtrack here either, the child counts on the parent, so we collect all of this level's results
(res2 (read (open-input-file* pipefd0)))) ;after we collected our results we can collect the result of the child
(if (and (null? res1) (null? res2))
((amb-failure-continuation))
(if (null? res1)
(amb1 res2)
(if (null? res2)
(amb1 res1)
(amb1 (list (amb1 res1) (amb1 res2)))))))))))
((_ arg1 arg2 argi ...)
(let ((chain (amb-parallel (amb-collect arg1) (amb-collect (amb-parallel arg2 argi ...)))))
(amb1 chain)))))
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Some tips (was gonna send on IRC but you were offline):
(receive (pipefd0 pipefd1) (create-pipe) (let ...))
let
has an implicitbegin
, you can remove it;begin
in the else-branch is also useless;open-input-file*
/open-output-file*
;res2
is simply(read pipe0)
-- and it's actually more correct: what guarantees do you have the child will write at most 100 chars?flush-output
to flush, (probably) instead of printing an extra newline;daemon
egg which already tries to do this bureaucracy for you (and you can test it more thoroughly for me :)