; .EnTete "Le-Lisp (c) version 15.2" " " "E/S sur chai↑nes de caracte`res"
; .EnPied "stringio.ll" "J-%" " "
; .Annexe X "E/S sur chai↑nes de caracte`res"
; .nr % 1
;
; .Centre "*****************************************************************"
; .Centre " Ce fichier est en lecture seule hors du projet ALE de l'INRIA. "
; .Centre " Il est maintenu par ILOG SA, 2 Avenue Gallie'ni, 94250 Gentilly "
; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA "
; .Centre "*****************************************************************"
; .Centre "$Header: stringio.ll,v 1.2 88/11/30 16:50:21 chaillou Exp $"
; Re'alise d'une manie`re raisonnable des E/S sur des chai↑nes de caracte`res
; en utilisant toute la puissance des IT programmables et en e'vitant
; d'utiliser des ressources dynamiques. Les fonctions de ce fichier
; vont rendre caduques les anciennes utilisation de IMPLODE/EXPLODE.
(unless (>= (version) 15.21)
(error 'load 'erricf 'stringio))
; Tous les symboles pre'ce'de's de : seront cre'e's dans le package STRINGIO.
(defvar #:sys-package:colon 'stringio)
(add-feature 'stringio)
; .Section "Impression retournant une chai↑ne"
(defvar :standard-string-output (makestring 256 #\sp))
(defvar :flush-reached ())
(de :eol ()
(princn #\cr)
(princn #\lf)) ; a` la Le-Lisp
(de :flush ()
(when :flush-reached
(exit :failed ()))
(setq :flush-reached t))
(dmd with-output-to-string (s i . body)
; <s> une chai↑ne qui sera remplie physiquement,
; <i> l'indice de de'but de remplissage
; <body> un corps a` exe'cuter
; toutes les impressions de cette exe'cution seront mise
; physiquement dans la chai↑ne.
; Si elle est trop petite, une erreur se de'clenche.
; Retourne l'index max du chargement.
;
`(let ((:s ,s) (:i ,i)) ; pour prote'ger des doubles e'valuations
(let ((:b (outbuf)) ; sauvetage de l'e'tat courant.
(:pos (outpos))
(:rmargin (rmargin)))
(tag :ok
(tag :failed
(let ((#:sys-package:itsoft
(cons '#.#:sys-package:colon #:sys-package:itsoft))
(:flush-reached ()))
(protect (progn
(exchstring :b :s)
(rmargin (add1 (slen :b)))
(outpos :i)
,.body
(exit :ok (outpos)))
(exchstring :b :s)
(rmargin :rmargin)
(outpos :pos))))
(error 'print-to-string "EOS durant un PRINT" ())
))))
(de print-to-string (e)
; retourne l'impression de l'objet <e> sous forme
; d'une chai↑ne de caracte`res.
; ?!? Aujourd'hui la chai↑ne est limite'e a` 256 caracte`res ?!?!?
; ?!? ce qui est mieux que l'ancienne version d'Aida qui limitait ?!?!
; ?!? cette chaine a` 80 caracte`res ?!?!
(substring :standard-string-output
0
(with-output-to-string :standard-string-output
0
(prin e))))
; .Section "Lecture a` partir d'une chai↑ne de caracte`res"
(defvar :eos-reached ())
(de :bol ()
(when :eos-reached
(exit :failed ()))
(sset (inbuf) 0 #\sp)
(setq :eos-reached t)
(inmax 1)
(inpos 0))
(de read-from-string (s)
(with-input-from-string s 0 (read)))
(dmd with-input-from-string (s i . body)
; <s> est une chai↑ne de caracte`res
; <i> est l'index a` partir duquel seront re'alise's les lectures
; potentielles durant l'e'valuation de <body>.
; retourne la valeur de <body>.
`(let ((:s ,s) (:i ,i))
(let ((:b (inbuf))
(:firstcn (sref :s 0))
(:max (inmax))
(:pos (inpos)))
(tag :ok
(tag :failed
(let ((#:sys-package:itsoft
(cons '#.#:sys-package:colon #:sys-package:itsoft))
(:eos-reached ())
(val ()))
(protect (progn
(exchstring :b :s)
(inmax (slen :b))
(inpos :i)
(setq val (catcherror t ,@body))
(if (consp val)
(exit :ok (car val))
(exit :failed ())))
(exchstring :b :s)
(inmax :max)
(inpos :pos)
(sset :s 0 :firstcn)))
(error 'with-input-from-string 'errsxt ()))))))