@@ Read more about Whitespace at http : //compsoc . dur . ac . uk/whitespace/index . php

( ns whitespace

( : gen-class )

( : use [ clojure . contrib . duck-streams ] ) )

( defmulti translate class )

( defmulti read-wsl # ( . exists ( java . io . File . % ) ) )

( defn sub

"Because god kills a kitten everytime you write .replaceAll"

[ from to ph ]

( . replaceAll ph from to ) )

( defmethod translate Integer [ n ]

( - >> n

Math/ abs

Integer /toBinaryString

seq

( map # ( if ( = \ 0 % ) " " " \t " ) )

( apply str )

( format "%s%s

" ( if ( pos? n ) " " " \t " ) ) ) )

( defmethod translate clojure . lang . Keyword [ k ]

( k

;; Stack Manipulation

{ : push " "

: dupl "

"

: copy " \t "

: swap "

\t "

: disc "



"

: slid " \t

"

;; Arithmetic

: add " \t "

: sub " \t \t "

: mul " \t

"

: div " \t \t "

: mod " \t \t \t "

;; Heap Access

: store " \t \t "

: retri " \t \t \t "

;; Flow Control

: mark "

"

: call "

\t "

: ju "



"

: jzero "

\t "

: jneg "

\t \t "

: ends "

\t

"

: end "





"

;; I/O

: outc " \t

"

: outi " \t

\t "

: inc " \t

\t "

: ini " \t

\t \t " } ) )

( defmethod translate clojure . lang . LazySeq [ al ]

( apply str ( map translate al ) ) )

( defmethod read-wsl false [ string ]

( - >> string

( sub "#.*" "" )

( re-seq # "[^

\t ]+" )

( map # ( let [ n % ] ( try ( Integer /parseInt n )

( catch Exception e ( keyword n ) ) ) ) ) ) )

( defmethod read-wsl true [ file ]

( read-wsl ( slurp file ) ) )

( def sample-program

"

### This program expects a lowercase character and then prints a rhombus like

### a

### b b

### c c

### b b

### a

## Stores the character a and the user input in 0 and 1

push 0 push 97 store

push 1 inc

## Increments the argument

push 1

push 1 retri

push 1 add

store

## 2 Loops to process

push 1 retri

push 0 retri

sub

## First Loop

mark 1

dupl jzero 2

dupl push 1 retri sub push -1 mul

call 101

push 1 sub

ju 1

mark 2 disc

push 1 retri

push 0 retri

sub

push 1 sub

## Second Loop

mark 3

dupl jzero 4

dupl push 0 retri add push 1 sub

call 101

push 1 sub

ju 3

mark 4

end

## Routine used to print a line containing character (once or twice) and the correct ammount of whitespace

## Input: a character

mark 101

dupl dupl dupl dupl

call 103

outc

push 0 retri sub

jzero 102

call 104

outc

push 1 push 1

mark 102

disc disc

push 10 out

ends

## Calculates how many spaces we are going to need before the first letter

## Input: a character

mark 103

push 1 retri

sub

push -1 mul

push 1 sub

call 105

ends

## Calculates how many spaces we are going to need before the second letter

## Input: a character

mark 104

push 0 retri sub

push 2 mul

push 1 sub

call 105

ends

## Prints N whitespace characters

## Input: an integer

mark 105

dupl

jzero 106

push 32

outc

push 1

sub

ju 105

mark 106

disc

ends

" )