git » blacktide.git » master » tree

[master] / examples / blacktide / algorithms.clj 

 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
(ns blacktide.algorithms
  "Small parsers and an in-place Hoare partition using mutable lexical locals."
  (:require [com.tailrecursion.blacktide :refer [loophole label goto setq]]))

(defn tokens [^String s]
  (loophole [i 0 word "" out []]
    (label scan)
    (when (= i (count s)) (goto flush))
    (let [c (.charAt s i)]
      (setq i (inc i))
      (if (Character/isWhitespace c)
        (do (when (seq word) (setq out (conj out word)))
            (setq word ""))
        (setq word (str word c))))
    (goto scan)
    (label flush)
    (when (seq word) (setq out (conj out word)))
    out))

(defn partition! [^longs a]
  (when (pos? (alength a))
    (let [pivot (aget a 0)]
      (loophole [left -1 right (alength a)]
        (label scan)
        (setq left (inc left))
        (while (< (aget a left) pivot) (setq left (inc left)))
        (setq right (dec right))
        (while (> (aget a right) pivot) (setq right (dec right)))
        (when (>= left right) (goto done))
        (let [v (aget a left)] (aset-long a left (aget a right)) (aset-long a right v))
        (goto scan)
        (label done) right))))

(defn decimal-prefix [^String s]
  (loophole [i 0 sign 1 value 0N start 0]
    (when (empty? s) (goto done))
    (case (.charAt s 0)
      \- (setq sign -1 i 1)
      \+ (setq i 1)
      nil)
    (setq start i)
    (label digit)
    (when (= i (count s)) (goto done))
    (let [c (.charAt s i)]
      (when-not (<= (int \0) (int c) (int \9)) (goto done))
      (setq value (+ (* value 10) (- (int c) (int \0)))
            i (inc i)))
    (goto digit)
    (label done)
    (when (< start i) [(* sign value) i])))