extra/rosetta-code/odd-word/odd-word.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: continuations kernel io io.streams.string unicode ;
   4 IN: rosetta-code.odd-word
   5
   6 ! http://rosettacode.org/wiki/Odd_word_problem
   7
   8 ! Write a program that solves the odd word problem with the
   9 ! restrictions given below.
  10
  11 ! Description: You are promised an input stream consisting of
  12 ! English letters and punctuations. It is guaranteed that
  13
  14 ! * the words (sequence of consecutive letters) are delimited by
  15 !   one and only one punctuation; that
  16 ! * the stream will begin with a word; that
  17 ! * the words will be at least one letter long; and that
  18 ! * a full stop (.) appears after, and only after, the last word.
  19
  20 ! For example, what,is,the;meaning,of:life. is such a stream
  21 ! with six words. Your task is to reverse the letters in every
  22 ! other word while leaving punctuations intact, producing e.g.
  23 ! "what,si,the;gninaem,of:efil.", while observing the following
  24 ! restrictions:
  25
  26 ! Only I/O allowed is reading or writing one character at a
  27 ! time, which means: no reading in a string, no peeking ahead, no
  28 ! pushing characters back into the stream, and no storing
  29 ! characters in a global variable for later use;
  30
  31 ! You are not to explicitly save characters in a collection data
  32 ! structure, such as arrays, strings, hash tables, etc, for later
  33 ! reversal;
  34
  35 ! You are allowed to use recursions, closures, continuations,
  36 ! threads, coroutines, etc., even if their use implies the storage
  37 ! of multiple characters.
  38
  39 ! Test case: work on both the "life" example given above, and
  40 ! the text we,are;not,in,kansas;any,more.
  41
  42 <PRIVATE
  43 ! Save current continuation.
  44 : savecc ( -- continuation/f )
  45     [ ] callcc1 ; inline
  46
  47 ! Jump back to continuation, where savecc will return f.
  48 : jump-back ( continuation -- )
  49     f swap continue-with ; inline
  50 PRIVATE>
  51
  52 :: read-odd-word ( -- )
  53     f :> first-continuation!
  54     f :> last-continuation!
  55     f :> reverse!
  56     ! Read characters. Loop until end of stream.
  57     [ read1 dup ] [
  58         dup Letter? [
  59             ! This character is a letter.
  60             reverse [
  61                 ! Odd word: Write letters in reverse order.
  62                 last-continuation savecc dup [
  63                     last-continuation!
  64                     2drop       ! Drop letter and previous continuation.
  65                 ] [
  66                     ! After jump: print letters in reverse.
  67                     drop                ! Drop f.
  68                     swap write1         ! Write letter.
  69                     jump-back           ! Follow chain of continuations.
  70                 ] if
  71             ] [
  72                 ! Even word: Write letters immediately.
  73                 write1
  74             ] if
  75         ] [
  76             ! This character is punctuation.
  77             reverse [
  78                 ! End odd word. Fix trampoline, follow chain of continuations
  79                 ! (to print letters in reverse), then bounce off trampoline.
  80                 savecc dup [
  81                     first-continuation!
  82                     last-continuation jump-back
  83                 ] [ drop ] if
  84                 write1                  ! Write punctuation.
  85                 f reverse!              ! Begin even word.
  86             ] [
  87                 write1                  ! Write punctuation.
  88                 t reverse!              ! Begin odd word.
  89                 ! Create trampoline to bounce to (future) first-continuation.
  90                 savecc dup [
  91                     last-continuation!
  92                 ] [ drop first-continuation jump-back ] if
  93             ] if
  94         ] if
  95     ] while
  96     ! Drop f from read1. Then print a cosmetic newline.
  97     drop nl ;
  98
  99 : odd-word ( string -- )
 100     [ read-odd-word ] with-string-reader ;