From d7abe4f8f54ecc3eff822ff1fab7dd51f857122a Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 25 May 2020 18:20:39 -0400
Subject: [PATCH] Issue #380 - Support optional args to write-string

---
 CHANGELOG.md                  |  1 +
 scheme/base.sld               | 22 ++++++++++++++++++----
 scheme/cyclone/transforms.sld |  4 ++++
 3 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 6370f3f6..65ee847d 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -14,6 +14,7 @@ Bug Fixes
 - Fix `list-copy` to return a non-list object instead of raising an error, per R7RS.
 - Fixed `eqv?` to use R7RS semantics to ensure equality of different instances of the same numeric value. The function was previously just an alias of `eq?`.
 - Support two-argument version of `atan`.
+- Support `start` and `end` arguments to `write-string`.
 
 ## 0.17 - April 6, 2020
 
diff --git a/scheme/base.sld b/scheme/base.sld
index f771290d..73abc406 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -135,6 +135,8 @@
     newline
     write-char
     write-string
+    write-string-1
+    write-string-2
     flush-output-port
     peek-char
     read-char
@@ -716,10 +718,22 @@
       (if (null? port)
         (Cyc-flush-output-port (current-output-port))
         (Cyc-flush-output-port (car port))))
-    (define (write-string str . port)
-      (if (null? port)
-        (Cyc-display str (current-output-port))
-        (Cyc-display str (car port))))
+    (define (write-string-1 str)
+      (Cyc-display str (current-output-port)))
+    (define (write-string-2 str port)
+      (Cyc-display str port))
+    (define (write-string str . opts)
+      (cond
+       ((null? opts)
+        (Cyc-display str (current-output-port)))
+       ((null? (cdr opts))
+        (Cyc-display str (car opts)))
+       (else 
+        (let ((start (cadr opts))
+              (end (if (> (length opts) 2) (caddr opts) (string-length str))))
+          (Cyc-display
+            (substring str start end)
+            (car opts))))))
     (define (read-bytevector k . _port)
       (letrec ((port (if (null? port)
                          (current-input-port)
diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld
index 39e495c1..507da361 100644
--- a/scheme/cyclone/transforms.sld
+++ b/scheme/cyclone/transforms.sld
@@ -1129,6 +1129,10 @@ if (acc) {
            (cons 'Cyc-map-loop-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
           ((and (eq? (car ast) 'map) (= (length ast) 4))
            (cons 'Cyc-map-loop-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'write-string) (= (length ast) 2))
+           (cons 'write-string-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'write-string) (= (length ast) 3))
+           (cons 'write-string-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
           ;; Regular case, alpha convert everything
           (else
            (regular-case)))))