fork(2) download 
  1. (define (println n)
  2.     (display n)
  3.     (newline))
  4.  
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    
  6. (define call/cc call-with-current-continuation) 
  7.  
  8. (define stack '())
  9.  
  10. (define (now)
  11.     (call/cc
  12.         (lambda (cc) 
  13.             (cc cc))))
  14.  
  15. (define (push cc)
  16.     (set! stack (cons cc stack)))
  17.  
  18. (define (next)
  19.     (if (null? stack) '()
  20.         (let ((head (car stack)))
  21.              (set! stack (cdr stack))
  22.              (head head))))
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24. ; List Monad:
  25. (define (list_get x)
  26.     (let ((cc (now)))
  27.         (if (null? x)
  28.             (next)
  29.             (let ((head (car x)))
  30.                 (set! x (cdr x))
  31.                 (push cc)
  32.                 head))))
  33.  
  34. (define (list_results_return x)
  35.     (reverse (delete '() x)))
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. ; Maybe Monad:
  38. (define (maybe_get x)
  39.     (if (null? x)
  40.         (next)
  41.         (car x)))
  42.  
  43. (define (maybe_results_return x)
  44.         (if (null? x)
  45.             "Nothing"
  46.             (car x)))
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48. (define (monadic_call get results_return func . args)
  49.     (define results '())
  50.     (define first '())
  51.     (let ((cc (now)))
  52.         (if (null? first)
  53.             (begin
  54.                 (push cc)
  55.                 (set! first 1)
  56.                 (set! results (cons (apply func (cons get args)) results))
  57.                 (next))
  58.             (results_return results))))
  59. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60. (define (user_func get Mx My)
  61.     (define x '())
  62.     (define y '())
  63.     (set! x (get Mx))
  64.     (if (< x 1000)
  65.         (begin
  66.             (set! y (get My))
  67.             (* x y))
  68.         '()))
  69. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  70. (begin
  71.     (println "normal call:")
  72.     (println (user_func car '(10) '(11))))
  73.  
  74. (begin
  75.     (println "list call:")
  76.     (println
  77.         (monadic_call list_get list_results_return user_func '(10 100 1000) '(1 2 3))))
  78.  
  79. (begin
  80.     (println "maybe call:")
  81.     (println
  82.         (monadic_call maybe_get maybe_results_return user_func '(10) '(11))))
  83.  
  84. (begin
  85.     (println "maybe call with Nothing:")
  86.     (println
  87.         (monadic_call maybe_get maybe_results_return user_func '() '(11))))
  88.  
Success #stdin #stdout 0.03s 4132KB
comments (?)
stdin 
scheme monad
stdout 
normal call:
110
list call:
(10 20 30 100 200 300)
maybe call:
110
maybe call with Nothing:
Nothing
https://ideone.com/7uOVe2
language:
Scheme (guile 2.2.4)
created:
10 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!