From 8b43a0d4acf4f21f33e3a9e750e5c579bc40ffe0 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 24 Mar 2016 21:12:14 -0400 Subject: [PATCH] Added (parse-literal-identifier) --- scheme/read.sld | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/scheme/read.sld b/scheme/read.sld index e426dc91..046bbb37 100644 --- a/scheme/read.sld +++ b/scheme/read.sld @@ -392,6 +392,8 @@ (in-port:get-cnum ptbl))))) ;; just another char... (parse fp (cons c tok) toks all? #f parens ptbl))) + ((eq? c #\|) + (parse-literal-identifier fp toks all? parens ptbl)) (else (parse fp (cons c tok) toks all? #f parens ptbl))))) @@ -518,6 +520,31 @@ ((eq? #\| c) (read-block-terminator fp ptbl)) (else (read-block-comment fp ptbl))))) +;; Parse literal identifier encountered within pipes +(define (parse-literal-identifier fp toks all? parens ptbl) + (let ((sym (parse-li-rec fp '() ptbl))) + (if all? + (parse fp '() (cons sym toks) all? #f parens ptbl) + sym))) + +;; Helper for parse-literal-identifier +(define (parse-li-rec fp tok ptbl) + (let ((c (get-next-char fp ptbl)) + (next (lambda (c) (parse-li-rec fp (cons c tok) ptbl)))) + (cond + ((eq? #\| c) + (let ((str (if (null? tok) + "||" + (list->string + (reverse tok))))) + (string->symbol str))) + ((eof-object? c) + (parse-error "EOF encountered parsing literal identifier" + (in-port:get-lnum ptbl) + (in-port:get-cnum ptbl))) + (else + (next c))))) + (define (parse-number fp toks all? parens ptbl base tok->num) ; (parse-number-rec base fp '() ptbl)) (let ((num (parse-number-rec base fp '() ptbl)))