Create compiler for strudel mini-notation

2 files changed, 411 insertions, 0 deletions

diff --git a/src/unheard/strudel/mini_notation_compiler.clj b/src/unheard/strudel/mini_notation_compiler.clj
new file mode 100644
index 0000000..f3f597e
--- /dev/null
+++ b/src/unheard/strudel/mini_notation_compiler.clj
@@ -0,0 +1,252 @@
+(ns unheard.strudel.mini-notation-compiler
+  "Compiler for Strudel mini-notation to unheard.cycles code.
+
+  Note: This namespace excludes clojure.core/compile to avoid naming conflict.
+
+  Translates Strudel's text-based pattern notation into equivalent
+  unheard.cycles expressions.
+
+  Supported syntax:
+  - Spaces: Sequential events (l combinator)
+  - []: Subdivision/grouping (l combinator)
+  - <> : Alternating events (f combinator)
+  - ,: Parallel/simultaneous events (p combinator)
+  - *N: Speed multiplication (rate modifier)
+  - /N: Speed division (rate modifier)
+  - @N: Elongation (elongate modifier)
+  - !N: Replication (rep modifier)
+  - ~: Rest literal (becomes :r)
+
+  Not yet supported:
+  - ?: Probabilistic removal
+  - |: Random selection
+  - (): Euclidean rhythms
+
+  See: https://strudel.cc/learn/mini-notation/
+
+  Examples:
+    (compile \"c e g\")
+    => (l :c :e :g)
+
+    (compile \"c [e g] b\")
+    => (l :c (l :e :g) :b)
+
+    (compile \"<c e g>\")
+    => (f :c :e :g)
+
+    (compile \"[c,e,g] [d,f,a]\")
+    => (l (p :c :e :g) (p :d :f :a))
+
+    (compile \"c*2\")
+    => (rate 2 :c)
+
+    (compile \"c@3\")
+    => (elongate 3 :c)"
+  (:refer-clojure :exclude [compile])
+  (:require [clojure.string :as str]))
+
+(defn- parse-number [s]
+  "Parse a number, returning either a long or ratio."
+  (if (str/includes? s "/")
+    (let [[num denom] (str/split s #"/")]
+      (/ (parse-long num) (parse-long denom)))
+    (parse-long s)))
+
+(declare parse-sequence)
+(declare parse-element)
+
+(defn- parse-atom [s]
+  "Parse a single atom (note, number, or rest)."
+  (cond
+    (= s "~") :r
+    (re-matches #"\d+(/\d+)?" s) (parse-number s)
+    :else (keyword s)))
+
+(defn- apply-modifiers [expr modifiers]
+  "Apply modifiers to an expression.
+  Modifiers is a map with keys: :rate, :elongate, :rep
+  Order: elongate/rep first (innermost), then rate (outermost)"
+  (cond-> expr
+    (:elongate modifiers) (#(list 'elongate (:elongate modifiers) %))
+    (:rep modifiers) (#(list 'rep (:rep modifiers) %))
+    (:rate modifiers) (#(list 'rate (:rate modifiers) %))))
+
+(defn- parse-token-with-modifiers [token]
+  "Parse a token that may have modifiers like *2, /3, @2, !3"
+  (let [;; Extract modifiers (note: /N is division, not a rational number in this context)
+        ;; Check for *N/M first (multiplication with rational)
+        rate-match (re-find #"\*(\d+(?:/\d+)?)" token)
+        ;; Only match /N if it's NOT part of *N/M (no preceding * and digits)
+        div-match (when-not rate-match
+                    (re-find #"/(\d+)" token))
+        elong-match (re-find #"@(\d+(?:/\d+)?)" token)
+        rep-match (re-find #"!(\d+)" token)
+
+        ;; Remove modifiers to get base token
+        base (-> token
+                 (str/replace #"\*\d+(?:/\d+)?" "")
+                 (str/replace #"/\d+" "")
+                 (str/replace #"@\d+(?:/\d+)?" "")
+                 (str/replace #"!\d+" ""))
+
+        modifiers (cond-> {}
+                    rate-match (assoc :rate (parse-number (second rate-match)))
+                    div-match (assoc :rate (list '/ 1 (parse-long (second div-match))))
+                    elong-match (assoc :elongate (parse-number (second elong-match)))
+                    rep-match (assoc :rep (parse-long (second rep-match))))]
+
+    [base modifiers]))
+
+(defn- split-on-comma [s]
+  "Split string on commas at depth 0 (not inside nested brackets).
+  Returns vector of substrings."
+  (loop [chars (seq s)
+         groups []
+         current []
+         depth 0]
+    (if (empty? chars)
+      (conj groups (str/join current))
+      (let [c (first chars)]
+        (cond
+          ;; Track bracket depth
+          (or (= c \[) (= c \<) (= c \())
+          (recur (rest chars) groups (conj current c) (inc depth))
+
+          (or (= c \]) (= c \>) (= c \)))
+          (recur (rest chars) groups (conj current c) (dec depth))
+
+          ;; Comma at depth 0 - split here
+          (and (= c \,) (zero? depth))
+          (if (seq current)
+            (recur (rest chars) (conj groups (str/join current)) [] depth)
+            (recur (rest chars) groups [] depth))
+
+          :else
+          (recur (rest chars) groups (conj current c) depth))))))
+
+(defn- parse-group [s open-char close-char combinator]
+  "Parse a bracketed group with a specific combinator."
+  ;; Find the matching closing bracket, then extract modifiers after it
+  (let [close-idx (.lastIndexOf s (int close-char))
+        brackets-part (subs s 0 (inc close-idx))
+        modifiers-part (subs s (inc close-idx))
+        ;; Extract modifiers from the part AFTER the closing bracket
+        [_ modifiers] (parse-token-with-modifiers modifiers-part)
+        ;; Extract content between brackets
+        inner-content (subs brackets-part 1 close-idx)
+
+        ;; Special handling for angle brackets with commas (polymeter)
+        result (if (and (= combinator 'f) (str/includes? inner-content ","))
+                 ;; Split on commas and parse each group
+                 (let [groups (split-on-comma inner-content)
+                       parsed-groups (map parse-sequence groups)
+                       ;; Zip groups together element-by-element and wrap in parallel
+                       max-length (apply max (map count parsed-groups))
+                       zipped (for [i (range max-length)]
+                                (let [elements (keep #(nth (vec %) i nil) parsed-groups)]
+                                  (if (= 1 (count elements))
+                                    (first elements)
+                                    (cons 'p elements))))]
+                   (if (= 1 (count zipped))
+                     (first zipped)
+                     (cons 'f zipped)))
+                 ;; Normal handling without commas
+                 (let [elements (parse-sequence inner-content)]
+                   (if (= 1 (count elements))
+                     (first elements)
+                     (cons combinator elements))))]
+    (apply-modifiers result modifiers)))
+
+(defn- tokenize [s]
+  "Tokenize a mini-notation string, respecting nested brackets."
+  (loop [chars (seq s)
+         tokens []
+         current []
+         depth 0]
+    (if (empty? chars)
+      (if (seq current)
+        (conj tokens (str/join current))
+        tokens)
+      (let [c (first chars)]
+        (cond
+          ;; Track bracket depth
+          (or (= c \[) (= c \<) (= c \())
+          (recur (rest chars) tokens (conj current c) (inc depth))
+
+          (or (= c \]) (= c \>) (= c \)))
+          (recur (rest chars) tokens (conj current c) (dec depth))
+
+          ;; Space separates tokens only at depth 0
+          (and (= c \space) (zero? depth))
+          (if (seq current)
+            (recur (rest chars) (conj tokens (str/join current)) [] depth)
+            (recur (rest chars) tokens [] depth))
+
+          :else
+          (recur (rest chars) tokens (conj current c) depth))))))
+
+(defn- parse-parallel [token]
+  "Parse comma-separated elements into parallel structure."
+  (if (str/includes? token ",")
+    (let [parts (str/split token #",")
+          elements (map parse-element parts)]
+      (cons 'p elements))
+    (parse-element token)))
+
+(defn- parse-element [token]
+  "Parse a single element (may be atom, group, or have modifiers)."
+  (cond
+    ;; Square brackets - subdivision (l)
+    ;; Check if starts with [ (may have modifiers at end)
+    (str/starts-with? token "[")
+    (parse-group token \[ \] 'l)
+
+    ;; Angle brackets - alternation (f)
+    ;; Check if starts with < (may have modifiers at end)
+    (str/starts-with? token "<")
+    (parse-group token \< \> 'f)
+
+    ;; Contains comma - parallel (p)
+    (str/includes? token ",")
+    (parse-parallel token)
+
+    ;; Token with modifiers
+    :else
+    (let [[base modifiers] (parse-token-with-modifiers token)]
+      (apply-modifiers (parse-atom base) modifiers))))
+
+(defn- parse-sequence [s]
+  "Parse a space-separated sequence."
+  (let [tokens (tokenize s)]
+    (map parse-element tokens)))
+
+(defn compile
+  "Compile a Strudel mini-notation string to unheard.cycles code.
+
+  Returns a quoted expression that can be evaluated in the context
+  where unheard.cycles functions are available.
+
+  Newlines in the input string are automatically converted to spaces
+  to allow for multi-line pattern notation.
+
+  Examples:
+    (compile \"c e g\")
+    => (l :c :e :g)
+
+    (compile \"c [e g] b\")
+    => (l :c (l :e :g) :b)
+
+    (compile \"<c e g b>*2\")
+    => (rate 2 (f :c :e :g :b))
+
+    (compile \"[c,e,g] [d,f,a]\")
+    => (l (p :c :e :g) (p :d :f :a))
+
+    (compile \"<a b\\nc d>\")
+    => (f :a :b :c :d)"
+  [s]
+  (let [normalized (str/replace s #"\n" " ")
+        elements (parse-sequence (str/trim normalized))]
+    (if (= 1 (count elements))
+      (first elements)
+      (cons 'l elements))))
diff --git a/test/unheard/strudel/mini_notation_compiler_test.clj b/test/unheard/strudel/mini_notation_compiler_test.clj
new file mode 100644
index 0000000..04b6347
--- /dev/null
+++ b/test/unheard/strudel/mini_notation_compiler_test.clj
@@ -0,0 +1,159 @@
+(ns unheard.strudel.mini-notation-compiler-test
+  (:refer-clojure :exclude [compile])
+  (:require [clojure.test :refer [deftest is testing]]
+            [unheard.strudel.mini-notation-compiler :refer [compile]]))
+
+(deftest compile-tests
+  (testing "single atom"
+    (is (= :c
+           (compile "c"))))
+
+  (testing "rest literal"
+    (is (= :r
+           (compile "~"))))
+
+  (testing "simple sequence - space separated"
+    (is (= '(l :c :e :g)
+           (compile "c e g"))))
+
+  (testing "sequence with rest"
+    (is (= '(l :c :r :g)
+           (compile "c ~ g"))))
+
+  (testing "subdivision with brackets"
+    (is (= '(l :c (l :e :g) :b)
+           (compile "c [e g] b"))))
+
+  (testing "nested brackets"
+    (is (= '(l :a (l :b (l :c :d)))
+           (compile "a [b [c d]]"))))
+
+  (testing "angle brackets - alternation"
+    (is (= '(f :c :e :g :b)
+           (compile "<c e g b>"))))
+
+  (testing "parallel with commas"
+    (is (= '(p :c :e :g)
+           (compile "c,e,g"))))
+
+  (testing "parallel in sequence"
+    (is (= '(l (p :c :e :g) (p :d :f :a))
+           (compile "[c,e,g] [d,f,a]"))))
+
+  (testing "rate modifier - multiplication"
+    (is (= '(rate 2 :c)
+           (compile "c*2"))))
+
+  (testing "rate modifier - division"
+    (is (= '(rate (/ 1 2) :c)
+           (compile "c/2"))))
+
+  (testing "rate on group"
+    (is (= '(rate 2 (l :e :g))
+           (compile "[e g]*2"))))
+
+  (testing "rate on alternation"
+    (is (= '(rate 2 (f :c :e :g :b))
+           (compile "<c e g b>*2"))))
+
+  (testing "elongate modifier"
+    (is (= '(elongate 3 :c)
+           (compile "c@3"))))
+
+  (testing "elongate in sequence"
+    (is (= '(l (elongate 2 :a) :b :c)
+           (compile "a@2 b c"))))
+
+  (testing "replication modifier"
+    (is (= '(rep 3 :c)
+           (compile "c!3"))))
+
+  (testing "replication in sequence"
+    (is (= '(l (rep 2 :x) :y)
+           (compile "x!2 y"))))
+
+  (testing "multiple modifiers"
+    (is (= '(rate 2 (elongate 3 :c))
+           (compile "c@3*2"))))
+
+  (testing "complex nested structure"
+    (is (= '(l :c (f :e :g) :b :d)
+           (compile "c <e g> b d"))))
+
+  (testing "subdivision with parallel"
+    (is (= '(l :x (p :y :z) :w)
+           (compile "x [y,z] w"))))
+
+  (testing "strudel example from docs"
+    (is (= '(l :e5 (l :b4 :c5) :d5 (l :c5 :b4))
+           (compile "e5 [b4 c5] d5 [c5 b4]"))))
+
+  (testing "chord sequence"
+    (is (= '(rate 2 (f (p :g3 :b3 :e4) (p :a3 :c3 :e4)))
+           (compile "<[g3,b3,e4] [a3,c3,e4]>*2"))))
+
+  (testing "elongated chord"
+    (is (= '(rate 2 (f (elongate 2 (p :g3 :b3 :e4)) (p :a3 :c3 :e4)))
+           (compile "<[g3,b3,e4]@2 [a3,c3,e4]>*2"))))
+
+  (testing "replicated chord"
+    (is (= '(rate 2 (f (rep 2 (p :g3 :b3 :e4)) (p :a3 :c3 :e4)))
+           (compile "<[g3,b3,e4]!2 [a3,c3,e4]>*2"))))
+
+  (testing "rest in subdivision"
+    (is (= '(l :b4 (l :r :c5) :d5 :e5)
+           (compile "b4 [~ c5] d5 e5"))))
+
+  (testing "numbers as values"
+    (is (= '(l 1 2 3)
+           (compile "1 2 3"))))
+
+  (testing "rational number rate"
+    (is (= '(rate 3/2 :c)
+           (compile "c*3/2"))))
+
+  (testing "whitespace handling"
+    (is (= '(l :a :b :c)
+           (compile "  a   b   c  "))))
+
+  (testing "complex real-world pattern"
+    (is (= '(l (rate 2 (f :bd :sd)) (p :hat :hat :hat))
+           (compile "<bd sd>*2 [hat,hat,hat]"))))
+
+  (testing "newlines are converted to spaces"
+    (is (= '(f :a :b :c :d)
+           (compile "<a b\nc d>"))))
+
+  (testing "multi-line pattern with parallel"
+    (is (= '(f (l :a :b) (p :c :d))
+           (compile "<\n[a b]\n[c,d]\n>"))))
+
+  (testing "polymeter - comma in angle brackets zips elements"
+    (is (= '(f (p :a :c) (p :b :d))
+           (compile "<a b, c d>"))))
+
+  (testing "polymeter - three groups"
+    (is (= '(f (p :a :c :e) (p :b :d :f))
+           (compile "<a b, c d, e f>"))))
+
+  (testing "polymeter - unequal lengths pads with nils"
+    (is (= '(f (p :a :c) (p :b :d) :e)
+           (compile "<a b e, c d>"))))
+
+  (testing "polymeter - single element groups"
+    (is (= '(p :a :c)
+           (compile "<a, c>"))))
+
+  (testing "polymeter - with nested structures"
+    (is (= '(f (p (l :a :b) (l :e :f))
+               (p (l :c :d) (l :g :h)))
+           (compile "<[a b] [c d], [e f] [g h]>"))))
+
+  (testing "polymeter - with modifiers"
+    (is (= '(rate 2 (f (p :a :c) (p :b :d)))
+           (compile "<a b, c d>*2"))))
+
+  (testing "polymeter - melody and bass pattern"
+    (is (= '(f (p (l :e5 :b4) (rate 4 (l :e2 :e3)))
+               (p (l :a4 :c5) (rate 4 (l :a2 :a3))))
+           (compile "<[e5 b4] [a4 c5], [[e2 e3]*4] [[a2 a3]*4]>")))))