User:Phantom Hoover/io.scm

(load "lazier.scm") (load "prelude.scm") (load "prelude-numbers.scm") (load "prelude-characters.scm")
 * The Lazy K monady IO library

(lazy-def '(triple x y z) '(lambda (f) (f x y z))) (lazy-def '(fst t) '(t (lambda (x y z) x))) (lazy-def '(snd t) '(t (lambda (x y z) y))) (lazy-def '(thd t) '(t (lambda (x y z) z)))

(lazy-def '(return x) '(lambda (input) (triple x input i)))

(lazy-def '(bind x f) '(lambda (input) (x input (lambda (xv xin xout) (triple (fst (f xv xin))					   (snd (f xv xin))					    (o xout (thd (f xv xin))))))))

(lazy-def '(seq a b) '(bind a (k b)))

(lazy-def '(io-main main) '(lambda (input) (main input (lambda (val in out) (out (cons 256 256))))))

(lazy-def '(putstr str) '(lambda (input) (triple input str)))

(lazy-def '(putchar char) '(lambda (input) (triple input (cons char))))

(lazy-def '(putstrln str) '(seq (putstr str) (putchar 10)))

(lazy-def 'getchar '(lambda (input) (triple (1- (1+ (car input))) (cdr input) i)))

(lazy-def 'getline '(Y (lambda (self)			 (bind getchar (lambda (c)					 (if (= c 10) (return i)					    (bind self						   (lambda (rest) (return (o (cons c) rest))))))))))

(define (list->consable l) (if (null? (cdr l)) (list 'cons (car l)) (list 'o (list 'cons (car l)) (list->consable (cdr l)))))

(define (string->consable str) (list->consable (map char->integer (string->list str))))

(define expand-do (lambda (first . rest) (if (null? rest)			first			(if (and (pair? first) (eq? (car first) 'let)) (list 'bind (caddr first) (list 'lambda (list (cadr first)) (apply expand-do rest))) (list 'seq first (apply expand-do rest))))))