/usr/share/scsh-0.6/misc/either.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Internal variable representing the failure stack.
(define (fail) (*fail*))
(define *fail* (lambda () (error "You didn't do (init).")))
; For the alternation operator, Icon's a | b or McCarthy's (amb a b),
; we write (either a b).
(define-syntax either
(syntax-rules ()
((either) (fail))
((either x) x)
((either x y ...)
(%either (lambda () x) (lambda () (either y ...))))))
(define (%either thunk1 thunk2) ;Macro auxiliary
(saving-failure-state
(lambda (restore)
((call-with-current-continuation
(lambda (k)
(set! *fail*
(lambda ()
(restore)
(k thunk2)))
thunk1))))))
(define (saving-failure-state proc)
(let ((save *fail*))
(proc (lambda () (set! *fail* save)))))
; (one-value x) is Prolog's CUT operator
(define-syntax one-value
(syntax-rules ()
((one-value x) (%one-value (lambda () x)))))
(define (%one-value thunk)
(saving-failure-state
(lambda (restore)
(let ((value (thunk)))
(restore)
value))))
; (all-values a) returns a list of all the possible values of the
; expression a. Prolog calls this "bagof"; I forget what Icon calls it.
(define-syntax all-values
(syntax-rules ()
((all-values x) (%all-values (lambda () x)))))
(define (%all-values thunk)
(let ((results '()))
(either (let ((new-result (thunk)))
(set! results (cons new-result results))
(fail))
(reverse results))))
; Generate all the members of list l. E.g.
; (all-values (+ (member-of '(10 20 30)) (member-of '(1 2 3))))
; => '(11 12 13 21 22 23 31 32 33)
(define (member-of l)
(if (null? l)
(fail)
(either (car l) (member-of (cdr l)))))
; Crufty initialization hack that allows you to type failing
; expressions at the R-E-P loop (if there is an R-E-P loop). E.g. try
; evaluating the sequence
; (either 1 2)
; (fail)
; (+ (fail) 10)
(define (init)
(set! *fail* #f) ;for GC purposes
(either 'initialized
(let loop ()
(either 'failed (loop)))))
(display "Type (init) at the read-eval-print loop.")
(newline)
|