mirror of
https://github.com/PDP-10/its.git
synced 2026-02-19 05:57:14 +00:00
77 lines
3.0 KiB
Common Lisp
Executable File
77 lines
3.0 KiB
Common Lisp
Executable File
;;; -*- Mode:LISP; -*-
|
|
|
|
;;; LispM semi-compatible WITH-INPUT-FROM-STRING package.
|
|
|
|
;;; (WITH-INPUT-FROM-STRING (var string [index] [limit])
|
|
;;;
|
|
;;; Allows the user to read from a string as if it were a stream. Starting
|
|
;;; pos is optional and defaults to 0. Ending pos is optional and defaults
|
|
;;; to string-length of the string.
|
|
;;;
|
|
;;; Unlike the lispm, the index will not be assigned to so can be any expression.
|
|
;;; This means you cannot easily tell how far you read in the string. You are,
|
|
;;; however, allowed to do (SFA-CALL var 'READ-POINTER) to find out your position
|
|
;;; in the string. I have not abstracted this functionality into a function since
|
|
;;; it is incompatible with other implementations anyway.
|
|
;;;
|
|
;;; If you want to specify a limit but not an index and can't bring yourself
|
|
;;; to write 0, use NIL instead and the right thing will happen.
|
|
|
|
;;; Bugs/Comments to KMP@MC.
|
|
|
|
;;; Accessors
|
|
|
|
(DEFMACRO SSH-BUFFER (SFA) `(SFA-GET ,SFA 0))
|
|
(DEFMACRO SSH-POINTER (SFA) `(SFA-GET ,SFA 1))
|
|
(DEFMACRO SSH-LIMIT (SFA) `(SFA-GET ,SFA 2))
|
|
|
|
;; Now define the actual handler function.
|
|
(DEFUN STRING-STREAM-HANDLER (SELF OP DATA)
|
|
(CASEQ OP
|
|
(WHICH-OPERATIONS '(TYI UNTYI TYIPEEK INIT-BUFFER INIT-POINTER INIT-LIMIT
|
|
READ-POINTER))
|
|
(INIT-BUFFER (SETF (SSH-BUFFER SELF) DATA))
|
|
(INIT-POINTER (SETF (SSH-POINTER SELF) DATA))
|
|
(INIT-LIMIT (SETF (SSH-LIMIT SELF) DATA))
|
|
(READ-POINTER (SSH-POINTER SELF))
|
|
(TYI (LET ((POINTER (SSH-POINTER SELF)))
|
|
(COND ((= POINTER (SSH-LIMIT SELF)) DATA)
|
|
(T
|
|
(PROG1 (CHAR-N (SSH-BUFFER SELF) POINTER)
|
|
(SETF (SSH-POINTER SELF) (1+ POINTER)))))))
|
|
(UNTYI (LET* ((POINTER (SSH-POINTER SELF))
|
|
(OPOINTER (1- POINTER)))
|
|
(COND ((ZEROP POINTER)
|
|
(ERROR "Can't UNTYI past beginning of buffer"))
|
|
((NOT (= DATA (CHAR-N (SSH-BUFFER SELF) OPOINTER)))
|
|
(ERROR "Char UNTYI'd doesn't match last TYI'd char"
|
|
DATA))
|
|
(T (SETF (SSH-POINTER SELF) OPOINTER)))
|
|
T))
|
|
(TYIPEEK (LET ((POINTER (SSH-POINTER SELF)))
|
|
(COND ((= POINTER (SSH-LIMIT SELF)) DATA)
|
|
(T (CHAR-N (SSH-BUFFER SELF) POINTER)))))
|
|
(T (ERROR "Unsupported SFA operation" `(SFA-CALL ,SELF ,OP ,DATA)))))
|
|
|
|
(EVAL-WHEN (EVAL LOAD COMPILE)
|
|
(COND ((NOT (MEMQ COMPILER-STATE '(NIL TOPLEVEL)))
|
|
(*EXPR STRING-STREAM-HANDLER))))
|
|
|
|
;; Now define a function which creates/uses SFA's with our handler.
|
|
(DEFMACRO WITH-INPUT-FROM-STRING (STREAM-SPEC &BODY BODY)
|
|
(LET (((VAR STRING IDX LIMIT) STREAM-SPEC)
|
|
(TEMP1 (GENSYM))
|
|
(TEMP2 (GENSYM))
|
|
(TEMP3 (GENSYM)))
|
|
`(LET* ((,TEMP1 ,STRING)
|
|
(,TEMP2 ,(OR IDX 0.))
|
|
(,TEMP3 ,(OR LIMIT `(STRING-LENGTH ,TEMP1))))
|
|
(LET ((,VAR (SFA-CREATE #'STRING-STREAM-HANDLER
|
|
3. ;One slot for local storage
|
|
"StringStream")))
|
|
(SFA-CALL ,VAR 'INIT-BUFFER ,TEMP1)
|
|
(SFA-CALL ,VAR 'INIT-POINTER ,TEMP2)
|
|
(SFA-CALL ,VAR 'INIT-LIMIT ,TEMP3)
|
|
,@(IF (NULL BODY) (NCONS NIL)) ;in case null body, want to return NIL
|
|
,@BODY))))
|