Created
July 3, 2018 07:46
-
-
Save kuuote/b0a6fa7b77a611686220e4abb0d4fb51 to your computer and use it in GitHub Desktop.
遅延シーケンステスト
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
#!/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