Skip to content

Instantly share code, notes, and snippets.

@kuuote
Created July 3, 2018 07:46
Show Gist options
  • Save kuuote/b0a6fa7b77a611686220e4abb0d4fb51 to your computer and use it in GitHub Desktop.
Save kuuote/b0a6fa7b77a611686220e4abb0d4fb51 to your computer and use it in GitHub Desktop.
遅延シーケンステスト
#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
(ros:ensure-asdf)
;;#+quicklisp (ql:quickload '() :silent t)
)
(defpackage :ros.script.a.3739587226
(:use :cl))
(in-package :ros.script.a.3739587226)
(defconstant promise-tag (gensym))
(defun promisep (p)
(and (consp p) (eq (car p) promise-tag)))
(defun make-promise (fn)
(list promise-tag fn nil))
(defun force (p)
(if (promisep p)
(if (caddr p)
(cadr p)
(let ((result (funcall (cadr p))))
(setf (cadr p) result)
(setf (caddr p) t)
result))
p))
(defmacro delay (proc)
`(make-promise (lambda () ,proc)))
(defun lseq (gen)
(delay (cons (funcall gen) (delay (lseq gen)))))
(defun make-lseq (gen)
(labels ((kons ()
(cons (funcall gen) (delay (kons)))))
(delay (kons))))
(defun lcar (p)
(car (force p)))
(defun lcdr (p)
(force (cdr (force p))))
(defun main (&rest argv)
(declare (ignorable argv))
(print (lcar (make-lseq (lambda () (read-char nil nil 'EOF)))))
(print (lcar (lcdr (make-lseq (lambda () (read-char nil nil 'EOF))))))
(print (lcar (lcdr (lcdr (make-lseq (lambda () (read-char nil nil 'EOF)))))))
(print (lcar (lcdr (lcdr (lcdr (make-lseq (lambda () (read-char nil nil 'EOF)))))))))
;;; vim: set ft=lisp lisp:
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment