omasanori / bf.clj

Created December 19, 2011


    
    View bf.clj 
  
  
      bf.clj
    
    
        Raw
      
    
    File suppressed. Click to show.
  
  
            1
            2
            3
            4
            5
            6
            7
            8
            9
            10
            11
            12
            13
            14
            15
            16
            17
            18
            19
            20
            21
            22
            23
            24
            25
            26
            27
            28
            29
            30
            31
            32
            33
            34
            35
            36
            37
            38
            39
            40
            41
            42
            43
            44
            45
            46
            47
            48
            49
            50
            51
            52
            53
            54
            55
            56
            57
            58
            59
            60
            61
            62
            63
            64
            65
            66
            67
            68
            69
            70
            71
            72
            73
            74
            75
            76
            77
            78
            79
            80
            81
            82
            83
            84
            85
            86
            87
            88
            89
            90
            91
            92
            93
            94
            95
            96
            97
            98
            99
            100
            101
            102
            103
            104
            105
            106
            107
            108
            109
            110
            111
            112
            113
            114
            115
            116
            117
            118
            119
            120
            121
            122
            123
            124
            125
            126
            127
            128
            129
            130
            131
            132
            133
            134
            135
            136
            137
            138
          
          
            ;;; bf.clj --- A Brainfuck interpreter written in Clojure
;; The idea to implement loop instructions without waste of stack
;; is borrowed from a interpreter by Blake Williams, available at
;; https://github.com/BlakeWilliams/Clojure-Brainfuck
 
;;; Data Constructors and Manipulators
;; TODO(omasanori): Consider writing a macro to remove duplication of code.
(defn valid-address?
  "Returns true if `address` is valid, otherwise false."
  [address]
  (and (integer? address)
       (not (neg? address))))
(defn pointer
  "Returns a new pointer."
  []
  (atom 0 :validator valid-address?))
(defn read-pointer
  "Returns the value of `ptr`."
  [ptr]
  (deref ptr))
(defn inc-pointer
  [ptr]
  (swap! ptr inc'))
(defn dec-pointer
  [ptr]
  (swap! ptr dec'))
 
(defn cell
  "Returns a new cell."
  []
  (atom 0 :validator integer?))
(defn read-cell
  [cll]
  (deref cll))
(defn write-cell
  [cll]
  (reset! cll value))
(defn inc-cell
  [cll]
  (swap! cll inc'))
(defn dec-cell
  [cll]
  (swap! cll dec'))
 
;;; Cells and Data Pointer
(def ^:dynamic *data-pointer*
  "Points a cell witch the program can read/write now."
  (pointer))
(def ^:dynamic *cells*
  "Holds cells used by the program."
  (repeatedly cell))
(defn current-cell
  "Returns a cell pointed by *data-pointer*."
  []
  (nth *cells* (read-pointer *data-pointer*)))
 
;;; Instruction Pointer
(def ^:dynamic *inst-pointer*
  "Points a instruction running now."
  (pointer))
(defn current-inst
  "Returns a instruction pointed by *inst-pointer*."
  [program]
  (nth program (read-pointer *inst-pointer*)))
 
;;; Jump Instructions
;; TODO(omasanori): Consider writing a macro to remove duplication of code.
(defn jump-forward
  "Forwards *inst-pointer* to ] which corresponds to current [."
  [program]
  (loop [depth 1]
    (when-not (zero? depth)
      (inc-pointer *inst-pointer*)
      (case (current-inst program)
        \[ (recur (inc' depth))
        \] (recur (dec' depth))
        (recur depth)))))
(defn jump-backward
  "Backs *inst-pointer* to [ corresponds to current ]."
  (loop [depth 1]
    (when-not (zero? depth)
      (dec-pointer *inst-pointer*)
      (case (current-inst program)
        \[ (recur (dec' depth))
        \] (recur (inc' depth))
        (recur depth)))))
 
;;; Input/Output Instructions
(defn read-char
  "Reads a character from *in* and stores to the current cell."
  []
  (write-cell (current-cell) (.read *in*)))
(defn write-char
  "Writes the value of the current cell to *out* as a character."
  []
  (print (char (read-cell (current-cell)))))
 
;;; Interpreter Loop
(defn run*
  "Executes `program` with current thread's *data-pointer*,
  *inst-pointer* and *cells*."
  [program]
  (loop []
    (case (current-inst program)
      \> (inc-pointer *data-pointer*)
      \< (dec-pointer *data-pointer*)
      \+ (inc-cell (current-cell))
      \- (dec-cell (current-cell))
      \, (read-char)
      \. (write-char)
      \[ (when (zero? (read-cell (current-cell)))
           (jump-forward program))
      \] (when-not (zero? (read-cell (current-cell)))
           (jump-backward))
      nil)
    (inc-pointer *inst-pointer*)
    (when-not (= (read-pointer *inst-pointer*) (count program))
      (recur))))
(defn run
  "Executes `program` with new *data-pointer*, *inst-pointer* and
  *cells*."
  [program]
  (binding [*data-pointer* (pointer)
            *inst-pointer* (pointer)
            *cells* (repeatedly cell)]
    (run* program)))
 
;;; Other Utilities
(def hello-world
  "A 'hello world' Brainfuck program borrowed from
  https://gist.github.com/1491858 ."
  "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.")
 
(defn silly-loop
  "Returns a Brainfuck program with `n`-depth loop. Simple implementations
  using recursions for loops will cause stack overflow with enough `n`."
  [n]
  (apply str "+" (concat (repeat n \[) "-" (repeat n \]))))