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.

Advertisements

Pages: 1 2

5 Responses to “Exercise 1-9”

  1. Jussi Piitulainen said

    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

    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

    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

    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

    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 Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: