ijp

(define-module (angels-and-devils)
  #:export (milestone devil angel))

;; See the paper "call-with-current-continuation patterns"

(define future '())
(define past '())

(define-syntax-rule (push var val)
  (set! var (cons val var)))

ijp

(defun raellear-lgrep (regexp &optional files confirm)
  (interactive
   (progn
     (grep-compute-defaults)
     (cond
      ((and grep-command (equal current-prefix-arg '(16)))
       (list (read-from-minibuffer "Run: " grep-command
				   nil nil 'grep-history)))
      ((not grep-template)
       (error "grep.el: No `grep-template' available"))

ijp

(save-module-excursion
 (lambda ()
   (set-current-module (resolve-module '(web client)))
   (eval '(define (extend-request r k v . additional)
            (let ((r (build-request (request-uri r)
                                    #:method (request-method r)
                                    #:version (request-version r)
                                    #:headers
                                    (assoc-set! (copy-tree (request-headers r))
                                                k v)

ijp

;; extending the y combinator to handle mutual recursion, for zacts

(define (y . funcs)
  ((lambda (x) (x x))
   (lambda (x)
     (map (lambda (g)
            (lambda args
              (apply (apply g (x x)) args)))
          funcs))))

ijp

(import (rnrs)
        (ijputils boxes)
        (ice-9 match))

;; Big picture: Two boxes
;; - first = pointer
;; - second = thunk

(define (create-graph l)
  (let lp ((l l))

ijp

(import (rnrs)
        (for (only (srfi :1) break) expand))

(define-syntax foo
  (lambda (stx)
    (define (no-vals f befores)
      (let ((temps (generate-temporaries befores)))
        #`(lambda #,temps
            (#,f #,@(map list befores temps)))))
    (define (yes-vals f befores afters)

ijp

;;; shift-reset fixed point combinator
(use-modules (ice-9 control))

(define (fix f)
  (reset
   (let ((g (shift k (k k))))
     (lambda (x)
       ((f (g g)) x)))))

(define fact

ijp

(define (discriminate f)
  (define first? #t)
  (define k #f)
  (define (discriminator)
    (define (return x) x)
    (let ((x
           (f (lambda (x)
                (when first?
                  (set! first? #f)
                  (set! return (call/cc (lambda (resume)

ijp

(define-syntax ck
  (syntax-rules (quote)
    ((ck () 'v) v)                      ; yield the value on empty stack

    ((ck (((op ...) ea ...) . s) 'v)    ; re-focus on the other argument, ea
     (ck-arg s (op ... 'v) ea ...))

    ((ck s (op ea ...))                 ; Focus: handling an application;
     (ck-arg s (op) ea ...))))          ; check if args are values

ijp

;;; Lambda calculus interpreter with precomputed free variables
(use-modules (srfi srfi-1)
             (srfi srfi-9)
             (ice-9 match))

;;; Set Type
(define set list)
(define member? member)
(define (union s1 s2)
  (lset-union eqv? s1 s2))