Exercise 1-9

January 17, 2017

Here’s our solution:

(define (copy)
  (let loop ((c (read-char)) (prev #\p))
    (cond ((eof-object? c))
          ((and (char=? #\space c) (char=? \#space prev))
            (loop (read-char) c))
          (else (display c) (loop (read-char) c)))))

We read standard input and write standard output. C is the next character on standard input and prev is the current character on standard input, initially anything other than a blank. The loop stops in the first cond clause when it sees the end-of-file character, skips a character and goes to the next in the second cond clause when both the current character and the previous character are blanks, and otherwise outputs the current current character and goes to the next in the else clause (which might be the first blank character in a run of blanks, or any other non-blank character).

You can run the program at http://ideone.com/quOgSe, where you will also see sample output.

Pages: 1 2

Posted by programmingpraxis
Filed in Exercises
5 Comments »

5 Responses to “Exercise 1-9”

  1. Jussi Piitulainen said
    January 18, 2017 at 1:15 PM

    This is a state-machine:

    ;; "Tail recursion is its own reward."

(define (state-non i o)
  (let ((x (read-char i)))
    (or (eof-object? x)
	(case x
	  ((#\space #\tab #\newline) (write-char #\space o) (state-spc i o))
	  (else (write-char x o) (state-non i o))))))

(define (state-spc i o)
  (let ((x (read-char i)))
    (or (eof-object? x)
	(case x
	  ((#\space #\tab #\newline) (state-spc i o))
	  (else (write-char x o) (state-non i o))))))

(define (copy)
  (state-non (current-input-port) (current-output-port)))

(copy)

(newline)

    Thus:

    $ guile cp.scm < cp.scm 2> /dev/null
;; "Tail recursion is its own reward." (define (state-non i o) (let ((x (read-char i))) (or (eof-object? x) (case x ((#\space #\tab #\newline) (write-char #\space o) (state-spc i o)) (else (write-char x o) (state-non i o)))))) (define (state-spc i o) (let ((x (read-char i))) (or (eof-object? x) (case x ((#\space #\tab #\newline) (state-spc i o)) (else (write-char x o) (state-non i o)))))) (define (copy) (state-non (current-input-port) (current-output-port))) (copy) (newline) 
$
  2. matthew said
    January 18, 2017 at 10:49 PM

    Well, for K&R we really ought to have a C program: like Jussi we have a state machine, but since gcc doesn’t seem to handle mutual tail recursion well (yet), I thought I was going to have to use gotos, but it can all be nicely done with two loops, one for each state. The first ‘continue’ isn’t necessary of course, but makes for a nice symmetry:

    #include <stdio.h>
#include <stdbool.h>
int main() {
  int c;
  while (true) {
    while (true) {
      if ((c = getchar()) == EOF) return 0;
      if (c == ' ') break;
      putchar(c);
      continue;
    }
    putchar(c);
    while (true) {
      if ((c = getchar()) == EOF) return 0;
      if (c == ' ') continue;
      putchar(c);
      break;
    }
  }
}
  3. matthew said
    January 18, 2017 at 11:11 PM

    This is the assembler for that function (with gcc -03). As you can see, it’s pretty tight:

    main:
	subq	$8, %rsp
	jmp	.L2
.L16:
	movq	stdout(%rip), %rsi
	movl	%eax, %edi
	call	_IO_putc
.L2:
	movq	stdin(%rip), %rdi
	call	_IO_getc
	cmpl	$-1, %eax
	je	.L3
	cmpl	$32, %eax
	jne	.L16
	movq	stdout(%rip), %rsi
	movl	$32, %edi
	call	_IO_putc
.L6:
	movq	stdin(%rip), %rdi
	call	_IO_getc
	cmpl	$-1, %eax
	je	.L3
	cmpl	$32, %eax
	jne	.L16
	jmp	.L6
.L3:
	xorl	%eax, %eax
	addq	$8, %rsp
	ret
  4. Globules said
    January 21, 2017 at 9:27 PM

    Here’s a Haskell version, written in a fairly direct style. I pipe the output of the program to `cat -e`, which indicates end-of-line with a dollar sign.

    import Data.List (group)

squeezeBlanks :: String -> String
squeezeBlanks str = concatMap sqz (group str)
  where sqz cs@(c:_) = if c == ' ' then " " else cs
        sqz     []   = [] -- never called, but eliminates compiler warning

main :: IO ()
main = do
  input <- getContents
  putStr (squeezeBlanks input)

    $ printf "foo bar   baz\n   zot    quux   \n" | ./blanks | cat -e
foo bar baz$
 zot quux $
  5. Globules said
    January 21, 2017 at 9:46 PM

    This is pretty much the same as the previous Haskell program, but golfed just a bit… :-) Fore!

    import Control.Monad ((>=>))
import Data.Bool (bool)
import Data.List (group)

main :: IO ()
main = interact $ group >=> \s@(c:_) -> bool s " " (c == ' ')

    $ printf "foo bar   baz\n   zot    quux   \n" | ./blanksGolfed | cat -e
foo bar baz$
 zot quux $

Leave a comment