From 7e4645197cc1d74f753b24773ed286f10fd1d32e Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Mon, 26 Dec 2016 16:54:25 -0500 Subject: [PATCH 01/22] streaming parser: tokenizer --- build.boot | 3 +- grammar/README.md | 3 - grammar/barline.bnf | 1 - grammar/clojure-cached.bnf | 1 - grammar/clojure.bnf | 13 - grammar/comments.bnf | 4 - grammar/cram.bnf | 2 - grammar/duration.bnf | 12 - grammar/event-sequence.bnf | 2 - grammar/events.bnf | 52 --- grammar/header.bnf | 1 - grammar/names.bnf | 6 - grammar/numbers.bnf | 3 - grammar/score.bnf | 9 - grammar/variables.bnf | 6 - grammar/voices.bnf | 5 - grammar/whitespace.bnf | 9 - src/alda/parser.clj | 317 ++-------------- src/alda/parser/tokenize.clj | 682 +++++++++++++++++++++++++++++++++++ 19 files changed, 718 insertions(+), 413 deletions(-) delete mode 100644 grammar/README.md delete mode 100644 grammar/barline.bnf delete mode 100644 grammar/clojure-cached.bnf delete mode 100644 grammar/clojure.bnf delete mode 100644 grammar/comments.bnf delete mode 100644 grammar/cram.bnf delete mode 100644 grammar/duration.bnf delete mode 100644 grammar/event-sequence.bnf delete mode 100644 grammar/events.bnf delete mode 100644 grammar/header.bnf delete mode 100644 grammar/names.bnf delete mode 100644 grammar/numbers.bnf delete mode 100644 grammar/score.bnf delete mode 100644 grammar/variables.bnf delete mode 100644 grammar/voices.bnf delete mode 100644 grammar/whitespace.bnf create mode 100644 src/alda/parser/tokenize.clj diff --git a/build.boot b/build.boot index 8745376..2baa31c 100755 --- a/build.boot +++ b/build.boot @@ -1,6 +1,6 @@ (set-env! :source-paths #{"src" "test"} - :resource-paths #{"grammar" "examples"} + :resource-paths #{"examples"} :dependencies '[ ; dev [adzerk/bootlaces "0.1.13" :scope "test"] @@ -11,6 +11,7 @@ ; alda.core [org.clojure/clojure "1.8.0"] + [org.clojure/core.async "0.2.395"] [instaparse "1.4.3"] [com.taoensso/timbre "4.7.4"] [djy "0.1.4"] diff --git a/grammar/README.md b/grammar/README.md deleted file mode 100644 index f2c94b1..0000000 --- a/grammar/README.md +++ /dev/null @@ -1,3 +0,0 @@ -For optimized performance, Alda uses multiple parsers to parse different parts of a score. - -The grammars in this directory are not each complete grammars; Instaparse will fail to build most of them individually because they may refer to rules defined in the other grammars. In `src/alda/parser.clj`, parsers are built using different combinations of the grammars here. diff --git a/grammar/barline.bnf b/grammar/barline.bnf deleted file mode 100644 index 919cee6..0000000 --- a/grammar/barline.bnf +++ /dev/null @@ -1 +0,0 @@ -barline = <"|"> diff --git a/grammar/clojure-cached.bnf b/grammar/clojure-cached.bnf deleted file mode 100644 index 307cf22..0000000 --- a/grammar/clojure-cached.bnf +++ /dev/null @@ -1 +0,0 @@ -clj-expr-cached = <"⚙"> #"clj-expr\d+" <"⚙"> diff --git a/grammar/clojure.bnf b/grammar/clojure.bnf deleted file mode 100644 index 9b42278..0000000 --- a/grammar/clojure.bnf +++ /dev/null @@ -1,13 +0,0 @@ - (* inline clojure expressions *) - -clj-character = <"\\"> ( "newline" / "space" / "tab" / - "formfeed" / "backspace" / "return" / - #"(o|u)\d{4}" / #"." ) - -clj-string = <"\""> inside-clj-string* <"\""> - = !"\"" #".|\n|\r" | "\\\"" - -clj-expr = <"("> inside-clj-expr* <")"> - = !( "(" | ")" | "\"" | "\\" ) - #".|\n|\r" | clj-string | clj-character | clj-expr - diff --git a/grammar/comments.bnf b/grammar/comments.bnf deleted file mode 100644 index 1da1d59..0000000 --- a/grammar/comments.bnf +++ /dev/null @@ -1,4 +0,0 @@ -score = (non-comment | comment | clj-expr)* -comment = <"#"> #".*" <#"(\n|\r|$)+"> - = #"[^\#\(\)]+" - diff --git a/grammar/cram.bnf b/grammar/cram.bnf deleted file mode 100644 index 9ead3e7..0000000 --- a/grammar/cram.bnf +++ /dev/null @@ -1,2 +0,0 @@ -cram = <"{"> events <"}"> duration? - diff --git a/grammar/duration.bnf b/grammar/duration.bnf deleted file mode 100644 index 66fe8cd..0000000 --- a/grammar/duration.bnf +++ /dev/null @@ -1,12 +0,0 @@ -duration = (note-length | seconds | milliseconds) - ( subduration)* - = barline? tie barline? - (note-length | seconds | milliseconds) - -seconds = positive-number <"s"> -milliseconds = positive-number <"ms"> - -note-length = positive-number dots? -dots = #"\.+" - = <"~"> -slur = <"~"> diff --git a/grammar/event-sequence.bnf b/grammar/event-sequence.bnf deleted file mode 100644 index f0df552..0000000 --- a/grammar/event-sequence.bnf +++ /dev/null @@ -1,2 +0,0 @@ -event-sequence = <"["> events? <"]"> - diff --git a/grammar/events.bnf b/grammar/events.bnf deleted file mode 100644 index 2541be9..0000000 --- a/grammar/events.bnf +++ /dev/null @@ -1,52 +0,0 @@ - = events? - = event ( event)* - = event ( event)* - = event-inside-voice ( event-inside-voice)* - = event-inside-voice ( event-inside-voice)* - - (* notes, chords & other events *) - - = single-event | repeat | voices - = single-event | repeat - - = (octave-up | octave-down)* - (chord | note | rest) - (octave-up | octave-down)* | - - octave-change | clj-expr-cached | marker | at-marker | - barline | event-sequence | cram | set-variable | - get-variable - -repeat = single-event <"*"> positive-number - - (* chords, notes, rests *) - -chord = (note | rest) subchord+ - = inside-chord* - <"/"> - inside-chord* - (note | rest) - = octave-change | clj-expr-cached - -note = pitch duration? ( slur)? -rest = <"r"> duration? - - (* pitch *) - -pitch = #"[a-g]" accidental* - = flat | sharp | natural -flat = "-" -sharp = "+" -natural = "_" - - (* octaves *) - - = octave-set | (octave-up | octave-down)+ -octave-set = <"o"> number -octave-up = <">"> -octave-down = <"<"> - - (* markers *) - -marker = <"%"> name -at-marker = <"@"> name diff --git a/grammar/header.bnf b/grammar/header.bnf deleted file mode 100644 index dfcb997..0000000 --- a/grammar/header.bnf +++ /dev/null @@ -1 +0,0 @@ -header = (clj-expr-cached / set-variable / )* diff --git a/grammar/names.bnf b/grammar/names.bnf deleted file mode 100644 index f8f5fb2..0000000 --- a/grammar/names.bnf +++ /dev/null @@ -1,6 +0,0 @@ -(* these rules apply to instrument and marker names, but not variable names *) - - = #"[a-zA-Z]{2}[\w_\-+'()]*" -name = acceptable-name ("." acceptable-name)* -nickname = <"\""> acceptable-name <"\""> - diff --git a/grammar/numbers.bnf b/grammar/numbers.bnf deleted file mode 100644 index 9cb5131..0000000 --- a/grammar/numbers.bnf +++ /dev/null @@ -1,3 +0,0 @@ - = positive-number | negative-number -positive-number = #"[0-9]+" -negative-number = #"-[0-9]+" diff --git a/grammar/score.bnf b/grammar/score.bnf deleted file mode 100644 index 629f2ec..0000000 --- a/grammar/score.bnf +++ /dev/null @@ -1,9 +0,0 @@ -score = header? ( part)* -header = !calls music-data+ -part = calls music-data* -calls = name - ( <"/"> name)* - ( nickname)? - <":"> - = !calls #"[a-zA-Z]*[^a-zA-Z]*([a-zA-Z][^a-zA-Z]+)*" - diff --git a/grammar/variables.bnf b/grammar/variables.bnf deleted file mode 100644 index fc8c959..0000000 --- a/grammar/variables.bnf +++ /dev/null @@ -1,6 +0,0 @@ - = #"[a-zA-Z]{2}[\w_]*" - -get-variable = variable-name - -set-variable = variable-name <"="> - (events-inline / event-sequence) diff --git a/grammar/voices.bnf b/grammar/voices.bnf deleted file mode 100644 index 350efeb..0000000 --- a/grammar/voices.bnf +++ /dev/null @@ -1,5 +0,0 @@ - = voice ( voice)* ( (voice-zero | <#"\z"> | &<"]">)) -voice = voice-number events-inside-voice -voice-number = <"V"> #"[1-9]\d*" <":"> -voice-zero = <"V0:"> - diff --git a/grammar/whitespace.bnf b/grammar/whitespace.bnf deleted file mode 100644 index 9bed244..0000000 --- a/grammar/whitespace.bnf +++ /dev/null @@ -1,9 +0,0 @@ -(* mandatory whitespace *) - -ws = #"\s+" -ws-inline = #"[^\S\n\r]+" - -(* optional whitespace *) - -ows = #"\s*" -ows-inline = #"[^\S\n\r]*" diff --git a/src/alda/parser.clj b/src/alda/parser.clj index b971663..3a38b72 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -1,287 +1,38 @@ (ns alda.parser - (:require [instaparse.core :as insta] - [clojure.string :as str] - [clojure.java.io :as io] - [taoensso.timbre :as log] - [alda.lisp.attributes :as attrs] - [alda.lisp.events :as evts] - [alda.lisp.model.duration :as dur] - [alda.lisp.model.pitch :as pitch] - [alda.lisp.score :as score])) - -(defn- parser-from-grammars - "Builds a parser from any number of BNF grammars, concatenated together." - [& grammars] - (insta/parser (str/join \newline - (map #(slurp (io/resource (str % ".bnf"))) grammars)))) - -(def comment-parser (parser-from-grammars "comments" - "clojure")) - -(def score-parser (parser-from-grammars "score" - "names" - "whitespace")) - -(def header-parser (parser-from-grammars "header" - "events" - "clojure-cached" - "voices" - "event-sequence" - "cram" - "duration" - "barline" - "names" - "numbers" - "variables" - "whitespace")) - -(def part-parser (parser-from-grammars "events" - "clojure-cached" - "voices" - "event-sequence" - "cram" - "duration" - "barline" - "names" - "numbers" - "variables" - "whitespace")) - -(defn check-for-failure - "Determines whether its input is an Instaparse failure, throwing an exception - if it is. If it isn't, passes it through so we can continue parsing." - [x] - (if (insta/failure? x) - (throw (Exception. (pr-str x))) - x)) - -(defn- store-in-cache! - "Parsing an Alda score is a multi-step process that sometimes has to involve - looking at the same entity multiple times, but in different contexts as we - parse the score from inside out. To avoid having to parse the same entity - more than once, we can cache it the first time, storing it back in the text - in a uniquely parseable form, a generated id (gensym) surrounded by ⚙ - (Unicode code point 2699), so we can retrieve it from the cache later." - [cache prefix x] - (let [id (gensym prefix)] - (swap! cache assoc id x) - (str \u2699 id \u2699))) - -(defn- get-from-cache - [cache id] - (get @cache (symbol id))) - -(def number-transforms - {:positive-number #(Integer/parseInt %) - :negative-number #(Integer/parseInt %) - :voice-number #(Integer/parseInt %)}) - -(def name-transforms - {:name #(hash-map :name (apply str %&)) - :nickname #(hash-map :nickname %)}) - -(defn- read-clj-expr - "Reads an inline Clojure expression within Alda code. - - This expression will be evaluated within the `boot.user` context, which has - the vars in `alda.lisp` referred in. - - Returns ready-to-evaluate Clojure code." - [expr] - (read-string (str \( (apply str expr) \)))) - -(def clj-expr-transforms - {:clj-character #(str \\ %) - :clj-string #(str \" (apply str %&) \") - :clj-expr #(read-clj-expr %&)}) - -(defn remove-comments - "Strips comments from a string of Alda code. - - We have to also parse Clojure expressions at this stage in order to avoid - ambiguity between Alda comments and portions of Clojure expressions. But we - don't want to have to parse the Clojure expressions again later, so we cache - them and return them along with the code." - [[input cache]] - (let [code (->> input - comment-parser - check-for-failure - (insta/transform - (merge clj-expr-transforms - {:comment (constantly "\n") - :score #(reduce - (fn [acc x] - (if (string? x) - (str acc x) - (str acc (store-in-cache! - cache "clj-expr" x)))) - "" - %&)})))] - [code cache])) - -(defn separate-parts - "Separates out instrument parts (including subsequent calls to existing - parts)." - [[input cache]] - (->> input - score-parser - check-for-failure - (insta/transform - (merge name-transforms - {:calls (fn [& calls] - (let [names (vec (keep :name calls)) - nickname (some :nickname calls)] - (if nickname - {:names names, :nickname nickname} - {:names names})))})))) - -(defn- lisp-xforms [cache] - {:header #(list* %&) - :events #(list* %&) - :repeat (fn [event n] - (list 'alda.lisp/times n event)) - :event-sequence #(vec (list* %&)) - :cram #(list* 'alda.lisp/cram %&) - :voice (fn [voice-number & events] - (list* 'alda.lisp/voice voice-number events)) - :voice-zero #(list 'alda.lisp/voice 0 - (list 'alda.lisp/end-voices)) - :tie (constantly :tie) - :slur (constantly :slur) - :flat (constantly :flat) - :sharp (constantly :sharp) - :natural (constantly :natural) - :dots #(hash-map :dots (count %)) - :note-length #(list* 'alda.lisp/note-length %&) - :milliseconds #(list 'alda.lisp/ms %) - :seconds #(list 'alda.lisp/ms (* % 1000)) - :duration #(list* 'alda.lisp/duration %&) - :pitch (fn [letter & accidentals] - (list* 'alda.lisp/pitch (keyword letter) accidentals)) - :note #(list* 'alda.lisp/note %&) - :rest #(list* 'alda.lisp/pause %&) - :chord #(list* 'alda.lisp/chord %&) - :octave-set #(list 'alda.lisp/octave %) - :octave-up #(list 'alda.lisp/octave :up) - :octave-down #(list 'alda.lisp/octave :down) - :marker #(list 'alda.lisp/marker (:name %)) - :at-marker #(list 'alda.lisp/at-marker (:name %)) - :barline #(list 'alda.lisp/barline) - :clj-expr-cached #(get-from-cache cache %) - :set-variable (fn [var-name & events] - (list* 'alda.lisp/set-variable (keyword var-name) events)) - :get-variable #(list 'alda.lisp/get-variable (keyword %)) - }) - -(defn- map-xforms [cache] - {:header vector - :events vector - :repeat (fn [event n] - (evts/times n event)) - :event-sequence vector - :cram #(apply evts/cram %&) - :voice (fn [voice-number & events] - (apply evts/voice - voice-number - events)) - :voice-zero #(evts/voice 0 (evts/end-voices)) - :tie (constantly :tie) - :slur (constantly :slur) - :flat (constantly :flat) - :sharp (constantly :sharp) - :natural (constantly :natural) - :dots #(hash-map :dots (count %)) - :note-length #(apply dur/note-length %&) - :milliseconds #(dur/ms %) - :seconds #(dur/ms (* % 1000)) - :duration #(apply dur/duration %&) - :pitch (fn [letter & accidentals] - (apply pitch/pitch - (keyword letter) - accidentals)) - :note #(apply evts/note %&) - :rest #(apply evts/pause %&) - :chord #(apply evts/chord %&) - :octave-set #(attrs/octave %) - :octave-up #(attrs/octave :up) - :octave-down #(attrs/octave :down) - :marker #(evts/marker (:name %)) - :at-marker #(evts/at-marker (:name %)) - :barline #(evts/barline) - :clj-expr-cached #(eval (get-from-cache cache %)) - :set-variable (fn [var-name & events] - (apply evts/set-variable (keyword var-name) events)) - :get-variable #(evts/get-variable (keyword %)) - }) - -(defn parse-header - "Parses the (optional) string of non-instrument-specific events that may - occur at the beginning of an Alda score (e.g. setting variables, global - attributes, inline Clojure code)." - [mode cache header] - (->> header - header-parser - check-for-failure - (insta/transform (merge name-transforms - number-transforms - (case mode - :lisp (lisp-xforms cache) - :map (map-xforms cache) - :events (map-xforms cache)))))) - -(defn parse-part - "Parses the events of a single call to an instrument part." - [mode cache part] - (->> part - part-parser - check-for-failure - (insta/transform (merge name-transforms - number-transforms - (case mode - :lisp (lisp-xforms cache) - :map (map-xforms cache) - :events (map-xforms cache)))))) + (:require [clojure.core.async :refer (chan thread !! close!)] + [clojure.string :as str] + [clojure.java.io :as io] + [taoensso.timbre :as log] + [alda.lisp.attributes :as attrs] + [alda.lisp.events :as evts] + [alda.lisp.model.duration :as dur] + [alda.lisp.model.pitch :as pitch] + [alda.lisp.score :as score] + [alda.parser.tokenize :as token])) (defn parse-input - "Parses a string of Alda code. - - If `mode` is: - - :lisp -- the output is Clojure code using the alda.lisp DSL (default) - :map -- the output is the map of score data that would result from - evaluating the code - :events -- the output is a vector of events, which, when supplied as the - arguments to alda.lisp/score, will result in the aforementioned - map of score data" - [alda-code & [mode]] - (let [mode (or mode :lisp) - cache (atom {})] - (->> [alda-code cache] - remove-comments - separate-parts - (insta/transform - (let [lisp-xforms - {:score #(apply concat '(alda.lisp/score) %&) - :header #(parse-header mode cache (apply str %&)) - :part (fn [names & music-data] - (list - (list* 'alda.lisp/part - names - (parse-part mode - cache - (apply str music-data)))))} - - map-xforms - {:score #(apply score/score %&) - :header #(parse-header mode cache (apply str %&)) - :part (fn [names & music-data] - (apply evts/part - names - (parse-part mode - cache - (apply str music-data))))}] - (case mode - :lisp lisp-xforms - :map map-xforms - :events (assoc map-xforms :score vector))))))) + [input] + (let [chars-ch (chan) + tokens-ch (chan)] + ; feed each character of input to chars-ch + (thread + (doseq [character input] (>!! chars-ch character)) + (>!! chars-ch :EOF) + (close! chars-ch)) + + ; parse tokens from chars-ch and feed them to tokens-ch + (thread + (loop [parser (token/parser tokens-ch)] + (if-let [character (!! tokens-ch (dissoc parser :tokens-ch)) + (close! tokens-ch))))) + + ; temp: print out tokens as they are parsed + (thread + (loop [] + (when-let [token (!!)])) + +(def initial-parser-state + {:state :parsing ; parsing, done, or error + :line 1 + :column 1 + :stack [] ; context for nesting tokens + }) + +(defn parser + [tokens-ch] + (assoc initial-parser-state :tokens-ch tokens-ch)) + +(def token-names + {:accidentals "accidentals" + :clj-char "Clojure character" + :clj-sexp "Clojure S-expression" + :clj-string "Clojure string" + :comment "comment" + :duration "duration" + :event-seq "event sequence" + :name "name" + :note "note" + :note-length "note length" + :note-rest-or-name "note, rest, or name" + :repeat "repeat" + :rest "rest"}) + +(defn current-token-type + [{:keys [stack] :as parser}] + (-> stack peek first)) + +(defn current-token-content + [{:keys [stack] :as parser}] + (-> stack peek second)) + +(defn last-token-type + [{:keys [stack] :as parser}] + (-> stack pop peek first)) + +(defn last-token-content + [{:keys [stack] :as parser}] + (-> stack pop peek second)) + +(defn currently-parsing? + [parser token] + (= (current-token-type parser) token)) + +(defn pop-stack + [parser] + (-> parser (update :stack #(if (empty? %) % (pop %))))) + +(defn emit-token! + [{:keys [tokens-ch] :as parser} & {:keys [token content pop-stack?]}] + (>!! tokens-ch [(or token (current-token-type parser)) + (or content (current-token-content parser))]) + (if pop-stack? + (-> parser pop-stack) + parser)) + +(defn unexpected-char-error + [{:keys [line column] :as parser} character] + (let [parsing (current-token-type parser) + error-msg (format "Unexpected %s%s at line %s, column %s." + (if (= :EOF character) + "EOF" + (format "'%s'" character)) + (if parsing + (str " in " (get token-names parsing parsing)) + "") + line + column)] + (-> parser (emit-token! :token :error :content error-msg) + (assoc :state :error)))) + +(defn caught-error + [parser e] + (-> parser (emit-token! :token :error :content e) + (assoc :state :error))) + +(defn reject-chars + [parser character blacklist] + (when (contains? blacklist character) + (unexpected-char-error parser character))) + +(defn next-line + [parser] + (-> parser (update :line inc) (assoc :column 1))) + +(defn next-column + [parser] + (-> parser (update :column inc))) + +(defn advance + [parser x & [size]] + (cond + (= :EOF x) + parser + + (#{\newline "\n"} x) + (-> parser next-line) + + :else + (-> parser (update :column + (or size 1))))) + +(defn append-to-current-buffer + [{:keys [stack] :as parser} x] + (if-let [[token buffer] (peek stack)] + (update parser :stack #(-> % pop (conj [token (str buffer x)]))) + parser)) + +(defn add-current-buffer-to-last + [{:keys [stack] :as parser}] + (let [[current-token current-buffer] (peek stack) + popped-stack (pop stack) + [last-token last-buffer] (peek popped-stack) + last-buffer+ (str last-buffer current-buffer)] + (-> parser + (assoc :stack (-> popped-stack pop (conj [last-token last-buffer+])))))) + +(defn new-buffer + [parser token] + (-> parser (update :stack conj [token ""]))) + +(defn read-to-buffer + [parser x & [size]] + (-> parser (append-to-current-buffer x) (advance x size))) + +(defn read-to-new-buffer + [parser token x & [size]] + (-> parser (new-buffer token) (read-to-buffer x size))) + +(defn rename-current-token + [{:keys [stack] :as parser} token] + (let [renamed-token (-> stack peek (assoc 0 token))] + (-> parser (update :stack #(-> % pop (conj renamed-token)))))) + +(defn read-chars + [parser character whitelist] + (when (contains? whitelist character) + (-> parser (read-to-buffer character)))) + +(defn discard-buffer + [parser] + (-> parser (update :stack pop))) + +(defn ensure-parsing + "If the parser's state is not :parsing, short-circuits the parser so that the + current state is passed through until the end. + + Otherwise returns nil so that parsing will continue." + [{:keys [state] :as parser}] + (when (not= :parsing state) + parser)) + +(defn finish-parsing + [parser character] + (when (= :EOF character) + (-> parser (assoc :state :done)))) + +(defn ignore-carriage-return + [parser character] + (when (= \return character) + parser)) + +(defn skip-whitespace + [parser character] + (when (#{\newline \space} character) + (advance parser character))) + +(declare read-character!) + +(defn start-parsing + [parser character token + & [{:keys [start-char ignore-first-char buffer-first-char]}]] + (when (or (nil? start-char) + (= start-char character) + (and (set? start-char) (contains? start-char character))) + (let [maybe-advance #(if ignore-first-char + (-> % (advance character)) + %) + maybe-buffer #(if buffer-first-char + (-> % (read-to-buffer character)) + %) + maybe-read #(if (or ignore-first-char buffer-first-char) + % + (-> % (read-character! character)))] + (-> parser (new-buffer token) maybe-advance maybe-buffer maybe-read)))) + +(defn start-parsing-accidentals + [p c] + (start-parsing p c :accidentals)) + +(defn start-parsing-at-marker + [p c] + (start-parsing p c :at-marker {:start-char \@ :ignore-first-char true})) + +(defn start-parsing-clj-char + [p c] + (start-parsing p c :clj-char {:start-char \\})) + +(defn start-parsing-clj-sexp + [p c] + (start-parsing p c :clj-sexp {:start-char \( :buffer-first-char true})) + +(defn start-parsing-clj-string + [p c] + (start-parsing p c :clj-string {:start-char \"})) + +(defn start-parsing-comment + [p c] + (start-parsing p c :comment {:start-char \# :ignore-first-char true})) + +(defn start-parsing-duration + [p c] + (start-parsing p c :duration)) + +(defn start-parsing-marker + [p c] + (start-parsing p c :marker {:start-char \% :ignore-first-char true})) + +(defn start-parsing-nickname + [p c] + (start-parsing p c :nickname {:start-char \" :ignore-first-char true})) + +(defn start-parsing-note-length + [p c] + (start-parsing p c :note-length)) + +(defn start-parsing-note-rest-or-name + [p c] + (start-parsing p c :note-rest-or-name + {:start-char (set (str "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) + :buffer-first-char true})) + +(defn start-parsing-octave-change + [p c] + (start-parsing p c :octave-change {:start-char #{\o \< \>}})) + +(defn start-parsing-repeat + [p c] + (start-parsing p c :repeat {:start-char \* :ignore-first-char true})) + +(defn start-parsing-voice + [p c] + (start-parsing p c :voice {:start-char \V})) + +(declare parse-tie) +(defn parse-accidentals + [parser character] + (when (currently-parsing? parser :accidentals) + (condp contains? character + #{\+ \- \_} + (-> parser (read-to-buffer character)) + + #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (emit-token! :pop-stack? true) + (start-parsing-duration character)) + + #{\~} + (-> parser (emit-token! :pop-stack? true) + (parse-tie character)) + + ; else + (-> parser (emit-token! :pop-stack? true) + (read-character! character))))) + +(defn parse-at-marker + [parser character] + (when (currently-parsing? parser :at-marker) + (if ((set (str "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789_-")) + character) + (-> parser (read-to-buffer character)) + (-> parser (emit-token! :pop-stack? true) + (read-character! character))))) + +(defn parse-barline + [parser character] + (when (= \| character) + (-> parser (read-to-new-buffer :barline character) + (emit-token! :pop-stack? true)))) + +(defn parse-clj-char + [parser character] + (when (currently-parsing? parser :clj-char) + (cond + (empty? (current-token-content parser)) + (-> parser (read-to-buffer character)) + + ((set "0123456789abcdefghijklmnopqrstuvwxyz") character) + (-> parser (read-to-buffer character)) + + :else + (-> parser (read-to-buffer character) add-current-buffer-to-last)))) + +(declare parse-clj-string finish-parsing-clj-sexp) +(defn parse-clj-sexp + [p c] + (when (currently-parsing? p :clj-sexp) + (or (reject-chars p c #{:EOF}) + (read-chars p c #{\newline \space \,}) + (parse-clj-string p c) + (parse-clj-char p c) + (start-parsing-clj-sexp p c) + (start-parsing-clj-string p c) + (start-parsing-clj-char p c) + (finish-parsing-clj-sexp p c) + (read-to-buffer p c)))) + +(defn finish-parsing-clj-sexp + [parser character] + (when (= \) character) + (let [emit-or-continue-parsing-parent + (if (= :clj-sexp (last-token-type parser)) + add-current-buffer-to-last + #(-> % (emit-token! :token :clj-expr :pop-stack? true)))] + (-> parser (read-to-buffer \)) emit-or-continue-parsing-parent)))) + +(defn parse-clj-string + [parser character] + (when (currently-parsing? parser :clj-string) + (cond + (= \\ (last (current-token-content parser))) + (-> parser (read-to-buffer character)) + + (= \" character) + (-> parser (read-to-buffer character) add-current-buffer-to-last) + + :else + (-> parser (read-to-buffer character))))) + +(defn parse-colon + [parser character] + (when (= \: character) + (-> parser (read-to-new-buffer :colon character) + (emit-token! :pop-stack? true)))) + +(defn parse-comment + [parser character] + (when (currently-parsing? parser :comment) + (if (= \newline character) + (-> parser (emit-token! :pop-stack? true) next-line) + (-> parser (read-to-buffer character))))) + +(defn parse-cram-open + [parser character] + (when (= \{ character) + (-> parser (read-to-new-buffer :cram-open character) + (emit-token! :pop-stack? true)))) + +(defn parse-cram-close + [parser character] + (when (= \} character) + (-> parser (read-to-new-buffer :cram-close character) + (emit-token! :pop-stack? true) + (new-buffer :duration)))) + +(defn parse-duration + [p c] + (when (currently-parsing? p :duration) + (condp contains? c + #{\space \newline} + (-> p (advance c)) + + #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> p (start-parsing-note-length c)) + + #{\|} + (-> p (parse-barline c)) + + #{\~} + (-> p (parse-tie c)) + + ; else + (-> p discard-buffer (read-character! c))))) + +(defn parse-equals + [parser character] + (when (= \= character) + (-> parser (read-to-new-buffer :equals character) + (emit-token! :pop-stack? true)))) + +(defn parse-event-seq-open + [parser character] + (when (= \[ character) + (-> parser (read-to-new-buffer :event-seq-open character) + (emit-token! :pop-stack? true)))) + +(defn parse-event-seq-close + [parser character] + (when (= \] character) + (-> parser (read-to-new-buffer :event-seq-close character) + (emit-token! :pop-stack? true)))) + +(defn parse-marker + [parser character] + (when (currently-parsing? parser :marker) + (if ((set (str "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789_-")) + character) + (-> parser (read-to-buffer character)) + (-> parser (emit-token! :pop-stack? true) + (read-character! character))))) + +(defn parse-name + [parser character] + (when (currently-parsing? parser :name) + (if ((set (str "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789_-")) + character) + (-> parser (read-to-buffer character)) + (-> parser (emit-token! :pop-stack? true) + (read-character! character))))) + +(defn parse-newline + [parser character] + (when (= \newline character) + (-> parser (read-to-new-buffer :newline character) + (emit-token! :pop-stack? true)))) + +(defn parse-nickname + [parser character] + (when (currently-parsing? parser :nickname) + (let [buffer (current-token-content parser)] + (cond + (= \" character) + (-> parser (emit-token! :pop-stack? true) + (advance character)) + + ((set (str "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "0123456789_-")) + character) + (-> parser (read-to-buffer character)) + + :else + (unexpected-char-error parser character))))) + +(defn parse-note + [parser character] + (when (currently-parsing? parser :note) + (let [note-letter (current-token-content parser)] + (condp contains? character + #{\+ \- \_} + (-> parser (emit-token! :pop-stack? true) + (start-parsing-accidentals character)) + + #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (emit-token! :pop-stack? true) + (start-parsing-duration character)) + + #{\~} + (-> parser (emit-token! :pop-stack? true) + (parse-tie character)) + + ; else + (-> parser (emit-token! :pop-stack? true) + (read-character! character)))))) + +(defn parse-note-length + [parser character] + (when (currently-parsing? parser :note-length) + (let [buffer (current-token-content parser)] + (condp contains? character + #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (read-to-buffer character)) + + #{\.} + (if (re-matches #"\d+\.*" buffer) + (-> parser (read-to-buffer character)) + (-> parser (unexpected-char-error character))) + + #{\m} + (if (re-matches #"\d+" buffer) + (-> parser (read-to-buffer character)) + (-> parser (unexpected-char-error character))) + + #{\s} + (if (re-matches #"\d+m?" buffer) + (-> parser (read-to-buffer character)) + (-> parser (unexpected-char-error character))) + + ; else + (-> parser (emit-token! :pop-stack? true) + (start-parsing-duration character)))))) + +(defn parse-note-rest-or-name + "Parse a character that could be part of: + - a variable name + - a note + - a rest + - an instrument call" + [parser character] + (when (currently-parsing? parser :note-rest-or-name) + (let [buffer (current-token-content parser) + char1 (first buffer) + parse #(-> %1 (rename-current-token %2) + (read-character! character))] + (cond + (and ((set "abcdefg") char1) + ((conj (set " \n+-_/~*}]0123456789") :EOF) character)) + (-> parser (parse :note)) + + (and (= \r char1) + ((set " \n/~0123456789") character)) + (-> parser (parse :rest)) + + ((set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") character) + (-> parser (parse :name)) + + :else + (-> parser (unexpected-char-error character)))))) + +(defn parse-repeat + [parser character] + (let [buffer (current-token-content parser)] + (when (currently-parsing? parser :repeat) + (cond + (#{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} character) + (-> parser (read-to-buffer character)) + + (re-matches #"\d+" buffer) + (-> parser (emit-token! :pop-stack? true) + (read-character! character)) + + (#{\space \newline} character) + (-> parser (advance character)) + + :else + (-> parser (unexpected-char-error character)))))) + +(defn parse-rest + [parser character] + (when (currently-parsing? parser :rest) + (let [note-letter (current-token-content parser)] + (condp contains? character + #{\space \newline :EOF} + (-> parser (advance character) (emit-token! :pop-stack? true)) + + #{\1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (emit-token! :pop-stack? true) + (start-parsing-duration character)) + + ; else + (-> parser (unexpected-char-error character)))))) + +(defn parse-slash + [parser character] + (when (= \/ character) + (-> parser (read-to-new-buffer :slash character) + (emit-token! :pop-stack? true)))) + +(defn parse-tie + [parser character] + (when (= \~ character) + (-> parser (read-to-new-buffer :tie character) + (emit-token! :pop-stack? true)))) + +(defn parse-voice + [parser character] + (when (currently-parsing? parser :voice) + (let [buffer (current-token-content parser)] + (condp re-matches buffer + #"" + (if (= \V character) + (-> parser (read-to-buffer character)) + (-> parser (unexpected-char-error character))) + + #"V" + (condp contains? character + #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (read-to-buffer character)) + + (set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") + (-> parser (rename-current-token :name) + (read-character! character)) + + ; else + (-> parser (unexpected-char-error character))) + + #"V\d+" + (condp contains? character + #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (read-to-buffer character)) + + #{\:} + (-> parser (emit-token! :pop-stack? true) + (advance character))))))) + +(defn parse-octave-change + [parser character] + (when (currently-parsing? parser :octave-change) + (let [buffer (current-token-content parser)] + (condp re-matches buffer + #"" + (condp contains? character + #{\o} + (-> parser (read-to-buffer character)) + + #{\< \>} + (-> parser (read-to-buffer character) (emit-token! :pop-stack? true)) + + ; else + (-> parser (unexpected-char-error character))) + + #"o" + (condp contains? character + #{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (read-to-buffer character)) + + (set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") + (-> parser (rename-current-token :name) + (read-character! character)) + + ; else + (-> parser (unexpected-char-error character))) + + #"o-?\d+" + (condp contains? character + #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9} + (-> parser (read-to-buffer character)) + + #{\space \newline :EOF} + (-> parser (emit-token! :pop-stack? true) (advance character)) + + ; else + (-> parser (unexpected-char-error character))))))) + +(defn read-character! + "Reads one character `c` and updates parser `p`. + + Puts tokens on (:tokens-ch p) as they are parsed." + [p c] + (try + (or (ensure-parsing p) + (ignore-carriage-return p c) + (parse-comment p c) + (parse-clj-sexp p c) + (parse-clj-string p c) + (parse-clj-char p c) + (parse-note p c) + (parse-rest p c) + (parse-name p c) + (parse-nickname p c) + (parse-voice p c) + (parse-octave-change p c) + (parse-marker p c) + (parse-at-marker p c) + (parse-note-rest-or-name p c) + (parse-duration p c) + (parse-note-length p c) + (parse-accidentals p c) + (parse-repeat p c) + (parse-slash p c) + (parse-colon p c) + (parse-barline p c) + (parse-equals p c) + (parse-newline p c) + (parse-cram-open p c) + (parse-cram-close p c) + (parse-event-seq-open p c) + (parse-event-seq-close p c) + (start-parsing-clj-sexp p c) + (start-parsing-comment p c) + (start-parsing-voice p c) + (start-parsing-octave-change p c) + (start-parsing-marker p c) + (start-parsing-at-marker p c) + (start-parsing-note-rest-or-name p c) + (start-parsing-nickname p c) + (start-parsing-repeat p c) + (finish-parsing p c) + (skip-whitespace p c) + (unexpected-char-error p c)) + (catch Throwable e + (caught-error p e)))) From 03dd2477b5e0ff2c5c77c914b4696f6b7d692b17 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Sat, 14 Jan 2017 15:51:27 -0500 Subject: [PATCH 02/22] WIP: scaffolding for event parser --- src/alda/parser.clj | 67 ++++++++++++++++++++++++++++---- src/alda/parser/parse_events.clj | 52 +++++++++++++++++++++++++ 2 files changed, 112 insertions(+), 7 deletions(-) create mode 100644 src/alda/parser/parse_events.clj diff --git a/src/alda/parser.clj b/src/alda/parser.clj index 3a38b72..b7971df 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -8,9 +8,30 @@ [alda.lisp.model.duration :as dur] [alda.lisp.model.pitch :as pitch] [alda.lisp.score :as score] - [alda.parser.tokenize :as token])) + [alda.parser.tokenize :as token] + [alda.parser.parse-events :as event])) -(defn parse-input +(defn print-stream + "Continuously reads from a channel and prints what is received, stopping once + the channel is closed." + [channel] + (thread + (loop [] + (when-let [x (!! tokens-ch (dissoc parser :tokens-ch)) + ; close channel (close! tokens-ch))))) - ; temp: print out tokens as they are parsed + tokens-ch)) + +(defn parse-events + "Asynchronously reads tokens from a channel, parsing events and streaming + them into a new channel. + + Returns a channel from which events can be read as they are parsed." + [tokens-ch] + (let [events-ch (chan)] (thread - (loop [] - (when-let [token (!! events-ch (dissoc token :tokens-ch)) + ; put final event-parser state on the channel + (>!! events-ch (dissoc parser :events-ch)) + ; close channel + (close! events-ch)) + + :else + (recur (event/read-token! parser token)))))) + + events-ch)) + +(defn parse-input + [input] + ; temp: print out tokens as they are parsed + (-> input tokenize parse-events print-stream)) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj new file mode 100644 index 0000000..6ef1eaa --- /dev/null +++ b/src/alda/parser/parse_events.clj @@ -0,0 +1,52 @@ + +(ns alda.parser.parse-events + (:require [clojure.core.async :refer (>!!)])) + +(def initial-parser-state + {:state :parsing ; parsing, done, or error + ; TODO + }) + +(defn emit-event! + [{:keys [events-ch] :as parser} event] + (>!! events-ch event) + parser) + +(defn parser + [events-ch] + (assoc initial-parser-state :events-ch events-ch)) + +(defn ensure-parsing + "If the parser's state is not :parsing, short-circuits the parser so that the + current state is passed through until the end. + + Otherwise returns nil so that parsing will continue." + [{:keys [state] :as parser}] + (when (not= :parsing state) + parser)) + +(defn finish-parsing + [parser character] + (when (= :EOF character) + (-> parser (assoc :state :done)))) + +(defn caught-error + [parser e] + (-> parser (emit-event! e) (assoc :state :error))) + +(defn unexpected-token-error + [parser token] + (let [error-msg (format "Unexpected token: %s." token)] + (-> parser (emit-event! (Exception. error-msg)) (assoc :state :error)))) + +(defn read-token! + "Reads one token `t` and updates parser `p`. + + Puts events on (:events-ch p) as they are parsed." + [p t] + (try + (or (ensure-parsing p) + (finish-parsing p t) + (unexpected-token-error p t)) + (catch Throwable e + (caught-error p t)))) From ac4cd46f53d41b0264f0a21755e4fb53afa8494b Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Sun, 15 Jan 2017 14:14:23 -0500 Subject: [PATCH 03/22] simplify, don't put final parser state on the stream --- src/alda/parser.clj | 28 ++++++---------------------- 1 file changed, 6 insertions(+), 22 deletions(-) diff --git a/src/alda/parser.clj b/src/alda/parser.clj index b7971df..7f7e492 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -47,9 +47,7 @@ (if-let [character (!! tokens-ch (dissoc parser :tokens-ch)) - ; close channel + (>!! tokens-ch :EOF) (close! tokens-ch))))) tokens-ch)) @@ -63,25 +61,11 @@ (let [events-ch (chan)] (thread (loop [parser (event/parser events-ch)] - (let [token (!! events-ch (dissoc token :tokens-ch)) - ; put final event-parser state on the channel - (>!! events-ch (dissoc parser :events-ch)) - ; close channel - (close! events-ch)) - - :else - (recur (event/read-token! parser token)))))) - + (if-let [token (!! events-ch :EOF) + (close! events-ch))))) events-ch)) (defn parse-input From 9114a53243d20368d78d5dec3d9aeea0ed4beacf Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Sun, 15 Jan 2017 15:01:47 -0500 Subject: [PATCH 04/22] include line & column number when emitting tokens --- src/alda/parser/parse_events.clj | 26 ++++++++++++++++++-------- src/alda/parser/tokenize.clj | 30 +++++++++++++++++++----------- 2 files changed, 37 insertions(+), 19 deletions(-) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj index 6ef1eaa..1b80e90 100644 --- a/src/alda/parser/parse_events.clj +++ b/src/alda/parser/parse_events.clj @@ -1,10 +1,11 @@ - (ns alda.parser.parse-events - (:require [clojure.core.async :refer (>!!)])) + (:require [clojure.core.async :refer (>!!)] + [alda.parser.tokenize :refer (token-names)])) -(def initial-parser-state - {:state :parsing ; parsing, done, or error - ; TODO +(defn initial-parser-state + [& [initial-context]] + {:state :parsing + :stack [[(or initial-context :header)]] ; context for nesting events }) (defn emit-event! @@ -13,8 +14,9 @@ parser) (defn parser - [events-ch] - (assoc initial-parser-state :events-ch events-ch)) + [events-ch & [initial-context]] + (-> (initial-parser-state initial-context) + (assoc :events-ch events-ch))) (defn ensure-parsing "If the parser's state is not :parsing, short-circuits the parser so that the @@ -36,7 +38,15 @@ (defn unexpected-token-error [parser token] - (let [error-msg (format "Unexpected token: %s." token)] + (let [error-msg (if (sequential? token) + (let [[token [line column] content] token] + (format "Unexpected %s at line %s, column %s." + (if (= :EOF token) + "EOF" + (get token-names token token)) + line + column)) + (format "Unexpected token: %s." token))] (-> parser (emit-event! (Exception. error-msg)) (assoc :state :error)))) (defn read-token! diff --git a/src/alda/parser/tokenize.clj b/src/alda/parser/tokenize.clj index dab983d..abcb8ca 100644 --- a/src/alda/parser/tokenize.clj +++ b/src/alda/parser/tokenize.clj @@ -31,17 +31,21 @@ [{:keys [stack] :as parser}] (-> stack peek first)) -(defn current-token-content +(defn starting-line-and-column [{:keys [stack] :as parser}] (-> stack peek second)) +(defn current-token-content + [{:keys [stack] :as parser}] + (-> stack peek (nth 2))) + (defn last-token-type [{:keys [stack] :as parser}] (-> stack pop peek first)) (defn last-token-content [{:keys [stack] :as parser}] - (-> stack pop peek second)) + (-> stack pop peek (nth 2))) (defn currently-parsing? [parser token] @@ -54,6 +58,7 @@ (defn emit-token! [{:keys [tokens-ch] :as parser} & {:keys [token content pop-stack?]}] (>!! tokens-ch [(or token (current-token-type parser)) + (starting-line-and-column parser) (or content (current-token-content parser))]) (if pop-stack? (-> parser pop-stack) @@ -106,22 +111,25 @@ (defn append-to-current-buffer [{:keys [stack] :as parser} x] - (if-let [[token buffer] (peek stack)] - (update parser :stack #(-> % pop (conj [token (str buffer x)]))) + (if-let [[token [line col] buffer] (peek stack)] + (update parser :stack #(-> % pop (conj [token [line col] (str buffer x)]))) parser)) (defn add-current-buffer-to-last [{:keys [stack] :as parser}] - (let [[current-token current-buffer] (peek stack) - popped-stack (pop stack) - [last-token last-buffer] (peek popped-stack) - last-buffer+ (str last-buffer current-buffer)] + (let [[current-token current-line-col current-buffer] (peek stack) + popped-stack (pop stack) + [last-token last-line-col last-buffer] (peek popped-stack) + last-buffer+ (str last-buffer + current-buffer)] (-> parser - (assoc :stack (-> popped-stack pop (conj [last-token last-buffer+])))))) + (assoc :stack (-> popped-stack pop (conj [last-token + last-line-col + last-buffer+])))))) (defn new-buffer - [parser token] - (-> parser (update :stack conj [token ""]))) + [{:keys [line column] :as parser} token] + (-> parser (update :stack conj [token [line column] ""]))) (defn read-to-buffer [parser x & [size]] From 5907521815216b43dc93c3a3fc2ea5bb142aa558 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Fri, 20 Jan 2017 11:20:57 -0500 Subject: [PATCH 05/22] WIP: event parser --- src/alda/parser.clj | 6 +- src/alda/parser/parse_events.clj | 300 +++++++++++++++++++++++++++++-- src/alda/parser/tokenize.clj | 3 + 3 files changed, 295 insertions(+), 14 deletions(-) diff --git a/src/alda/parser.clj b/src/alda/parser.clj index 7f7e492..dedd772 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -43,11 +43,11 @@ ; parse tokens from chars-ch and feed them to tokens-ch (thread - (loop [parser (token/parser tokens-ch)] + (loop [{:keys [line column] :as parser} (token/parser tokens-ch)] (if-let [character (!! tokens-ch :EOF) + (>!! tokens-ch [:EOF [line column]]) (close! tokens-ch))))) tokens-ch)) @@ -64,7 +64,7 @@ (if-let [token (!! events-ch :EOF) + (prn :final-parser-state (dissoc parser :events-ch)) (close! events-ch))))) events-ch)) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj index 1b80e90..b8eef29 100644 --- a/src/alda/parser/parse_events.clj +++ b/src/alda/parser/parse_events.clj @@ -1,22 +1,159 @@ (ns alda.parser.parse-events (:require [clojure.core.async :refer (>!!)] + [alda.lisp.events :as evts] [alda.parser.tokenize :refer (token-names)])) (defn initial-parser-state - [& [initial-context]] - {:state :parsing - :stack [[(or initial-context :header)]] ; context for nesting events + [] + {:state :parsing + :stack [] }) -(defn emit-event! +(defn parser + [events-ch] + (-> (initial-parser-state) + (assoc :events-ch events-ch))) + +(defn current-event + [{:keys [stack] :as parser}] + (-> stack peek)) + +(defn current-event-type + [{:keys [stack] :as parser}] + (-> stack peek :type)) + +(defn current-event-content + [{:keys [stack] :as parser}] + (-> stack peek :content)) + +(defn previous-event-type + [{:keys [stack] :as parser}] + (when-not (empty? stack) + (-> stack pop peek :type))) + +(defn previous-event-content + [{:keys [stack] :as parser}] + (when-not (empty? stack) + (-> stack pop peek :content))) + +(defn token-is + [token-type token] + (and (sequential? token) (= token-type (first token)))) + +(defn token-type + [token] + (when (sequential? token) (first token))) + +(defn token-content + [[_ _ content :as token]] + content) + +(defmulti emit-event! (fn [parser event] (:type event))) + +(defmethod emit-event! :default [{:keys [events-ch] :as parser} event] (>!! events-ch event) parser) -(defn parser - [events-ch & [initial-context]] - (-> (initial-parser-state initial-context) - (assoc :events-ch events-ch))) +(defmethod emit-event! :event-seq + [parser {:keys [content] :as event}] + (doseq [event content] (emit-event! parser event)) + parser) + +(defn pop-and-emit-event! + [{:keys [stack] :as parser}] + (if-let [event (peek stack)] + (-> parser (emit-event! event) (update :stack pop)) + parser)) + +(defn append-to-parent + "Given a stack like [[:event-seq] [:note ...]], + + if no `value` arg is provided, appends the top of the stack to the event + below: [[:event-seq [:note ...]]] + + if a `value` arg is provided, pops the stack and appends the custom value + to the item below: [[:event-seq 'some-custom-value]]" + [{:keys [stack] :as parser} & [value]] + (let [value (or value (peek stack)) + parent (-> stack pop peek) + parent+value (update parent :content conj value)] + (-> parser (update :stack #(-> % pop pop (conj parent+value)))))) + +(defn append-to-current-event + [{:keys [stack] :as parser} event] + (let [current-event (peek stack) + appended-event (update current-event :content conj event)] + (-> parser (update :stack #(-> % pop (conj appended-event)))))) + +(defn open-event? + [event-type] + (fn [{:keys [stack] :as parser}] + (->> stack + (filter (fn [{:keys [type open?]}] (and (= event-type type) open?))) + last))) + +(def open-event-seq? (open-event? :event-seq)) +(def open-set-variable? (open-event? :set-variable)) + +(defn last-open-event + [{:keys [stack] :as parser}] + (->> stack + (filter :open?) + last)) + +(defn push-event + [{:keys [stack] :as parser} {:keys [type] :as event}] + (cond + (last-open-event parser) + (-> parser (update :stack conj event)) + + :else + (-> parser pop-and-emit-event! (update :stack conj event)))) + +(defn rename-current-event + [{:keys [stack] :as parser} new-name] + (let [current-event (-> stack peek (assoc :type new-name))] + (-> parser (update :stack #(-> % pop (conj current-event)))))) + +(defn open-current-event + [{:keys [stack] :as parser}] + (let [current-event (-> stack peek (assoc :open? true))] + (-> parser (update :stack #(-> % pop (conj current-event)))))) + +(defn push-set-variable + [{:keys [stack] :as parser}] + {:pre [(= :set-variable (:type (last-open-event parser)))]} + (let [var-events (->> stack + reverse + (take-while #(not= :set-variable (:type %))) + reverse) + {var-name :content} (->> stack + reverse + (drop-while #(not= :set-variable (:type %))) + first) + set-var-event {:type :set-variable + :content [var-name var-events]}] + (-> parser + (update :stack #(->> % + (drop-last (inc (count var-events))) + vec)) + (push-event set-var-event)))) + +(defn push-event-seq + [{:keys [stack] :as parser}] + {:pre [(= :event-seq (:type (last-open-event parser)))]} + (let [seq-events (->> stack + reverse + (take-while #(not (and (= :event-seq (:type %)) + (:open? %)))) + reverse)] + (-> parser + (update :stack #(->> % + (drop-last (inc (count seq-events))) + vec)) + (push-event {:type :event-seq + :content seq-events})))) (defn ensure-parsing "If the parser's state is not :parsing, short-circuits the parser so that the @@ -34,7 +171,7 @@ (defn caught-error [parser e] - (-> parser (emit-event! e) (assoc :state :error))) + (-> parser (emit-event! [:error e]) (assoc :state :error))) (defn unexpected-token-error [parser token] @@ -47,7 +184,133 @@ line column)) (format "Unexpected token: %s." token))] - (-> parser (emit-event! (Exception. error-msg)) (assoc :state :error)))) + (-> parser (emit-event! [:error error-msg]) (assoc :state :error)))) + +(defn ignore-comment + [parser token] + (when (token-is :comment token) + parser)) + +(declare parse-note-length parse-tie parse-barline read-token!) + +(defn parse-accidentals + [parser token] + (when (token-is :accidentals token) + (if (= :note (current-event-type parser)) + (-> parser (append-to-current-event {:type :accidentals + :content (token-content token)})) + (-> parser (unexpected-token-error token))))) + +(defn parse-barline + [parser token] + (when (token-is :barline token) + (if (= :note (current-event-type parser)) + (-> parser (append-to-current-event {:type :barline})) + (-> parser (push-event {:type :barline}))))) + +(defn parse-clj-expr + [parser token] + (when (token-is :clj-expr token) + (let [clj-expr (token-content token)] + (-> parser (push-event {:type :clj-expr + :content (token-content token)}))))) + +(defn parse-name + [parser token] + (when (token-is :name token) + (-> parser (push-event {:type :name + :content (token-content token)})))) + +(defn parse-note-length + [parser token] + (when (token-is :note-length token) + (if (#{:note :rest} (current-event-type parser)) + (-> parser (append-to-current-event {:type :note-length + :content (token-content token)})) + (-> parser (unexpected-token-error token))))) + +(defn parse-octave-change + [parser token] + (when (token-is :octave-change token) + (-> parser (push-event {:type :octave-change + :content (token-content token)})))) + +(def ^:private repeatable? + ; TODO: include all the things that can be repeated + #{:clj-expr :note :rest :chord :event-seq :get-variable}) + +(defn parse-repeat + [{:keys [stack] :as parser} token] + (when (token-is :repeat token) + (if (and (repeatable? (current-event-type parser)) + (not (:open? (current-event parser)))) + (let [repeats (Integer/parseInt (token-content token)) + events-to-repeat (peek stack)] + (-> parser + (update :stack pop) + (push-event {:type :repeat + :content [repeats events-to-repeat]}))) + (-> parser (unexpected-token-error token))))) + +(defn parse-tie + [parser token] + (when (token-is :tie token) + (if (#{:note :rest} (current-event-type parser)) + (-> parser (append-to-current-event {:type :tie})) + (-> parser (unexpected-token-error token))))) + +(defn start-parsing-names + [parser token] + (when (token-is :slash token) + (-> parser + (rename-current-event :names)))) + +(defn start-parsing-note + [parser token] + (when (token-is :note token) + (-> parser (push-event {:type :note + :content [{:type :pitch + :content (token-content token)}]})))) + +(defn start-parsing-rest + [parser token] + (when (token-is :rest token) + (-> parser (push-event {:type :rest})))) + +(defn start-parsing-set-variable + [parser token] + (when (token-is :equals token) + (if (= :name (current-event-type parser)) + (-> parser (-> (rename-current-event :set-variable) open-current-event)) + (-> parser (unexpected-token-error token))))) + +(defn start-parsing-event-seq + [parser token] + (when (token-is :event-seq-open token) + (-> parser (push-event {:type :event-seq}) open-current-event))) + +(defn finish-parsing-event-seq + [parser token] + (when (token-is :event-seq-close token) + (-> parser push-event-seq))) + +(defn handle-newline + [parser token] + (when (token-is :newline token) + (let [open-event (last-open-event parser)] + (if (= :set-variable (:type open-event)) + (-> parser push-set-variable) + parser)))) + +(defn disambiguate-name + [p t] + (when (= :name (current-event-type p)) + (case (token-type t) + :equals (start-parsing-set-variable p t) + :slash (start-parsing-names p t) + (-> p + (rename-current-event :get-variable) + (read-token! t))))) (defn read-token! "Reads one token `t` and updates parser `p`. @@ -56,7 +319,22 @@ [p t] (try (or (ensure-parsing p) + (ignore-comment p t) + (handle-newline p t) + (disambiguate-name p t) + (parse-accidentals p t) + (parse-barline p t) + (parse-clj-expr p t) + (parse-name p t) + (parse-note-length p t) + (parse-octave-change p t) + (parse-repeat p t) + (parse-tie p t) + (start-parsing-note p t) + (start-parsing-rest p t) + (start-parsing-event-seq p t) + (finish-parsing-event-seq p t) (finish-parsing p t) (unexpected-token-error p t)) (catch Throwable e - (caught-error p t)))) + (caught-error p e)))) diff --git a/src/alda/parser/tokenize.clj b/src/alda/parser/tokenize.clj index abcb8ca..ce9e96c 100644 --- a/src/alda/parser/tokenize.clj +++ b/src/alda/parser/tokenize.clj @@ -16,9 +16,12 @@ {:accidentals "accidentals" :clj-char "Clojure character" :clj-sexp "Clojure S-expression" + :clj-expr "Clojure expression" :clj-string "Clojure string" + :colon "':'" :comment "comment" :duration "duration" + :equals "'='" :event-seq "event sequence" :name "name" :note "note" From 0d610de5deaf111de2e480a363e405fe4a1b132d Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Fri, 24 Mar 2017 09:31:30 -0400 Subject: [PATCH 06/22] use clojure.tools.namespace to refresh code in dev --- build.boot | 9 +++++---- src/alda/parser_util.clj | 3 +++ 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/build.boot b/build.boot index 2baa31c..bdde687 100755 --- a/build.boot +++ b/build.boot @@ -3,11 +3,12 @@ :resource-paths #{"examples"} :dependencies '[ ; dev - [adzerk/bootlaces "0.1.13" :scope "test"] - [adzerk/boot-test "1.1.2" :scope "test"] - [alda/sound-engine-clj "0.1.0" :scope "test"] + [adzerk/bootlaces "0.1.13" :scope "test"] + [adzerk/boot-test "1.1.2" :scope "test"] + [alda/sound-engine-clj "0.1.0" :scope "test"] + [org.clojure/tools.namespace "0.3.0-alpha3" :scope "test"] ; used in examples_test.clj - [io.aviso/pretty "0.1.33" :scope "test"] + [io.aviso/pretty "0.1.33" :scope "test"] ; alda.core [org.clojure/clojure "1.8.0"] diff --git a/src/alda/parser_util.clj b/src/alda/parser_util.clj index b6f3b30..5c977b8 100644 --- a/src/alda/parser_util.clj +++ b/src/alda/parser_util.clj @@ -4,6 +4,9 @@ [instaparse.core :as insta] [clojure.java.io :as io])) +;; FIXME: stubs of removed fns to satisfy the compiler +(declare parse-header parse-part remove-comments separate-parts name-transforms check-for-failure score-parser) + (defn- test-parse-music-data [mode alda-code] (let [cache (atom {})] From 19a427acf83f030c072e54b19df3ec08482fe8b6 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Fri, 24 Mar 2017 09:32:25 -0400 Subject: [PATCH 07/22] event parser --- src/alda/lisp.clj | 4 + src/alda/lisp/attributes.clj | 8 +- src/alda/lisp/events.clj | 17 +- src/alda/lisp/events/barline.clj | 8 +- src/alda/lisp/events/voice.clj | 12 +- src/alda/lisp/model/attribute.clj | 25 -- src/alda/lisp/model/duration.clj | 9 +- src/alda/lisp/model/event.clj | 8 +- src/alda/lisp/model/global_attribute.clj | 4 +- src/alda/lisp/model/pitch.clj | 6 +- src/alda/parser.clj | 89 +++- src/alda/parser/aggregate_events.clj | 71 ++++ src/alda/parser/parse_events.clj | 512 ++++++++++++++++++----- src/alda/parser/tokenize.clj | 4 +- 14 files changed, 605 insertions(+), 172 deletions(-) create mode 100644 src/alda/parser/aggregate_events.clj diff --git a/src/alda/lisp.clj b/src/alda/lisp.clj index bbf0bf4..e3f0f0f 100644 --- a/src/alda/lisp.clj +++ b/src/alda/lisp.clj @@ -40,4 +40,8 @@ (require ns) (import-all-vars ns)) +;; This can be used to determine whether alda.lisp has been loaded into an +;; environment where it is needed, e.g. parsing a score that includes inline +;; Clojure expressions like (tempo! 80) +(declare ALDA-LISP-LOADED) diff --git a/src/alda/lisp/attributes.clj b/src/alda/lisp/attributes.clj index 4b8c180..29b2439 100644 --- a/src/alda/lisp/attributes.clj +++ b/src/alda/lisp/attributes.clj @@ -1,10 +1,10 @@ (ns alda.lisp.attributes - (:require [alda.lisp.events :refer (global-attribute)] - [alda.lisp.model.attribute :refer (set-attribute - *attribute-table*)] + (:require [alda.lisp.events :refer (set-attribute + global-attribute)] + [alda.lisp.model.attribute :refer (*attribute-table*)] [alda.lisp.model.key :refer (get-key-signature)] [alda.lisp.model.records :refer (->AbsoluteOffset - ->Attribute)])) + ->Attribute)])) (comment "The :attributes key in an instrument functions like the :global-attributes diff --git a/src/alda/lisp/events.clj b/src/alda/lisp/events.clj index 22e33e2..d92eb14 100644 --- a/src/alda/lisp/events.clj +++ b/src/alda/lisp/events.clj @@ -56,6 +56,21 @@ {:event-type :chord :events events}) +(defn set-attribute + "Public fn for setting attributes in a score. + e.g. (set-attribute :tempo 100)" + [attr val] + {:event-type :attribute-change + :attr (:kw-name (get-attr attr)) + :val val}) + +(defn set-attributes + "Convenience fn for setting multiple attributes at once. + e.g. (set-attributes :tempo 100 :volume 50)" + [& attrs] + (for [[attr val] (partition 2 attrs)] + (set-attribute attr val))) + (defn global-attribute "Public fn for setting global attributes in a score. e.g. (global-attribute :tempo 100)" @@ -85,7 +100,7 @@ (defn barline "Barlines, at least currently, do nothing when evaluated in alda.lisp." [] - nil) + {:event-type :barline}) (defn marker "Places a marker at the current absolute offset. Throws an exception if there diff --git a/src/alda/lisp/events/barline.clj b/src/alda/lisp/events/barline.clj index 6593226..80cd4e2 100644 --- a/src/alda/lisp/events/barline.clj +++ b/src/alda/lisp/events/barline.clj @@ -1,4 +1,8 @@ -(ns alda.lisp.events.barline) +(ns alda.lisp.events.barline + (:require [alda.lisp.model.event :refer (update-score)])) -(comment "Barlines, at least currently, do nothing when evaluated in alda.lisp.") +(defmethod update-score :barline + [score _] + "Barlines, at least currently, do nothing when evaluated in alda.lisp." + score) diff --git a/src/alda/lisp/events/voice.clj b/src/alda/lisp/events/voice.clj index 353c332..7b20d31 100644 --- a/src/alda/lisp/events/voice.clj +++ b/src/alda/lisp/events/voice.clj @@ -27,11 +27,13 @@ (defmethod update-score :voice [{:keys [instruments] :as score} {:keys [number events] :as voice}] - (let [score (-> score - (assoc :current-voice number) - (update-in [:voice-instruments number] - #(if % % instruments)))] - (reduce update-score score events))) + (if (zero? number) + (-> score end-voice-group) + (let [score (-> score + (assoc :current-voice number) + (update-in [:voice-instruments number] + #(if % % instruments)))] + (reduce update-score score events)))) (defmethod update-score :end-voice-group [score _] diff --git a/src/alda/lisp/model/attribute.clj b/src/alda/lisp/model/attribute.clj index 156256b..885a15a 100644 --- a/src/alda/lisp/model/attribute.clj +++ b/src/alda/lisp/model/attribute.clj @@ -30,16 +30,6 @@ attr (throw (Exception. (str kw " is not a valid attribute."))))) -(defn get-kw-name - "Given an attr (e.g. :tempo), which could be an alias (e.g. :quant for - :quantization), returns the correct keyword name of the attribute to which - it refers. - - Throws an exception if the argument supplied is not a valid keyword name or - alias for an existing attribute." - [attr] - (:kw-name (get-attr attr))) - (defn get-val-fn "Given an attr (e.g. :tempo) and a user-friendly val (e.g. 100), returns the function to apply to an instrument's existing value to update it to the new @@ -75,18 +65,3 @@ (apply-attribute score inst attr val) inst)))) -(defn set-attribute - "Public fn for setting attributes in a score. - e.g. (set-attribute :tempo 100)" - [attr val] - {:event-type :attribute-change - :attr (get-kw-name attr) - :val val}) - -(defn set-attributes - "Convenience fn for setting multiple attributes at once. - e.g. (set-attributes :tempo 100 :volume 50)" - [& attrs] - (for [[attr val] (partition 2 attrs)] - (set-attribute attr val))) - diff --git a/src/alda/lisp/model/duration.clj b/src/alda/lisp/model/duration.clj index 2249520..3a555fb 100644 --- a/src/alda/lisp/model/duration.clj +++ b/src/alda/lisp/model/duration.clj @@ -1,5 +1,4 @@ -(ns alda.lisp.model.duration - (:require [alda.lisp.model.event :refer (add-events)])) +(ns alda.lisp.model.duration) (defn ms "Represents a duration value specified in milliseconds. @@ -20,9 +19,9 @@ (note-length number {:dots 0})) ([number {:keys [dots]}] {:pre [(number? number) (pos? number)]} - {:type :beats - :value (* (/ 4 number) - (- 2 (Math/pow 2 (- dots))))})) + {:type :beats + :value (* (/ 4 number) + (- 2 (Math/pow 2 (- dots))))})) (defn calculate-duration "Given a number of beats, a tempo, and a time-scaling factor, calculates the diff --git a/src/alda/lisp/model/event.clj b/src/alda/lisp/model/event.clj index 170daf7..1ace62a 100644 --- a/src/alda/lisp/model/event.clj +++ b/src/alda/lisp/model/event.clj @@ -16,9 +16,11 @@ as a single 'event sequence'." (fn [score event] (cond - (or (nil? event) (var? event)) :nil - (sequential? event) :event-sequence - :else (:event-type event)))) + (or (= :nil event) + (nil? event) + (var? event)) :nil + (sequential? event) :event-sequence + :else (:event-type event)))) (defmethod update-score :default [_ event] diff --git a/src/alda/lisp/model/global_attribute.clj b/src/alda/lisp/model/global_attribute.clj index 0c7687e..93ae7a4 100644 --- a/src/alda/lisp/model/global_attribute.clj +++ b/src/alda/lisp/model/global_attribute.clj @@ -1,6 +1,6 @@ (ns alda.lisp.model.global-attribute - (:require [alda.lisp.model.attribute :refer (set-attribute - apply-attribute)] + (:require [alda.lisp.events :refer (set-attribute)] + [alda.lisp.model.attribute :refer (apply-attribute)] [alda.lisp.model.event :refer (update-score)] [alda.lisp.model.offset :refer (absolute-offset instruments-all-at-same-offset)] diff --git a/src/alda/lisp/model/pitch.clj b/src/alda/lisp/model/pitch.clj index 7a93cbb..d9c23f3 100644 --- a/src/alda/lisp/model/pitch.clj +++ b/src/alda/lisp/model/pitch.clj @@ -20,9 +20,9 @@ If there are no accidentals and this letter is in the signature, return the letter's signature accidentals, otherwise return existing accidentals." [signature letter accidentals] - (if (empty? accidentals) - (get signature letter) - accidentals)) + (if (empty? accidentals) + (get signature letter) + accidentals)) (defn pitch "Returns a fn that will calculate the frequency in Hz, within the context diff --git a/src/alda/parser.clj b/src/alda/parser.clj index dedd772..ef5a20a 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -1,15 +1,10 @@ (ns alda.parser - (:require [clojure.core.async :refer (chan thread !! close!)] - [clojure.string :as str] - [clojure.java.io :as io] - [taoensso.timbre :as log] - [alda.lisp.attributes :as attrs] - [alda.lisp.events :as evts] - [alda.lisp.model.duration :as dur] - [alda.lisp.model.pitch :as pitch] - [alda.lisp.score :as score] - [alda.parser.tokenize :as token] - [alda.parser.parse-events :as event])) + (:require [alda.lisp.score :as score] + [alda.parser + [aggregate-events :as agg] + [parse-events :as event] + [tokenize :as token]] + [clojure.core.async :refer [!! chan close! go-loop thread]])) (defn print-stream "Continuously reads from a channel and prints what is received, stopping once @@ -56,7 +51,9 @@ "Asynchronously reads tokens from a channel, parsing events and streaming them into a new channel. - Returns a channel from which events can be read as they are parsed." + Returns a channel from which events can be read as they are parsed. + + If there is an error, the error is included in the stream." [tokens-ch] (let [events-ch (chan)] (thread @@ -64,12 +61,72 @@ (if-let [token (!! events-ch :EOF) (close! events-ch))))) events-ch)) +(defn aggregate-events + "Asynchronously reads events from a channel and aggregates certain types of events that need to be aggregated, e.g. notes in a chord. + + Returns a channel on which the final events can be read. + + If there is an error, the error is included in the stream." + [events-ch] + (let [events-ch2 (chan)] + (thread + (loop [parser (agg/parser events-ch2)] + (if-let [event ( input tokenize parse-events print-stream)) + "Given a string of Alda code, process it via the following asynchronous + pipeline: + + - Tokenize it into a stream of recognized tokens. + - From the token stream, parse out a stream of events. + - Process the events sequentially to build a score. + + If an :output key is supplied, the result will depend on the value of that + key: + + :score => an Alda score map, ready to be performed by the sound engine + + :events => a lazy sequence of Alda events, which will produce a complete + score when applied sequentially to a new score + + The default :output is :score." + [input & {:keys [output] :or {output :score}}] + ;; alda.lisp must be required and referred in order to use inline Clojure + ;; expressions. + (when-not (resolve 'ALDA-LISP-LOADED) + (throw (Exception. "Prequisite: (require '[alda.lisp :refer :all])"))) + (case output + :score + (-> input tokenize parse-events aggregate-events build-score input tokenize parse-events aggregate-events stream-seq))) diff --git a/src/alda/parser/aggregate_events.clj b/src/alda/parser/aggregate_events.clj new file mode 100644 index 0000000..4ad7a7b --- /dev/null +++ b/src/alda/parser/aggregate_events.clj @@ -0,0 +1,71 @@ +(ns alda.parser.aggregate-events + (:require [clojure.core.async :refer (>!!)] + [alda.lisp.events :as event])) + +(defn initial-parser-state + [] + {:state :parsing + :buffer []}) + +(defn parser + [events-ch] + (-> (initial-parser-state) + (assoc :events-ch events-ch))) + +(defn emit-event! + [{:keys [events-ch] :as parser} event] + (when-not (= :EOF event) + (>!! events-ch event)) + parser) + +(defn add-to-buffer + [parser event] + (-> parser (update :buffer conj event))) + +(defn flush-buffer! + [{:keys [buffer] :as parser}] + (if (some :chord? buffer) + (let [chord (apply event/chord buffer)] + (emit-event! parser chord)) + (doseq [event buffer] + (emit-event! parser event))) + (-> parser (update :buffer empty))) + +(defn push-event + [{:keys [buffer] :as parser} event] + (cond + (instance? Throwable event) + (-> parser (emit-event! event)) + + (empty? buffer) + (if (#{:note :rest} (:event-type event)) + (-> parser (add-to-buffer event)) + (-> parser (emit-event! event))) + + (#{:note :rest} (:event-type event)) + (if (:chord? event) + (-> parser (add-to-buffer event)) + (-> parser flush-buffer! (add-to-buffer event))) + + :else + (-> parser flush-buffer! (emit-event! event)))) + +(defn ensure-parsing + "If the parser's state is not :parsing, short-circuits the parser so that the + current state is passed through until the end. + + Otherwise returns nil so that parsing will continue." + [{:keys [state] :as parser}] + (when (not= :parsing state) + parser)) + +(defn read-event! + "Reads one event `t` and updates parser `p`. + + Puts events on (:events-ch p) as they are read and (possibly) aggregated." + [p e] + (try + (or (ensure-parsing p) + (push-event p e)) + (catch Throwable e + (push-event p e)))) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj index b8eef29..2dc8300 100644 --- a/src/alda/parser/parse_events.clj +++ b/src/alda/parser/parse_events.clj @@ -1,13 +1,15 @@ (ns alda.parser.parse-events - (:require [clojure.core.async :refer (>!!)] - [alda.lisp.events :as evts] - [alda.parser.tokenize :refer (token-names)])) + (:require [clojure.core.async :refer (>!!)] + [clojure.string :as str] + [alda.lisp.events :as event] + [alda.lisp.model.duration :as dur] + [alda.lisp.model.pitch :as pitch] + [alda.parser.tokenize :refer (token-names)])) (defn initial-parser-state [] - {:state :parsing - :stack [] - }) + {:state :parsing + :stack []}) (defn parser [events-ch] @@ -44,20 +46,175 @@ [token] (when (sequential? token) (first token))) +(defn token-position + [[_ [line column] _ :as token]] + [line column]) + (defn token-content [[_ _ content :as token]] content) +(declare alda-event-with-metadata) + +(defmulti alda-event :type) + +(defmethod alda-event :default + [{:keys [type] :as event}] + ;; temp + (prn :event event) + (throw (Exception. (format "Unrecognized event: %s" type)))) + +(defmethod alda-event :error + [{:keys [content]}] + ;; Emit the error itself on the stream so it can be thrown at the end. + (if (instance? Throwable content) + content + (Exception. content))) + +(defmethod alda-event :at-marker + [{:keys [content]}] + (event/at-marker content)) + +(defmethod alda-event :barline + [{:keys [content]}] + (event/barline)) + +;; NB: I don't think we can include the position in the resulting object, +;; because we're evaluating an arbitrary clojure expression and the result might +;; be nil or some other object that doesn't implement IMeta. +(defmethod alda-event :clj-expr + [{:keys [content]}] + (require '[alda.lisp :refer :all]) + (let [value (load-string content)] + (if (nil? value) + :nil ; can't put nil on a channel + value))) + +(defmethod alda-event :cram + [{:keys [content]}] + (apply event/cram (map alda-event-with-metadata content))) + +(defmethod alda-event :duration + [{:keys [content]}] + (-> (apply dur/duration (for [{:keys [type] :as event} content + :when (not= :tie type)] + (alda-event-with-metadata event))) + (merge (when (= :tie (:type (last content))) + {:slur? true})))) + +(defmethod alda-event :event-seq + [{:keys [content]}] + (mapv alda-event-with-metadata content)) + +(defmethod alda-event :get-variable + [{:keys [content]}] + (event/get-variable content)) + +(defmethod alda-event :instrument-call + [{:keys [content]}] + (let [nickname-error (Exception. (str "Can't have more than one nickname in " + "an instrument call.")) + instruments (reduce (fn [acc {:keys [type content]}] + (case type + :name (update acc :names (fnil conj []) content) + :nickname (if (:nickname acc) + (throw nickname-error) + (assoc acc :nickname content)))) + {} + content)] + (event/part instruments))) + +(defmethod alda-event :marker + [{:keys [content]}] + (event/marker content)) + +(defmethod alda-event :note + [{:keys [content chord?] :as event}] + (let [[letter & more] content + accidentals (-> (for [{:keys [type content]} more + :when (= :accidentals type)] + (map {\+ :sharp \- :flat \_ :natural} content)) + flatten) + pitch-fn (apply pitch/pitch (keyword (:content letter)) accidentals) + duration (-> (for [{:keys [type] :as event} more + :when (= :duration type)] + (alda-event-with-metadata event)) + first) ; there should be at most one + slur (when (or (some #(= :tie (:type %)) more) + (:slur? duration)) + :slur)] + (-> (event/note pitch-fn duration slur) + (merge (when chord? {:chord? true}))))) + +(defmethod alda-event :note-length + [{:keys [content]}] + (let [[_ number dots] (re-matches #"(\d+)(\.*)" content) + [_ seconds] (re-matches #"(\d+)s" content) + [_ milliseconds] (re-matches #"(\d+)ms" content)] + (cond + number + (dur/note-length (Integer/parseInt number) {:dots (count dots)}) + + seconds + (dur/ms (* 1000 (Integer/parseInt seconds))) + + milliseconds + (dur/ms (Integer/parseInt milliseconds)) + + :else + (throw (Exception. (format "Invalid note length: %s" content)))))) + +(defmethod alda-event :octave-change + [{:keys [content]}] + (let [value (cond + (str/starts-with? content "o") + (Integer/parseInt (subs content 1)) + + (= "<" content) + :down + + (= ">" content) + :up)] + (event/set-attribute :octave value))) + +(defmethod alda-event :repeat + [{:keys [content]}] + (let [[times event] content] + (vec (repeat times (alda-event-with-metadata event))))) + +(defmethod alda-event :rest + [{:keys [content chord?] :as event}] + (let [duration (when (seq content) + (alda-event-with-metadata (first content)))] + (-> (event/pause duration) + (merge (when chord? {:chord? true}))))) + +(defmethod alda-event :set-variable + [{:keys [content] :as event}] + (let [[var-name events] content] + (apply event/set-variable var-name (map alda-event-with-metadata events)))) + +(defmethod alda-event :voice + [{:keys [content] :as event}] + (let [[_ vn] (re-matches #"V(\d+)" content) + voice-number (Integer/parseInt vn)] + (event/voice voice-number))) + +(defn alda-event-with-metadata + [{:keys [position] :as event}] + (let [event (alda-event event) + metadata (when (map? event) + (select-keys event [:position]))] + (if (and (instance? clojure.lang.IObj event) + (instance? clojure.lang.IMeta event)) + (with-meta event metadata) + event))) + (defmulti emit-event! (fn [parser event] (:type event))) (defmethod emit-event! :default [{:keys [events-ch] :as parser} event] - (>!! events-ch event) - parser) - -(defmethod emit-event! :event-seq - [parser {:keys [content] :as event}] - (doseq [event content] (emit-event! parser event)) + (>!! events-ch (alda-event-with-metadata event)) parser) (defn pop-and-emit-event! @@ -86,16 +243,6 @@ appended-event (update current-event :content conj event)] (-> parser (update :stack #(-> % pop (conj appended-event)))))) -(defn open-event? - [event-type] - (fn [{:keys [stack] :as parser}] - (->> stack - (filter (fn [{:keys [type open?]}] (and (= event-type type) open?))) - last))) - -(def open-event-seq? (open-event? :event-seq)) -(def open-set-variable? (open-event? :set-variable)) - (defn last-open-event [{:keys [stack] :as parser}] (->> stack @@ -103,13 +250,29 @@ last)) (defn push-event - [{:keys [stack] :as parser} {:keys [type] :as event}] + [{:keys [stack] :as parser} event] (cond + (empty? stack) + (-> parser (update :stack conj event)) + + (= :duration (:type event)) + (-> parser (update :stack conj event)) + + (= :duration (current-event-type parser)) + (-> parser append-to-parent (push-event event)) + (last-open-event parser) (-> parser (update :stack conj event)) :else - (-> parser pop-and-emit-event! (update :stack conj event)))) + (-> parser pop-and-emit-event! (push-event event)))) + +(defn push-event-when + [parser token expected-token] + (when (token-is expected-token token) + (-> parser (push-event {:type expected-token + :position (token-position token) + :content (token-content token)})))) (defn rename-current-event [{:keys [stack] :as parser} new-name] @@ -140,38 +303,49 @@ vec)) (push-event set-var-event)))) -(defn push-event-seq +(defn- push-container + [container] + (fn [{:keys [stack] :as parser}] + {:pre [(= container (:type (last-open-event parser)))]} + (let [events (->> stack + reverse + (take-while #(not (and (= container (:type %)) + (:open? %)))) + reverse + vec)] + (-> parser + (update :stack #(->> % + (drop-last (inc (count events))) + vec)) + (push-event {:type container :content events}))))) + +(def push-cram + (push-container :cram)) + +(def push-event-seq + (push-container :event-seq)) + +(def push-voice + (push-container :voice)) + +(defn push-instrument-call [{:keys [stack] :as parser}] - {:pre [(= :event-seq (:type (last-open-event parser)))]} - (let [seq-events (->> stack - reverse - (take-while #(not (and (= :event-seq (:type %)) - (:open? %)))) - reverse)] + {:pre [(= :instrument-call (:type (last-open-event parser)))]} + (let [contents (->> stack + reverse + (take-while #(not (= :instrument-call (:type %)))) + reverse)] (-> parser (update :stack #(->> % - (drop-last (inc (count seq-events))) + (drop-last (inc (count contents))) vec)) - (push-event {:type :event-seq - :content seq-events})))) + (push-event {:type :instrument-call + :content contents})))) -(defn ensure-parsing - "If the parser's state is not :parsing, short-circuits the parser so that the - current state is passed through until the end. - - Otherwise returns nil so that parsing will continue." - [{:keys [state] :as parser}] - (when (not= :parsing state) - parser)) - -(defn finish-parsing - [parser character] - (when (= :EOF character) - (-> parser (assoc :state :done)))) - -(defn caught-error - [parser e] - (-> parser (emit-event! [:error e]) (assoc :state :error))) +(defn error + [parser error-content] + (-> parser (emit-event! {:type :error :content error-content}) + (assoc :state :error))) (defn unexpected-token-error [parser token] @@ -184,60 +358,108 @@ line column)) (format "Unexpected token: %s." token))] - (-> parser (emit-event! [:error error-msg]) (assoc :state :error)))) + (-> parser (error error-msg)))) + +(defn ensure-parsing + "If the parser's state is not :parsing, short-circuits the parser so that the + current state is passed through until the end. + + Otherwise returns nil so that parsing will continue." + [{:keys [state] :as parser}] + (when (not= :parsing state) + parser)) + +(defn propagate-error + "If there was an error in a previous stage of the parsing pipeline, propagate + it through and stop parsing." + [parser token] + (when (token-is :error token) + (-> parser (error (token-content token))))) + +(defn finish-parsing + [{:keys [stack] :as parser} token] + (when (token-is :EOF token) + (-> parser (push-event :EOF) (assoc :state :done)))) (defn ignore-comment [parser token] (when (token-is :comment token) parser)) -(declare parse-note-length parse-tie parse-barline read-token!) +(declare read-token! start-parsing-note start-parsing-rest) (defn parse-accidentals [parser token] (when (token-is :accidentals token) (if (= :note (current-event-type parser)) - (-> parser (append-to-current-event {:type :accidentals - :content (token-content token)})) + (-> parser (append-to-current-event {:type :accidentals + :position (token-position token) + :content (token-content token)})) (-> parser (unexpected-token-error token))))) +(defn parse-at-marker + [parser token] + (-> parser (push-event-when token :at-marker))) + (defn parse-barline [parser token] (when (token-is :barline token) - (if (= :note (current-event-type parser)) - (-> parser (append-to-current-event {:type :barline})) - (-> parser (push-event {:type :barline}))))) + (let [barline {:type :barline + :position (token-position token)}] + (if (= :duration (current-event-type parser)) + (-> parser (append-to-current-event barline)) + (-> parser (push-event barline)))))) + +(defn parse-colon + [parser token] + (when (token-is :colon token) + (if (= :instrument-call (:type (last-open-event parser))) + (-> parser push-instrument-call) + (-> parser (unexpected-token-error token))))) (defn parse-clj-expr [parser token] - (when (token-is :clj-expr token) - (let [clj-expr (token-content token)] - (-> parser (push-event {:type :clj-expr - :content (token-content token)}))))) + (-> parser (push-event-when token :clj-expr))) + +(defn parse-marker + [parser token] + (-> parser (push-event-when token :marker))) (defn parse-name [parser token] - (when (token-is :name token) - (-> parser (push-event {:type :name - :content (token-content token)})))) + (-> parser (push-event-when token :name))) + +(defn parse-nickname + [parser token] + (when (token-is :nickname token) + (if (= :instrument-call (:type (last-open-event parser))) + (-> parser (push-event-when token :nickname)) + (-> parser (unexpected-token-error token))))) (defn parse-note-length [parser token] (when (token-is :note-length token) - (if (#{:note :rest} (current-event-type parser)) - (-> parser (append-to-current-event {:type :note-length - :content (token-content token)})) - (-> parser (unexpected-token-error token))))) + (let [note-length {:type :note-length + :position (token-position token) + :content (token-content token)}] + (condp contains? (current-event-type parser) + #{:duration} + (-> parser (append-to-current-event note-length)) + + #{:note :rest :cram} + (-> parser (push-event {:type :duration + :position (token-position token) + :content [note-length]})) + + ;; else + (-> parser (unexpected-token-error token)))))) (defn parse-octave-change [parser token] - (when (token-is :octave-change token) - (-> parser (push-event {:type :octave-change - :content (token-content token)})))) + (-> parser (push-event-when token :octave-change))) -(def ^:private repeatable? - ; TODO: include all the things that can be repeated - #{:clj-expr :note :rest :chord :event-seq :get-variable}) +(def repeatable? + #{:clj-expr :note :rest :event-seq :get-variable :cram}) (defn parse-repeat [{:keys [stack] :as parser} token] @@ -248,66 +470,135 @@ events-to-repeat (peek stack)] (-> parser (update :stack pop) - (push-event {:type :repeat - :content [repeats events-to-repeat]}))) + (push-event {:type :repeat + :position (token-position token) + :content [repeats events-to-repeat]}))) (-> parser (unexpected-token-error token))))) +(defn parse-voice + [parser token] + (-> parser (push-event-when token :voice))) + (defn parse-tie [parser token] (when (token-is :tie token) - (if (#{:note :rest} (current-event-type parser)) - (-> parser (append-to-current-event {:type :tie})) + (if (#{:duration :note} (current-event-type parser)) + (-> parser (append-to-current-event {:type :tie + :position (token-position token)})) (-> parser (unexpected-token-error token))))) -(defn start-parsing-names - [parser token] - (when (token-is :slash token) +(defn start-parsing-instrument-call + [parser] + (let [first-name (current-event parser)] (-> parser - (rename-current-event :names)))) + (update :stack pop) + (push-event {:type :instrument-call}) + open-current-event + (push-event first-name)))) -(defn start-parsing-note +(defn continue-parsing-instrument-call [parser token] - (when (token-is :note token) - (-> parser (push-event {:type :note - :content [{:type :pitch - :content (token-content token)}]})))) + (when (= :instrument-call (:type (last-open-event parser))) + (cond + (token-is :slash token) + parser ; ignore -(defn start-parsing-rest + (token-is :name token) + (-> parser (push-event-when token :name)) + + (token-is :nickname token) + (-> parser (push-event-when token :nickname)) + + (token-is :colon token) + (-> parser push-instrument-call) + + :else + (-> parser (unexpected-token-error token))))) + +(defn start-parsing-chord [parser token] - (when (token-is :rest token) - (-> parser (push-event {:type :rest})))) + (when (and (token-is :slash token) + (#{:note :rest :duration} (current-event-type parser))) + (-> parser (assoc :chord? true)))) -(defn start-parsing-set-variable +(defn continue-parsing-chord + [p t] + (when (:chord? parser) + (or + (parse-octave-change p t) + (parse-clj-expr p t) + (start-parsing-note p t) + (start-parsing-rest p t) + (unexpected-token-error p t)))) + +(defn start-parsing-cram [parser token] - (when (token-is :equals token) - (if (= :name (current-event-type parser)) - (-> parser (-> (rename-current-event :set-variable) open-current-event)) - (-> parser (unexpected-token-error token))))) + (when (token-is :cram-open token) + (-> parser (push-event {:type :cram + :position (token-position token)}) + open-current-event))) + +(defn finish-parsing-cram + [parser token] + (when (token-is :cram-close token) + (-> parser push-cram))) (defn start-parsing-event-seq [parser token] (when (token-is :event-seq-open token) - (-> parser (push-event {:type :event-seq}) open-current-event))) + (-> parser (push-event {:type :event-seq + :position (token-position token)}) + open-current-event))) (defn finish-parsing-event-seq [parser token] (when (token-is :event-seq-close token) (-> parser push-event-seq))) +(defn start-parsing-note + [{:keys [chord?] :as parser} token] + (when (token-is :note token) + (-> parser + (push-event (merge {:type :note + :position (token-position token) + :content [{:type :pitch + :position (token-position token) + :content (token-content token)}]} + (when chord? {:chord? true}))) + (dissoc :chord?)))) + +(defn start-parsing-rest + [{:keys [chord?] :as parser} token] + (when (token-is :rest token) + (-> parser + (push-event (merge {:type :rest + :position (token-position token)} + (when chord? {:chord? true}))) + (dissoc :chord?)))) + +(defn start-parsing-set-variable + [parser token] + (when (token-is :equals token) + (if (= :name (current-event-type parser)) + (-> parser (-> (rename-current-event :set-variable) open-current-event)) + (-> parser (unexpected-token-error token))))) + (defn handle-newline [parser token] (when (token-is :newline token) - (let [open-event (last-open-event parser)] - (if (= :set-variable (:type open-event)) - (-> parser push-set-variable) - parser)))) + (if (= :set-variable (:type (last-open-event parser))) + (-> parser push-set-variable) + parser))) (defn disambiguate-name [p t] - (when (= :name (current-event-type p)) + (when (and (= :name (current-event-type p)) + (not= :instrument-call (:type (last-open-event p)))) (case (token-type t) - :equals (start-parsing-set-variable p t) - :slash (start-parsing-names p t) + :equals (start-parsing-set-variable p t) + :slash (start-parsing-instrument-call p) + :nickname (-> p start-parsing-instrument-call (read-token! t)) + :colon (-> p start-parsing-instrument-call (parse-colon t)) (-> p (rename-current-event :get-variable) (read-token! t))))) @@ -319,22 +610,33 @@ [p t] (try (or (ensure-parsing p) + (propagate-error p t) (ignore-comment p t) (handle-newline p t) (disambiguate-name p t) + (continue-parsing-instrument-call p t) + (continue-parsing-chord p t) (parse-accidentals p t) + (parse-at-marker p t) (parse-barline p t) + (parse-colon p t) (parse-clj-expr p t) + (parse-marker p t) (parse-name p t) + (parse-nickname p t) (parse-note-length p t) (parse-octave-change p t) (parse-repeat p t) + (parse-voice p t) (parse-tie p t) (start-parsing-note p t) (start-parsing-rest p t) + (start-parsing-chord p t) + (start-parsing-cram p t) (start-parsing-event-seq p t) + (finish-parsing-cram p t) (finish-parsing-event-seq p t) (finish-parsing p t) (unexpected-token-error p t)) (catch Throwable e - (caught-error p e)))) + (error p e)))) diff --git a/src/alda/parser/tokenize.clj b/src/alda/parser/tokenize.clj index ce9e96c..ab5849a 100644 --- a/src/alda/parser/tokenize.clj +++ b/src/alda/parser/tokenize.clj @@ -24,11 +24,13 @@ :equals "'='" :event-seq "event sequence" :name "name" + :nickname "nickname" :note "note" :note-length "note length" :note-rest-or-name "note, rest, or name" :repeat "repeat" - :rest "rest"}) + :rest "rest" + :slash "'/'"}) (defn current-token-type [{:keys [stack] :as parser}] From 81e3ab2a350544896f8a3c2051f1901eb190cfd1 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Wed, 3 May 2017 12:42:34 -0400 Subject: [PATCH 08/22] add examples for untested features of alda --- examples/dot_accessor.alda | 2 ++ examples/seconds_and_milliseconds.alda | 4 ++++ test/alda/examples_test.clj | 2 ++ 3 files changed, 8 insertions(+) create mode 100644 examples/dot_accessor.alda create mode 100644 examples/seconds_and_milliseconds.alda diff --git a/examples/dot_accessor.alda b/examples/dot_accessor.alda new file mode 100644 index 0000000..977667e --- /dev/null +++ b/examples/dot_accessor.alda @@ -0,0 +1,2 @@ +violin/viola/cello "strings": g1~1~1 +strings.cello: < c1~1~1 diff --git a/examples/seconds_and_milliseconds.alda b/examples/seconds_and_milliseconds.alda new file mode 100644 index 0000000..b4cfdfb --- /dev/null +++ b/examples/seconds_and_milliseconds.alda @@ -0,0 +1,4 @@ +accordion: + c500ms/e/g + c1s/f/a + c2s/e/g diff --git a/test/alda/examples_test.clj b/test/alda/examples_test.clj index 061bd2f..586a5f0 100644 --- a/test/alda/examples_test.clj +++ b/test/alda/examples_test.clj @@ -20,6 +20,7 @@ bach_cello_suite_no_1 clapping_music debussy_quartet + dot_accessor entropy gau hello_world @@ -32,6 +33,7 @@ phase poly printing + seconds_and_milliseconds variables variables-2 ]) From 5f35d659927952e99ea7ec9ab0ee2f4bb2f681aa Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Wed, 3 May 2017 22:16:39 -0400 Subject: [PATCH 09/22] remove alda.parser-util Simplifying this a little bit: I don't think we really need to be able to "parse with context"; we only need to be able to parse input as a sequence of events, instead of a score map. Ramifications: - We are no longer in the business of generating alda.lisp code. We could add this back in the future, but I think it's extraneous since that's no longer an intermediate step in the parsing pipeline. (It actually hasn't been a step in the parsing process for some time now, and I don't consider it an essential feature of Alda.) - Not generating alda.lisp code makes testing the parser a little trickier, since not all events have good equality semantics out-of-the-box. For example, when a note event is generated by the parser, it includes an anonymous "pitch-fn" which is not considered equal (by Clojure standards) to the pitch-fn of another note, even if the note has the same pitch. I am taking this as an opportunity to re-implement certain events in ways that will give them proper equality semantics. Then testing the parser is just a matter of parsing input and comparing the actual sequence of events vs. an expected sequence of events that can be obtained by writing alda.lisp code in the test namespaces. This is nice because the tests still read just as well, but we're testing the equality of events instead of the equality of generated Clojure code which can always change arbitrarily. - The Alda REPL will need to be tweaked to use parse-input instead of parse-to-*-with-context, and also we won't know the context anymore. I think this is OK, because the only context we've ever needed so far in the REPL has been the current instruments, and those are easily obtained from the score map. My original idea (and the inspiration behind parse-to-*-with-context) was for the parser to give a lot of detail about where exactly we are in a score, e.g. are we in the middle of a voice? inside of an event sequence? in an instrument part? etc. But in practice, we haven't needed to use any of that context at all so far, and interestingly, we started adding more context to the score map itself, so I think even if we DID start to need that context in the REPL, we could just get it from the score map. So, this is a nice opportunity to clean up the code by removing complicated WIP features that we aren't using. --- build.boot | 1 - src/alda/lisp/code.clj | 7 +- src/alda/lisp/score/part.clj | 26 +++- src/alda/parser_util.clj | 107 ------------- test/alda/examples_test.clj | 1 - test/alda/parser/barlines_test.clj | 60 ++++--- test/alda/parser/clj_exprs_test.clj | 101 ++++++------ test/alda/parser/duration_test.clj | 88 +++++------ test/alda/parser/event_sequences_test.clj | 44 +++--- test/alda/parser/events_test.clj | 181 ++++++++++++---------- test/alda/parser/octaves_test.clj | 58 +++---- test/alda/parser/repeats_test.clj | 60 +++---- test/alda/parser/variables_test.clj | 95 ++++++------ 13 files changed, 367 insertions(+), 462 deletions(-) delete mode 100644 src/alda/parser_util.clj diff --git a/build.boot b/build.boot index bdde687..a1a0d60 100755 --- a/build.boot +++ b/build.boot @@ -13,7 +13,6 @@ ; alda.core [org.clojure/clojure "1.8.0"] [org.clojure/core.async "0.2.395"] - [instaparse "1.4.3"] [com.taoensso/timbre "4.7.4"] [djy "0.1.4"] [potemkin "0.4.3"] diff --git a/src/alda/lisp/code.clj b/src/alda/lisp/code.clj index 51f3c3c..628df53 100644 --- a/src/alda/lisp/code.clj +++ b/src/alda/lisp/code.clj @@ -1,12 +1,9 @@ (ns alda.lisp.code - (:require [alda.parser-util :refer (parse-to-events-with-context)])) + (:require [alda.parser :refer (parse-input)])) (defn alda-code "Attempts to parse a string of text within the context of the current score; if the code parses successfully, the result is one or more events that are spliced into the score." [code] - (let [[context parse-result] (parse-to-events-with-context code)] - (if (= context :parse-failure) - (throw (Exception. (str "Invalid Alda code: " code))) - parse-result))) + (parse-input code :output :events)) diff --git a/src/alda/lisp/score/part.clj b/src/alda/lisp/score/part.clj index 02f735e..73506a7 100644 --- a/src/alda/lisp/score/part.clj +++ b/src/alda/lisp/score/part.clj @@ -7,7 +7,7 @@ [alda.lisp.events.voice :refer (end-voice-group)] [alda.lisp.model.event :refer (update-score)] [alda.lisp.model.instrument :refer (*stock-instruments*)] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + [alda.parser :refer (parse-input)])) (defn- generate-id [name] @@ -189,11 +189,22 @@ instances) :current-instruments (set (map :id instances))))) -(defn- parse-instrument-call [s] - (parse-to-lisp-with-context :calls (-> s - (str/replace #":$" "") - (str/replace #"'" "\"") - (str \:)))) +(defn- invalid-instrument-call-error! + [x] + (throw (Exception. (str "Invalid instrument call: " (pr-str x))))) + +(defn- parse-instrument-call + [s] + (let [events (-> s + (str/replace #":$" "") + (str/replace #"'" "\"") + (str \:) + (parse-input :output :events)) + part (first events) + call (:instrument-call part)] + (if (and (= 1 (count events)) call) + call + (invalid-instrument-call-error! s)))) (defmethod update-score :part [score {:keys [instrument-call events] :as part}] @@ -205,8 +216,7 @@ (parse-instrument-call instrument-call) :else - (throw (Exception. (str "Invalid instrument call:" - (pr-str instrument-call))))) + (invalid-instrument-call-error! instrument-call)) score (-> score end-voice-group (determine-current-instruments instrument-call))] diff --git a/src/alda/parser_util.clj b/src/alda/parser_util.clj deleted file mode 100644 index 5c977b8..0000000 --- a/src/alda/parser_util.clj +++ /dev/null @@ -1,107 +0,0 @@ -(ns alda.parser-util - (:require [alda.parser :refer :all] - [alda.lisp.events :as evts] - [instaparse.core :as insta] - [clojure.java.io :as io])) - -;; FIXME: stubs of removed fns to satisfy the compiler -(declare parse-header parse-part remove-comments separate-parts name-transforms check-for-failure score-parser) - -(defn- test-parse-music-data - [mode alda-code] - (let [cache (atom {})] - (->> [alda-code cache] - remove-comments - ((fn [[alda-code cache]] - (parse-part mode cache alda-code)))))) - -(defn- test-parse-part - [mode alda-code] - (let [cache (atom {})] - (->> [alda-code cache] - remove-comments - separate-parts - (insta/transform - {:score #(if (> (count %&) 1) - (throw (Exception. "This is more than one part.")) - (first %&)) - :header #(parse-header mode cache (apply str %&)) - :part (let [lisp-xform - (fn [names & music-data] - (list* 'alda.lisp/part - names - (parse-part mode cache (apply str music-data)))) - - map-xform - (fn [names & music-data] - (apply evts/part - names - (parse-part mode cache (apply str music-data))))] - (case mode - :lisp lisp-xform - :map map-xform - :events map-xform))})))) - -(defn- test-parse-calls - [mode alda-code] - (->> alda-code - score-parser - check-for-failure - (insta/transform - (merge name-transforms - {:score #(if (> (count %&) 1) - (throw (Exception. "More than one group of calls.")) - (first %&)) - :header #(if (pos? (count %&)) - (throw (Exception. "Not an instrument call."))) - :part #(if (> (count %&) 1) - (throw (Exception. "Not an instrument call.")) - (first %&)) - :calls (fn [& calls] - (let [names (vec (keep :name calls)) - nickname (some :nickname calls)] - (if nickname - {:names names, :nickname nickname} - {:names names})))})))) - -(defn- parse-with-context - "Parse a string of Alda code within a particular context, e.g. to parse - additional music data for an already existing part, or to parse a single - instrument part in an already existing score. - - If `ctx` is provided, will attempt to parse the code within that context, - which will throw an error if parsing fails. - - If `ctx` is NOT provided, will try to parse the code in increasingly broad - contexts until it parses successfully. When it does parse successfully, - returns a vector containing the context and the parse result. If parsing - fails in all contexts, returns a vector containing `:parse-failure` and - the error that was thrown at the broadest context level." - ([mode code] - (letfn [(try-ctxs [[ctx & ctxs]] - (try - (let [parsed (parse-with-context mode ctx code)] - [ctx parsed]) - (catch Exception e - (if ctxs - (try-ctxs ctxs) - [:parse-failure e]))))] - (try-ctxs [:music-data :part :score]))) - ([mode ctx code] - (case ctx - :music-data (test-parse-music-data mode code) - :part (test-parse-part mode code) - :calls (test-parse-calls mode code) - :score (parse-input code mode)))) - -(defn parse-to-lisp-with-context - [& args] - (apply parse-with-context :lisp args)) - -(defn parse-to-map-with-context - [& args] - (apply parse-with-context :map args)) - -(defn parse-to-events-with-context - [& args] - (apply parse-with-context :events args)) diff --git a/test/alda/examples_test.clj b/test/alda/examples_test.clj index 586a5f0..2574c12 100644 --- a/test/alda/examples_test.clj +++ b/test/alda/examples_test.clj @@ -2,7 +2,6 @@ (:require [clojure.test :refer :all] [clojure.java.io :as io] [alda.parser :refer (parse-input)] - [instaparse.core :as insta] [io.aviso.ansi :refer :all])) (def example-scores diff --git a/test/alda/parser/barlines_test.clj b/test/alda/parser/barlines_test.clj index 72090a2..512130e 100644 --- a/test/alda/parser/barlines_test.clj +++ b/test/alda/parser/barlines_test.clj @@ -1,46 +1,44 @@ (ns alda.parser.barlines-test (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + [alda.parser :refer (parse-input)])) (def alda-code-1 "violin: c d | e f | g a") -(def alda-lisp-code-1 - '(alda.lisp/score - (alda.lisp/part {:names ["violin"]} - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/barline) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f)) - (alda.lisp/barline) - (alda.lisp/note (alda.lisp/pitch :g)) - (alda.lisp/note (alda.lisp/pitch :a))))) +(def alda-events-1 + [(alda.lisp/part {:names ["violin"]}) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/barline) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f)) + (alda.lisp/barline) + (alda.lisp/note (alda.lisp/pitch :g)) + (alda.lisp/note (alda.lisp/pitch :a))]) (def alda-code-2 "marimba: c1|~1|~1~|1|~1~|2.") -(def alda-lisp-code-2 - '(alda.lisp/score - (alda.lisp/part {:names ["marimba"]} - (alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration - (alda.lisp/note-length 1) - (alda.lisp/barline) - (alda.lisp/note-length 1) - (alda.lisp/barline) - (alda.lisp/note-length 1) - (alda.lisp/barline) - (alda.lisp/note-length 1) - (alda.lisp/barline) - (alda.lisp/note-length 1) - (alda.lisp/barline) - (alda.lisp/note-length 2 {:dots 1})))))) +(def alda-events-2 + [(alda.lisp/part {:names ["marimba"]}) + (alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration + (alda.lisp/note-length 1) + (alda.lisp/barline) + (alda.lisp/note-length 1) + (alda.lisp/barline) + (alda.lisp/note-length 1) + (alda.lisp/barline) + (alda.lisp/note-length 1) + (alda.lisp/barline) + (alda.lisp/note-length 1) + (alda.lisp/barline) + (alda.lisp/note-length 2 {:dots 1})))]) (deftest barline-tests (testing "barlines are included in alda.lisp code (even though they don't do anything)" - (is (= alda-lisp-code-1 (parse-to-lisp-with-context :score alda-code-1)))) + (is (= alda-events-1 (parse-input alda-code-1 :output :events)))) (testing "notes can be tied over barlines" - (is (= alda-lisp-code-2 (parse-to-lisp-with-context :score alda-code-2))))) + (is (= alda-events-2 (parse-input alda-code-2 :output :events))))) diff --git a/test/alda/parser/clj_exprs_test.clj b/test/alda/parser/clj_exprs_test.clj index d3e56ae..e072cb8 100644 --- a/test/alda/parser/clj_exprs_test.clj +++ b/test/alda/parser/clj_exprs_test.clj @@ -1,86 +1,87 @@ (ns alda.parser.clj-exprs-test - (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + (:require [clojure.test :refer :all] + [alda.lisp :refer :all] + [alda.parser :refer (parse-input)])) (deftest attribute-tests (testing "volume change" - (is (= (parse-to-lisp-with-context :music-data "(volume 50)") '((volume 50))))) + (is (= (parse-input "(volume 50)" :output :events) [(volume 50)]))) (testing "tempo change" - (is (= (parse-to-lisp-with-context :music-data "(tempo 100)") '((tempo 100))))) + (is (= (parse-input "(tempo 100)" :output :events) [(tempo 100)]))) (testing "quantization change" - (is (= (parse-to-lisp-with-context :music-data "(quant 75)") '((quant 75))))) + (is (= (parse-input "(quant 75)" :output :events) [(quant 75)]))) (testing "panning change" - (is (= (parse-to-lisp-with-context :music-data "(panning 0)") '((panning 0)))))) + (is (= (parse-input "(panning 0)" :output :events) [(panning 0)])))) (deftest multiple-attribute-change-tests (testing "attribute changes" - (is (= (parse-to-lisp-with-context :music-data "(do (vol 50) (tempo 100))") - '((do (vol 50) (tempo 100))))) - (is (= (parse-to-lisp-with-context :music-data "(do (quant! 50) (tempo 90))") - '((do (quant! 50) (tempo 90)))))) + (is (= (parse-input "(list (vol 50) (tempo 100))" :output :events) + [(list (vol 50) (tempo 100))])) + (is (= (parse-input "(list (quant! 50) (tempo 90))" :output :events) + [(list (quant! 50) (tempo 90))]))) (testing "global attribute changes" - (is (= (parse-to-lisp-with-context :music-data "(tempo! 126)") - '((tempo! 126)))) - (is (= (parse-to-lisp-with-context :music-data "(do (tempo! 130) (quant! 80))") - '((do (tempo! 130) (quant! 80))))))) + (is (= (parse-input "(tempo! 126)" :output :events) + [(tempo! 126)])) + (is (= (parse-input "(list (tempo! 130) (quant! 80))" :output :events) + [(list (tempo! 130) (quant! 80))])))) (deftest comma-and-semicolon-tests (testing "commas/semicolons can exist in strings" - (is (= (parse-to-lisp-with-context :music-data "(println \"hi; hi, hi\")") - '((println "hi; hi, hi"))))) + (is (= (parse-input "(println \"hi; hi, hi\")" :output :events) + [(println "hi; hi, hi")]))) (testing "commas inside [brackets] and {braces} won't break things" - (is (= (parse-to-lisp-with-context :music-data "(prn [1,2,3])") - '((prn [1 2 3])))) - (is (= (parse-to-lisp-with-context :music-data "(prn {:a 1, :b 2})") - '((prn {:a 1 :b 2}))))) + (is (= (parse-input "(prn [1,2,3])" :output :events) + [(prn [1 2 3])])) + (is (= (parse-input "(prn {:a 1, :b 2})" :output :events) + [(prn {:a 1 :b 2})]))) (testing "comma/semicolon character literals are OK too" - (is (= (parse-to-lisp-with-context :music-data "(println \\, \\;)") - '((println \, \;)))))) + (is (= (parse-input "(println \\, \\;)" :output :events) + [(println \, \;)])))) (deftest paren-tests (testing "parens inside of a string are NOT a clj-expr" - (is (= (parse-to-lisp-with-context :music-data "(prn \"a string (with parens)\")") - '((prn "a string (with parens)")))) - (is (= (parse-to-lisp-with-context :music-data "(prn \"a string with just a closing paren)\")") - '((prn "a string with just a closing paren)"))))) + (is (= (parse-input "(prn \"a string (with parens)\")" :output :events) + [(prn "a string (with parens)")])) + (is (= (parse-input "(prn \"a string with just a closing paren)\")" :output :events) + [(prn "a string with just a closing paren)")]))) (testing "paren character literals don't break things" - (is (= (parse-to-lisp-with-context :music-data "(prn \\()") - '((prn \()))) - (is (= (parse-to-lisp-with-context :music-data "(prn \\))") - '((prn \))))) - (is (= (parse-to-lisp-with-context :music-data "(prn \\( (+ 1 1) \\))") - '((prn \( (+ 1 1) \))))))) + (is (= (parse-input "(prn \\()" :output :events) + [(prn \()])) + (is (= (parse-input "(prn \\))" :output :events) + [(prn \))])) + (is (= (parse-input "(prn \\( (+ 1 1) \\))" :output :events) + [(prn \( (+ 1 1) \))])))) (deftest vector-tests (testing "vectors are a thing" - (is (= (parse-to-lisp-with-context :music-data "(prn [1 2 3 \\a :b \"c\"])") - '((prn [1 2 3 \a :b "c"]))))) + (is (= (parse-input "(prn [1 2 3 \\a :b \"c\"])" :output :events) + [(prn [1 2 3 \a :b "c"])]))) (testing "vectors can have commas in them" - (is (= (parse-to-lisp-with-context :music-data "(prn [1, 2, 3])") - '((prn [1 2 3])))))) + (is (= (parse-input "(prn [1, 2, 3])" :output :events) + [(prn [1 2 3])])))) (deftest map-tests (testing "maps are a thing" - (is (= (parse-to-lisp-with-context :music-data "(prn {:a 1 :b 2 :c 3})") - '((prn {:a 1 :b 2 :c 3}))))) + (is (= (parse-input "(prn {:a 1 :b 2 :c 3})" :output :events) + [(prn {:a 1 :b 2 :c 3})]))) (testing "maps can have commas in them" - (is (= (parse-to-lisp-with-context :music-data "(prn {:a 1, :b 2, :c 3})") - '((prn {:a 1 :b 2 :c 3})))))) + (is (= (parse-input "(prn {:a 1, :b 2, :c 3})" :output :events) + [(prn {:a 1 :b 2 :c 3})])))) (deftest set-tests (testing "sets are a thing" - (is (= (parse-to-lisp-with-context :music-data "(prn #{1 2 3})") - '((prn #{1 2 3}))))) + (is (= (parse-input "(prn #{1 2 3})" :output :events) + [(prn #{1 2 3})]))) (testing "sets can have commas in them" - (is (= (parse-to-lisp-with-context :music-data "(prn #{1, 2, 3})") - '((prn #{1 2 3})))))) + (is (= (parse-input "(prn #{1, 2, 3})" :output :events) + [(prn #{1 2 3})])))) (deftest nesting-things (testing "things can be nested and it won't break shit" - (is (= (parse-to-lisp-with-context :music-data "(prn [1 2 [3 4] 5])") - '((prn [1 2 [3 4] 5])))) - (is (= (parse-to-lisp-with-context :music-data "(prn #{1 2 #{3 4} 5})") - '((prn #{1 2 #{3 4} 5})))) - (is (= (parse-to-lisp-with-context :music-data "(prn (+ 1 [2 {3 #{4 5}}]))") - '((prn (+ 1 [2 {3 #{4 5}}]))))))) + (is (= (parse-input "(prn [1 2 [3 4] 5])" :output :events) + [(prn [1 2 [3 4] 5])])) + (is (= (parse-input "(prn #{1 2 #{3 4} 5})" :output :events) + [(prn #{1 2 #{3 4} 5})])) + (is (= (parse-input "(prn (+ 1 [2 {3 #{4 5}}]))" :output :events) + [(prn (+ 1 [2 {3 #{4 5}}]))])))) diff --git a/test/alda/parser/duration_test.clj b/test/alda/parser/duration_test.clj index 5917560..f51cc7d 100644 --- a/test/alda/parser/duration_test.clj +++ b/test/alda/parser/duration_test.clj @@ -1,64 +1,64 @@ (ns alda.parser.duration-test (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + [alda.parser :refer (parse-input)])) (deftest duration-tests (testing "duration" - (is (= (parse-to-lisp-with-context :music-data "c2") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 2)))))))) + (is (= (parse-input "c2" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 2)))])))) (deftest dot-tests (testing "dots" - (is (= (parse-to-lisp-with-context :music-data "c2..") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 2 {:dots 2})))))))) + (is (= (parse-input "c2.." :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 2 {:dots 2})))])))) (deftest millisecond-duration-tests (testing "duration in milliseconds" - (is (= (parse-to-lisp-with-context :music-data "c450ms") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/ms 450)))))))) + (is (= (parse-input "c450ms" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/ms 450)))])))) (deftest second-duration-tests (testing "duration in seconds" - (is (= (parse-to-lisp-with-context :music-data "c2s") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/ms 2000)))))))) + (is (= (parse-input "c2s" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/ms 2000)))])))) (deftest tie-and-slur-tests (testing "ties" (testing "ties" - (is (= (parse-to-lisp-with-context :music-data "c1~2~4") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 1) - (alda.lisp/note-length 2) - (alda.lisp/note-length 4)))))) - (is (= (parse-to-lisp-with-context :music-data "c500ms~350ms") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/ms 500) - (alda.lisp/ms 350)))))) - (is (= (parse-to-lisp-with-context :music-data "c5s~4~350ms") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/ms 5000) - (alda.lisp/note-length 4) - (alda.lisp/ms 350))))))) + (is (= (parse-input "c1~2~4" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 1) + (alda.lisp/note-length 2) + (alda.lisp/note-length 4)))])) + (is (= (parse-input "c500ms~350ms" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/ms 500) + (alda.lisp/ms 350)))])) + (is (= (parse-input "c5s~4~350ms" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/ms 5000) + (alda.lisp/note-length 4) + (alda.lisp/ms 350)))]))) (testing "slurs" - (is (= (parse-to-lisp-with-context :music-data "c4~") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 4)) - :slur)))) - (is (= (parse-to-lisp-with-context :music-data "c420ms~") - '((alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/ms 420)) - :slur))))))) + (is (= (parse-input "c4~" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 4)) + :slur)])) + (is (= (parse-input "c420ms~" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/ms 420)) + :slur)]))))) diff --git a/test/alda/parser/event_sequences_test.clj b/test/alda/parser/event_sequences_test.clj index 2bf8628..a0e8a02 100644 --- a/test/alda/parser/event_sequences_test.clj +++ b/test/alda/parser/event_sequences_test.clj @@ -1,35 +1,35 @@ (ns alda.parser.event-sequences-test (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + [alda.parser :refer (parse-input)])) (deftest event-sequence-tests (testing "event sequences" - (is (= (parse-to-lisp-with-context :music-data "[]") '([]))) - (is (= (parse-to-lisp-with-context :music-data "[ ]") '([]))) - (is (= (parse-to-lisp-with-context :music-data "[ c d e f c/e/g ]") - '([(alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f)) - (alda.lisp/chord - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :g)))]))) - (is (= (parse-to-lisp-with-context :music-data "[c d [e f] g]") - '([(alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - [(alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f))] - (alda.lisp/note (alda.lisp/pitch :g))])))) + (is (= (parse-input "[]" :output :events) [[]])) + (is (= (parse-input "[ ]" :output :events) [[]])) + (is (= (parse-input "[ c d e f c/e/g ]" :output :events) + [[(alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f)) + (alda.lisp/chord + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :g)))]])) + (is (= (parse-input "[c d [e f] g]" :output :events) + [[(alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + [(alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f))] + (alda.lisp/note (alda.lisp/pitch :g))]]))) (testing "voices within event sequences parse successfully" - (is (= (parse-to-lisp-with-context :music-data "[V1: e b d V2: a c f]") - '([(alda.lisp/voice + (is (= (parse-input "[V1: e b d V2: a c f]" :output :events) + [[(alda.lisp/voice 1 (alda.lisp/note (alda.lisp/pitch :e)) (alda.lisp/note (alda.lisp/pitch :b)) (alda.lisp/note (alda.lisp/pitch :d))) - (alda.lisp/voice + (alda.lisp/voice 2 (alda.lisp/note (alda.lisp/pitch :a)) (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :f)))]))))) + (alda.lisp/note (alda.lisp/pitch :f)))]])))) diff --git a/test/alda/parser/events_test.clj b/test/alda/parser/events_test.clj index 4afe3bb..9e5c1fc 100644 --- a/test/alda/parser/events_test.clj +++ b/test/alda/parser/events_test.clj @@ -1,113 +1,122 @@ (ns alda.parser.events-test (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + [alda.parser :refer (parse-input)])) (deftest note-tests (testing "notes" - (is (= (parse-to-lisp-with-context :music-data "c") - '((alda.lisp/note (alda.lisp/pitch :c))))) - (is (= (parse-to-lisp-with-context :music-data "c4") - '((alda.lisp/note (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 4)))))) - (is (= (parse-to-lisp-with-context :music-data "c+") - '((alda.lisp/note (alda.lisp/pitch :c :sharp))))) - (is (= (parse-to-lisp-with-context :music-data "b-") - '((alda.lisp/note (alda.lisp/pitch :b :flat)))))) + (is (= (parse-input "c" :output :events) + [(alda.lisp/note (alda.lisp/pitch :c))])) + (is (= (parse-input "c4" :output :events) + [(alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 4)))])) + (is (= (parse-input "c+" :output :events) + [(alda.lisp/note (alda.lisp/pitch :c :sharp))])) + (is (= (parse-input "b-" :output :events) + [(alda.lisp/note (alda.lisp/pitch :b :flat))]))) (testing "rests" - (is (= (parse-to-lisp-with-context :music-data "r") - '((alda.lisp/pause))) - (= (parse-to-lisp-with-context :music-data "r1") - '((alda.lisp/pause (alda.lisp/duration (alda.lisp/note-length 1)))))))) + (is (= (parse-input "r" :output :events) + [(alda.lisp/pause)]) + (= (parse-input "r1" :output :events) + [(alda.lisp/pause (alda.lisp/duration (alda.lisp/note-length 1)))])))) (deftest chord-tests (testing "chords" - (is (= (parse-to-lisp-with-context :music-data "c/e/g") - '((alda.lisp/chord + (is (= (parse-input "c/e/g" :output :events) + [(alda.lisp/chord (alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :g)))))) - (is (= (parse-to-lisp-with-context :music-data "c1/>e2/g4/r8") - '((alda.lisp/chord - (alda.lisp/note (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 1))) - (alda.lisp/octave :up) - (alda.lisp/note (alda.lisp/pitch :e) - (alda.lisp/duration (alda.lisp/note-length 2))) - (alda.lisp/note (alda.lisp/pitch :g) - (alda.lisp/duration (alda.lisp/note-length 4))) - (alda.lisp/pause (alda.lisp/duration (alda.lisp/note-length 8))))))) - (is (= (parse-to-lisp-with-context :music-data "b>/d/f2.") - '((alda.lisp/chord - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/octave :up) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :f) - (alda.lisp/duration (alda.lisp/note-length 2 {:dots 1}))))))))) + (alda.lisp/note (alda.lisp/pitch :g)))])) + (is (= (parse-input "c1/>e2/g4/r8" :output :events) + [(alda.lisp/chord + (alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 1))) + (alda.lisp/octave :up) + (alda.lisp/note + (alda.lisp/pitch :e) + (alda.lisp/duration (alda.lisp/note-length 2))) + (alda.lisp/note + (alda.lisp/pitch :g) + (alda.lisp/duration (alda.lisp/note-length 4))) + (alda.lisp/pause + (alda.lisp/duration (alda.lisp/note-length 8))))])) + (is (= (parse-input "b>/d/f2." :output :events) + [(alda.lisp/chord + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/octave :up) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note + (alda.lisp/pitch :f) + (alda.lisp/duration (alda.lisp/note-length 2 {:dots 1}))))])))) (deftest voice-tests (testing "voices" - (is (= (parse-to-lisp-with-context :part "piano: V1: a b c") - '(alda.lisp/part {:names ["piano"]} + (is (= (parse-input "piano: V1: a b c" :output :events) + [(alda.lisp/part {:names ["piano"]} (alda.lisp/voice 1 - (alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c)))))) - (is (= (parse-to-lisp-with-context :part "piano: - V1: a b c - V2: d e f") - '(alda.lisp/part {:names ["piano"]} + (alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c))))])) + (is (= (parse-input "piano: + V1: a b c + V2: d e f" + :output :events) + [(alda.lisp/part {:names ["piano"]} (alda.lisp/voice 1 - (alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c))) + (alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c))) (alda.lisp/voice 2 - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f)))))) - (is (= (parse-to-lisp-with-context :part "piano: - V1: a b c | V2: d e f") - '(alda.lisp/part {:names ["piano"]} + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f))))])) + (is (= (parse-input "piano: + V1: a b c | V2: d e f" + :output :events) + [(alda.lisp/part {:names ["piano"]} (alda.lisp/voice 1 - (alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/barline)) + (alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/barline)) (alda.lisp/voice 2 - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f)))))) - (is (= (parse-to-lisp-with-context :part "piano: - V1: [a b c] *8 - V2: [d e f] *8") - '(alda.lisp/part {:names ["piano"]} + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f))))])) + (is (= (parse-input "piano: + V1: [a b c] *8 + V2: [d e f] *8" + :output :events) + [(alda.lisp/part {:names ["piano"]} (alda.lisp/voice 1 - (alda.lisp/times 8 - [(alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c))])) + (alda.lisp/times 8 + [(alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c))])) (alda.lisp/voice 2 - (alda.lisp/times 8 - [(alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f))]))))))) + (alda.lisp/times 8 + [(alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f))])))])))) (deftest marker-tests (testing "markers" - (is (= (parse-to-lisp-with-context :music-data "%chorus") - '((alda.lisp/marker "chorus")))) - (is (= (parse-to-lisp-with-context :music-data "@verse-1") - '((alda.lisp/at-marker "verse-1")))))) + (is (= (parse-input "%chorus" :output :events) + [(alda.lisp/marker "chorus")])) + (is (= (parse-input "@verse-1" :output :events) + [(alda.lisp/at-marker "verse-1")])))) (deftest cram-tests (testing "crams" - (is (= (parse-to-lisp-with-context :music-data "{c d e}") - '((alda.lisp/cram - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)))))) - (is (= (parse-to-lisp-with-context :music-data "{c d e}2") - '((alda.lisp/cram - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/duration (alda.lisp/note-length 2)))))))) + (is (= (parse-input "{c d e}" :output :events) + [(alda.lisp/cram + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)))])) + (is (= (parse-input "{c d e}2" :output :events) + [(alda.lisp/cram + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/duration (alda.lisp/note-length 2)))])))) diff --git a/test/alda/parser/octaves_test.clj b/test/alda/parser/octaves_test.clj index f06c07c..4be511c 100644 --- a/test/alda/parser/octaves_test.clj +++ b/test/alda/parser/octaves_test.clj @@ -1,37 +1,37 @@ (ns alda.parser.octaves-test (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + [alda.parser :refer (parse-input)])) (deftest octave-tests (testing "octave change" - (is (= '((alda.lisp/octave :up)) - (parse-to-lisp-with-context :music-data ">"))) - (is (= '((alda.lisp/octave :down)) - (parse-to-lisp-with-context :music-data "<"))) - (is (= '((alda.lisp/octave 5)) - (parse-to-lisp-with-context :music-data "o5")))) + (is (= [(alda.lisp/octave :up)] + (parse-input ">" :output :events))) + (is (= [(alda.lisp/octave :down)] + (parse-input "<" :output :events))) + (is (= [(alda.lisp/octave 5)] + (parse-input "o5" :output :events)))) (testing "multiple octave changes back to back without spaces" - (is (= '((alda.lisp/octave :up) - (alda.lisp/octave :up) - (alda.lisp/octave :up)) - (parse-to-lisp-with-context :music-data ">>>"))) - (is (= '((alda.lisp/octave :down) - (alda.lisp/octave :down) - (alda.lisp/octave :down)) - (parse-to-lisp-with-context :music-data "<<<"))) - (is (= '((alda.lisp/octave :up) - (alda.lisp/octave :down) - (alda.lisp/octave :up)) - (parse-to-lisp-with-context :music-data "><>")))) + (is (= [(alda.lisp/octave :up) + (alda.lisp/octave :up) + (alda.lisp/octave :up)] + (parse-input ">>>" :output :events))) + (is (= [(alda.lisp/octave :down) + (alda.lisp/octave :down) + (alda.lisp/octave :down)] + (parse-input "<<<" :output :events))) + (is (= [(alda.lisp/octave :up) + (alda.lisp/octave :down) + (alda.lisp/octave :up)] + (parse-input "><>" :output :events)))) (testing "octave changes back to back with notes" - (is (= '((alda.lisp/octave :up) - (alda.lisp/note (alda.lisp/pitch :c))) - (parse-to-lisp-with-context :music-data ">c"))) - (is (= '((alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/octave :down)) - (parse-to-lisp-with-context :music-data "c<"))) - (is (= '((alda.lisp/octave :up) - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/octave :down)) - (parse-to-lisp-with-context :music-data ">c<"))))) + (is (= [(alda.lisp/octave :up) + (alda.lisp/note (alda.lisp/pitch :c))] + (parse-input ">c" :output :events))) + (is (= [(alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/octave :down)] + (parse-input "c<" :output :events))) + (is (= [(alda.lisp/octave :up) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/octave :down)] + (parse-input ">c<" :output :events))))) diff --git a/test/alda/parser/repeats_test.clj b/test/alda/parser/repeats_test.clj index 162260f..75cd504 100644 --- a/test/alda/parser/repeats_test.clj +++ b/test/alda/parser/repeats_test.clj @@ -1,35 +1,35 @@ (ns alda.parser.repeats-test - (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)])) + (:require [clojure.test :refer :all] + [alda.parser :refer (parse-input)])) (deftest repeat-tests (testing "repeated events" - (is (= (parse-to-lisp-with-context :music-data "[c d e] *4") - '((alda.lisp/times 4 - [(alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e))])))) - (is (= (parse-to-lisp-with-context :music-data "[ c > ]*5") - '((alda.lisp/times 5 - [(alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/octave :up)])))) - (is (= (parse-to-lisp-with-context :music-data "[ c > ] * 5") - '((alda.lisp/times 5 - [(alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/octave :up)])))) - (is (= (parse-to-lisp-with-context :music-data "c8*7") - '((alda.lisp/times 7 - (alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 8))))))) - (is (= (parse-to-lisp-with-context :music-data "c8 *7") - '((alda.lisp/times 7 - (alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 8))))))) - (is (= (parse-to-lisp-with-context :music-data "c8 * 7") - '((alda.lisp/times 7 - (alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 8))))))))) + (is (= (parse-input "[c d e] *4" :output :events) + [(alda.lisp/times 4 + [(alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e))])])) + (is (= (parse-input "[ c > ]*5" :output :events) + [(alda.lisp/times 5 + [(alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/octave :up)])])) + (is (= (parse-input "[ c > ] * 5" :output :events) + [(alda.lisp/times 5 + [(alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/octave :up)])])) + (is (= (parse-input "c8*7" :output :events) + [(alda.lisp/times 7 + (alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 8))))])) + (is (= (parse-input "c8 *7" :output :events) + [(alda.lisp/times 7 + (alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 8))))])) + (is (= (parse-input "c8 * 7" :output :events) + [(alda.lisp/times 7 + (alda.lisp/note + (alda.lisp/pitch :c) + (alda.lisp/duration (alda.lisp/note-length 8))))])))) diff --git a/test/alda/parser/variables_test.clj b/test/alda/parser/variables_test.clj index 706f757..c501582 100644 --- a/test/alda/parser/variables_test.clj +++ b/test/alda/parser/variables_test.clj @@ -1,65 +1,64 @@ (ns alda.parser.variables-test - (:require [clojure.test :refer :all] - [alda.parser-util :refer (parse-to-lisp-with-context)] - [instaparse.core :refer (failure?)])) + (:require [clojure.test :refer :all] + [alda.parser :refer (parse-input)])) (deftest variable-name-tests (testing "variable names" (testing "must start with two letters" - (is (= '((alda.lisp/get-variable :aa)) - (parse-to-lisp-with-context :music-data "aa"))) - (is (= '((alda.lisp/get-variable :aaa)) - (parse-to-lisp-with-context :music-data "aaa"))) - (is (= '((alda.lisp/get-variable :HI)) - (parse-to-lisp-with-context :music-data "HI"))) - (is (thrown? Exception (parse-to-lisp-with-context :music-data "x"))) - (is (thrown? Exception (parse-to-lisp-with-context :music-data "y2"))) - (is (thrown? Exception (parse-to-lisp-with-context :music-data "1234kittens"))) - (is (thrown? Exception (parse-to-lisp-with-context :music-data "r2d2"))) - (is (thrown? Exception (parse-to-lisp-with-context :music-data "i_like_underscores")))) + (is (= [(alda.lisp/get-variable :aa)] + (parse-input "aa" :output :events))) + (is (= [(alda.lisp/get-variable :aaa)] + (parse-input "aaa" :output :events))) + (is (= [(alda.lisp/get-variable :HI)] + (parse-input "HI" :output :events))) + (is (thrown? Exception (parse-input "x" :output :events))) + (is (thrown? Exception (parse-input "y2" :output :events))) + (is (thrown? Exception (parse-input "1234kittens" :output :events))) + (is (thrown? Exception (parse-input "r2d2" :output :events))) + (is (thrown? Exception (parse-input "i_like_underscores" :output :events)))) (testing "can't contain pluses or minuses" - (is (thrown? Exception (parse-to-lisp-with-context :music-data "jar-jar-binks"))) - (is (thrown? Exception (parse-to-lisp-with-context :music-data "han+leia"))) - (is (thrown? Exception (parse-to-lisp-with-context :music-data "ionlyprograminc++")))) + (is (thrown? Exception (parse-input "jar-jar-binks" :output :events))) + (is (thrown? Exception (parse-input "han+leia" :output :events))) + (is (thrown? Exception (parse-input "ionlyprograminc++" :output :events)))) (testing "can contain digits" - (is (= '((alda.lisp/get-variable :celloPart2)) - (parse-to-lisp-with-context :music-data "celloPart2"))) - (is (= '((alda.lisp/get-variable :xy42)) - (parse-to-lisp-with-context :music-data "xy42"))) - (is (= '((alda.lisp/get-variable :my20cats)) - (parse-to-lisp-with-context :music-data "my20cats")))) + (is (= [(alda.lisp/get-variable :celloPart2)] + (parse-input "celloPart2" :output :events))) + (is (= [(alda.lisp/get-variable :xy42)] + (parse-input "xy42" :output :events))) + (is (= [(alda.lisp/get-variable :my20cats)] + (parse-input "my20cats" :output :events)))) (testing "can contain underscores" - (is (= '((alda.lisp/get-variable :apple_cider)) - (parse-to-lisp-with-context :music-data "apple_cider"))) - (is (= '((alda.lisp/get-variable :underscores__are___great____)) - (parse-to-lisp-with-context :music-data "underscores__are___great____")))))) + (is (= [(alda.lisp/get-variable :apple_cider)] + (parse-input "apple_cider" :output :events))) + (is (= [(alda.lisp/get-variable :underscores__are___great____)] + (parse-input "underscores__are___great____" :output :events)))))) (deftest variable-get-tests (testing "variable getting" - (is (= '(alda.lisp/score + (is (= [(alda.lisp/score (alda.lisp/part {:names ["flute"]} (alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/get-variable :flan) - (alda.lisp/note (alda.lisp/pitch :f)))) - (parse-to-lisp-with-context :score "flute: c flan f"))) - (is (= '(alda.lisp/score + (alda.lisp/note (alda.lisp/pitch :f))))] + (parse-input "flute: c flan f" :output :events))) + (is (= [(alda.lisp/score (alda.lisp/part {:names ["clarinet"]} - (alda.lisp/get-variable :pudding123))) - (parse-to-lisp-with-context :score "clarinet: pudding123"))))) + (alda.lisp/get-variable :pudding123)))] + (parse-input "clarinet: pudding123" :output :events))))) (deftest variable-set-tests (testing "variable setting" (testing "within an instrument part" - (is (= '(alda.lisp/score - (alda.lisp/part {:names ["harpsichord"]} - (alda.lisp/set-variable :custard_ - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/chord - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :g)))))) - (parse-to-lisp-with-context :score "harpsichord:\n\ncustard_ = c d e/g"))) - (is (= '(alda.lisp/score + (is (= [alda.lisp/score + (alda.lisp/part {:names ["harpsichord"]} + (alda.lisp/set-variable :custard_ + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/chord + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :g)))))] + (parse-input "harpsichord:\n\ncustard_ = c d e/g" :output :events))) + (is (= [(alda.lisp/score (alda.lisp/part {:names ["glockenspiel"]} (alda.lisp/set-variable :sorbet (alda.lisp/note (alda.lisp/pitch :c)) @@ -67,15 +66,15 @@ (alda.lisp/chord (alda.lisp/note (alda.lisp/pitch :e)) (alda.lisp/note (alda.lisp/pitch :g)))) - (alda.lisp/note (alda.lisp/pitch :c)))) - (parse-to-lisp-with-context :score "glockenspiel:\n\nsorbet=c d e/g\nc")))) + (alda.lisp/note (alda.lisp/pitch :c))))] + (parse-input "glockenspiel:\n\nsorbet=c d e/g\nc" :output :events)))) (testing "at the top of a score" - (is (= '(alda.lisp/score + (is (= [(alda.lisp/score (alda.lisp/set-variable :GELATO (alda.lisp/note (alda.lisp/pitch :d)) (alda.lisp/note (alda.lisp/pitch :e))) (alda.lisp/part {:names ["clavinet"]} (alda.lisp/chord (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :f))))) - (parse-to-lisp-with-context :score "GELATO=d e\n\nclavinet: c/f")))))) + (alda.lisp/note (alda.lisp/pitch :f)))))] + (parse-input "GELATO=d e\n\nclavinet: c/f" :output :events)))))) From a802c302a051b26afc95ff120a5dae3e7dedaff2 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Wed, 3 May 2017 22:17:04 -0400 Subject: [PATCH 10/22] allow names to include dots (group access operator) --- src/alda/parser/tokenize.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/alda/parser/tokenize.clj b/src/alda/parser/tokenize.clj index ab5849a..608d6da 100644 --- a/src/alda/parser/tokenize.clj +++ b/src/alda/parser/tokenize.clj @@ -425,7 +425,7 @@ (when (currently-parsing? parser :name) (if ((set (str "abcdefghijklmnopqrstuvwxyz" "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - "0123456789_-")) + "0123456789_-.")) character) (-> parser (read-to-buffer character)) (-> parser (emit-token! :pop-stack? true) From f668ce5b7e6f1ed30552aa42afe9815b2735d881 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Thu, 4 May 2017 07:18:24 -0400 Subject: [PATCH 11/22] replace pitch-fn with a map containing letter and accidentals Conceptually simpler, and allows for notes to be equal in Clojure's eyes. --- src/alda/lisp/events.clj | 21 +++++++++++---------- src/alda/lisp/events/note.clj | 9 +++++---- src/alda/lisp/model/pitch.clj | 29 +++++++++++++++-------------- src/alda/parser/parse_events.clj | 4 ++-- 4 files changed, 33 insertions(+), 30 deletions(-) diff --git a/src/alda/lisp/events.clj b/src/alda/lisp/events.clj index d92eb14..8206b6c 100644 --- a/src/alda/lisp/events.clj +++ b/src/alda/lisp/events.clj @@ -23,19 +23,20 @@ If no duration is specified, the note is played for the instrument's own internal duration, which will be the duration last specified on a note or rest in that instrument's part." - ([pitch-fn] - (note pitch-fn nil false)) - ([pitch-fn x] + ([pitch] + (note pitch nil false)) + ([pitch x] ; x could be a duration or :slur (let [duration (when (map? x) x) slur? (= x :slur)] - (note pitch-fn duration slur?))) - ([pitch-fn {:keys [beats ms slurred]} slur?] - {:event-type :note - :pitch-fn pitch-fn - :beats beats - :ms ms - :slur? (or slur? slurred)})) + (note pitch duration slur?))) + ([{:keys [letter accidentals]} {:keys [beats ms slurred]} slur?] + {:event-type :note + :letter letter + :accidentals accidentals + :beats beats + :ms ms + :slur? (or slur? slurred)})) (defn pause "Causes every instrument in :current-instruments to rest (not play) for the diff --git a/src/alda/lisp/events/note.clj b/src/alda/lisp/events/note.clj index 276656e..2a652c9 100644 --- a/src/alda/lisp/events/note.clj +++ b/src/alda/lisp/events/note.clj @@ -3,6 +3,7 @@ [alda.lisp.model.duration :refer (calculate-duration)] [alda.lisp.model.event :refer (update-score add-events)] [alda.lisp.model.offset :refer (offset+)] + [alda.lisp.model.pitch :refer (determine-midi-note midi->hz)] [alda.lisp.model.records :refer (map->Note)] [alda.lisp.score.util :refer (merge-instruments merge-voice-instruments @@ -20,7 +21,7 @@ :state -- any number of keys with updated values. This will be merged into the existing state of the instrument." [{:keys [instruments chord-mode cram-level current-voice] :as score} - {:keys [event-type pitch-fn beats ms slur?] :as event}] + {:keys [event-type beats ms slur?] :as event}] (for [{:keys [id duration duration-inside-cram time-scaling tempo current-offset last-offset current-marker quantization volume track-volume panning octave key-signature min-duration] @@ -35,10 +36,10 @@ time-scaling ms) quant-duration (* full-duration quant) - pitch (if (= event-type :note) - (pitch-fn octave key-signature)) midi-note (if (= event-type :note) - (pitch-fn octave key-signature :midi true)) + (determine-midi-note event octave key-signature)) + pitch (if (= event-type :note) + (midi->hz midi-note)) note (if (= event-type :note) (map->Note {:offset current-offset diff --git a/src/alda/lisp/model/pitch.clj b/src/alda/lisp/model/pitch.clj index d9c23f3..2885c37 100644 --- a/src/alda/lisp/model/pitch.clj +++ b/src/alda/lisp/model/pitch.clj @@ -9,7 +9,7 @@ [letter octave] (+ (intervals letter) (* octave 12) 12)) -(defn- midi->hz +(defn midi->hz "Converts a MIDI note number to the note's frequency in Hz." [note] (* 440.0 (Math/pow 2.0 (/ (- note 69.0) 12.0)))) @@ -24,19 +24,20 @@ (get signature letter) accidentals)) +(defn determine-midi-note + "Determines the MIDI note number of a note, within the context of an + instrument's octave and key signature." + [{:keys [letter accidentals] :as note} octave key-sig] + (reduce (fn [number accidental] + (case accidental + :flat (dec number) + :sharp (inc number) + :natural (identity number))) + (midi-note letter octave) + (apply-key key-sig letter accidentals))) + (defn pitch - "Returns a fn that will calculate the frequency in Hz, within the context - of an instrument's octave and key signature." [letter & accidentals] - (fn [octave key-sig & {:keys [midi]}] - (let [midi-note (reduce (fn [number accidental] - (case accidental - :flat (dec number) - :sharp (inc number) - :natural (identity number))) - (midi-note letter octave) - (apply-key key-sig letter accidentals))] - (if midi - midi-note - (midi->hz midi-note))))) + {:letter letter + :accidentals (or accidentals [])}) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj index 2dc8300..fb503eb 100644 --- a/src/alda/parser/parse_events.clj +++ b/src/alda/parser/parse_events.clj @@ -135,7 +135,7 @@ :when (= :accidentals type)] (map {\+ :sharp \- :flat \_ :natural} content)) flatten) - pitch-fn (apply pitch/pitch (keyword (:content letter)) accidentals) + pitch (apply pitch/pitch (keyword (:content letter)) accidentals) duration (-> (for [{:keys [type] :as event} more :when (= :duration type)] (alda-event-with-metadata event)) @@ -143,7 +143,7 @@ slur (when (or (some #(= :tie (:type %)) more) (:slur? duration)) :slur)] - (-> (event/note pitch-fn duration slur) + (-> (event/note pitch duration slur) (merge (when chord? {:chord? true}))))) (defmethod alda-event :note-length From dfaa9aef97265ac322eb3134e9775f2157716014 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Thu, 4 May 2017 07:19:24 -0400 Subject: [PATCH 12/22] require/refer alda.lisp on demand --- src/alda/parser.clj | 2 +- test/alda/parser/events_test.clj | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/alda/parser.clj b/src/alda/parser.clj index ef5a20a..f1e19ea 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -122,7 +122,7 @@ ;; alda.lisp must be required and referred in order to use inline Clojure ;; expressions. (when-not (resolve 'ALDA-LISP-LOADED) - (throw (Exception. "Prequisite: (require '[alda.lisp :refer :all])"))) + (require '[alda.lisp :refer :all])) (case output :score (-> input tokenize parse-events aggregate-events build-score Date: Thu, 4 May 2017 07:20:42 -0400 Subject: [PATCH 13/22] aggregate_events fixes - dissoc :chord? from notes so that they can be equal to notes created via alda.lisp - don't flush the buffer on attribute changes --- src/alda/parser/aggregate_events.clj | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/alda/parser/aggregate_events.clj b/src/alda/parser/aggregate_events.clj index 4ad7a7b..14c032a 100644 --- a/src/alda/parser/aggregate_events.clj +++ b/src/alda/parser/aggregate_events.clj @@ -25,7 +25,7 @@ (defn flush-buffer! [{:keys [buffer] :as parser}] (if (some :chord? buffer) - (let [chord (apply event/chord buffer)] + (let [chord (apply event/chord (map #(dissoc % :chord?) buffer))] (emit-event! parser chord)) (doseq [event buffer] (emit-event! parser event))) @@ -47,6 +47,9 @@ (-> parser (add-to-buffer event)) (-> parser flush-buffer! (add-to-buffer event))) + (= :attribute-change (:event-type event)) + (-> parser (add-to-buffer event)) + :else (-> parser flush-buffer! (emit-event! event)))) From 2bf346b551bfafe29c323d46383ad621ee852c7f Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Thu, 4 May 2017 07:25:53 -0400 Subject: [PATCH 14/22] fixes for parsing notes, rests & chords --- src/alda/parser/parse_events.clj | 2 +- src/alda/parser/tokenize.clj | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj index fb503eb..38e8ea0 100644 --- a/src/alda/parser/parse_events.clj +++ b/src/alda/parser/parse_events.clj @@ -518,7 +518,7 @@ (defn start-parsing-chord [parser token] (when (and (token-is :slash token) - (#{:note :rest :duration} (current-event-type parser))) + (not= :instrument-call (last-open-event parser))) (-> parser (assoc :chord? true)))) (defn continue-parsing-chord diff --git a/src/alda/parser/tokenize.clj b/src/alda/parser/tokenize.clj index 608d6da..9ea4d13 100644 --- a/src/alda/parser/tokenize.clj +++ b/src/alda/parser/tokenize.clj @@ -517,11 +517,11 @@ (read-character! character))] (cond (and ((set "abcdefg") char1) - ((conj (set " \n+-_/~*}]0123456789") :EOF) character)) + ((conj (set " \n+-_/~*}]<>0123456789") :EOF) character)) (-> parser (parse :note)) (and (= \r char1) - ((set " \n/~0123456789") character)) + ((conj (set " \n/~*}]<>0123456789") :EOF) character)) (-> parser (parse :rest)) ((set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") character) From d785bd8a1d71ff426e35166cfbb1988114afbd37 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Thu, 4 May 2017 07:26:47 -0400 Subject: [PATCH 15/22] adjust expected parse results The parser now emits "empty" parts and voices, which have the same effect as before because they "set" the part/voice to use for the subsequent events. --- test/alda/parser/events_test.clj | 148 +++++++++++++++---------------- 1 file changed, 74 insertions(+), 74 deletions(-) diff --git a/test/alda/parser/events_test.clj b/test/alda/parser/events_test.clj index 155bf7a..c5dfd78 100644 --- a/test/alda/parser/events_test.clj +++ b/test/alda/parser/events_test.clj @@ -5,31 +5,30 @@ (deftest note-tests (testing "notes" - (is (= (parse-input "c" :output :events) - [(alda.lisp/note (alda.lisp/pitch :c))])) - (is (= (parse-input "c4" :output :events) - [(alda.lisp/note + (is (= [(alda.lisp/note (alda.lisp/pitch :c))] + (parse-input "c" :output :events))) + (is (= [(alda.lisp/note (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 4)))])) - (is (= (parse-input "c+" :output :events) - [(alda.lisp/note (alda.lisp/pitch :c :sharp))])) - (is (= (parse-input "b-" :output :events) - [(alda.lisp/note (alda.lisp/pitch :b :flat))]))) + (alda.lisp/duration (alda.lisp/note-length 4)))] + (parse-input "c4" :output :events))) + (is (= [(alda.lisp/note (alda.lisp/pitch :c :sharp))] + (parse-input "c+" :output :events))) + (is (= [(alda.lisp/note (alda.lisp/pitch :b :flat))] + (parse-input "b-" :output :events)))) (testing "rests" - (is (= (parse-input "r" :output :events) - [(alda.lisp/pause)]) - (= (parse-input "r1" :output :events) - [(alda.lisp/pause (alda.lisp/duration (alda.lisp/note-length 1)))])))) + (is (= [(alda.lisp/pause)] + (parse-input "r" :output :events)) + (= [(alda.lisp/pause (alda.lisp/duration (alda.lisp/note-length 1)))] + (parse-input "r1" :output :events))))) (deftest chord-tests (testing "chords" - (is (= (parse-input "c/e/g" :output :events) - [(alda.lisp/chord + (is (= [(alda.lisp/chord (alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :g)))])) - (is (= (parse-input "c1/>e2/g4/r8" :output :events) - [(alda.lisp/chord + (alda.lisp/note (alda.lisp/pitch :g)))] + (parse-input "c/e/g" :output :events))) + (is (= [(alda.lisp/chord (alda.lisp/note (alda.lisp/pitch :c) (alda.lisp/duration (alda.lisp/note-length 1))) @@ -41,83 +40,84 @@ (alda.lisp/pitch :g) (alda.lisp/duration (alda.lisp/note-length 4))) (alda.lisp/pause - (alda.lisp/duration (alda.lisp/note-length 8))))])) - (is (= (parse-input "b>/d/f2." :output :events) - [(alda.lisp/chord + (alda.lisp/duration (alda.lisp/note-length 8))))] + (parse-input "c1/>e2/g4/r8" :output :events))) + (is (= [(alda.lisp/chord (alda.lisp/note (alda.lisp/pitch :b)) (alda.lisp/octave :up) (alda.lisp/note (alda.lisp/pitch :d)) (alda.lisp/note (alda.lisp/pitch :f) - (alda.lisp/duration (alda.lisp/note-length 2 {:dots 1}))))])))) + (alda.lisp/duration (alda.lisp/note-length 2 {:dots 1}))))] + (parse-input "b>/d/f2." :output :events))))) (deftest voice-tests (testing "voices" - (is (= (parse-input "piano: V1: a b c" :output :events) - [(alda.lisp/part {:names ["piano"]} - (alda.lisp/voice 1 - (alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c))))])) - (is (= (parse-input "piano: + (is (= [(alda.lisp/part {:names ["piano"]}) + (alda.lisp/voice 1) + (alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c))] + (parse-input "piano: V1: a b c" :output :events))) + (is (= [(alda.lisp/part {:names ["piano"]}) + (alda.lisp/voice 1) + (alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/voice 2) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f))] + (parse-input "piano: V1: a b c V2: d e f" - :output :events) - [(alda.lisp/part {:names ["piano"]} - (alda.lisp/voice 1 - (alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c))) - (alda.lisp/voice 2 - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f))))])) - (is (= (parse-input "piano: + :output :events))) + (is (= [(alda.lisp/part {:names ["piano"]}) + (alda.lisp/voice 1) + (alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/barline) + (alda.lisp/voice 2) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f))] + (parse-input "piano: V1: a b c | V2: d e f" - :output :events) - [(alda.lisp/part {:names ["piano"]} - (alda.lisp/voice 1 - (alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/barline)) - (alda.lisp/voice 2 - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f))))])) - (is (= (parse-input "piano: + :output :events))) + (is (= [(alda.lisp/part {:names ["piano"]}) + (alda.lisp/voice 1) + (alda.lisp/times 8 + [(alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :c))]) + (alda.lisp/voice 2) + (alda.lisp/times 8 + [(alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :f))])] + (parse-input "piano: V1: [a b c] *8 V2: [d e f] *8" - :output :events) - [(alda.lisp/part {:names ["piano"]} - (alda.lisp/voice 1 - (alda.lisp/times 8 - [(alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :c))])) - (alda.lisp/voice 2 - (alda.lisp/times 8 - [(alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :f))])))])))) + :output :events))))) (deftest marker-tests (testing "markers" - (is (= (parse-input "%chorus" :output :events) - [(alda.lisp/marker "chorus")])) - (is (= (parse-input "@verse-1" :output :events) - [(alda.lisp/at-marker "verse-1")])))) + (is (= [(alda.lisp/marker "chorus")] + (parse-input "%chorus" :output :events))) + (is (= [(alda.lisp/at-marker "verse-1")] + (parse-input "@verse-1" :output :events))))) (deftest cram-tests (testing "crams" - (is (= (parse-input "{c d e}" :output :events) - [(alda.lisp/cram + (is (= [(alda.lisp/cram (alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)))])) - (is (= (parse-input "{c d e}2" :output :events) - [(alda.lisp/cram + (alda.lisp/note (alda.lisp/pitch :e)))] + (parse-input "{c d e}" :output :events))) + (is (= [(alda.lisp/cram (alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :d)) (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/duration (alda.lisp/note-length 2)))])))) + (alda.lisp/duration (alda.lisp/note-length 2)))] + (parse-input "{c d e}2" :output :events))))) From f7f4761636a83ddda301237b202ecc160c0e3f71 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Sun, 7 May 2017 22:02:00 -0400 Subject: [PATCH 16/22] get all tests passing --- src/alda/parser.clj | 16 +++- src/alda/parser/aggregate_events.clj | 68 +++++++++++--- src/alda/parser/parse_events.clj | 109 +++++++++++++--------- src/alda/parser/tokenize.clj | 6 +- test/alda/examples_test.clj | 94 ++++++++----------- test/alda/lisp/notes_test.clj | 6 +- test/alda/lisp/pitch_test.clj | 53 +++++------ test/alda/parser/clj_exprs_test.clj | 96 +++++++++---------- test/alda/parser/comments_test.clj | 16 ++-- test/alda/parser/event_sequences_test.clj | 36 ++++--- test/alda/parser/repeats_test.clj | 36 +++---- test/alda/parser/score_test.clj | 38 ++++---- test/alda/parser/variables_test.clj | 83 ++++++++-------- test/alda/test_helpers.clj | 11 ++- 14 files changed, 372 insertions(+), 296 deletions(-) diff --git a/src/alda/parser.clj b/src/alda/parser.clj index f1e19ea..7b0fe8b 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -115,7 +115,12 @@ :score => an Alda score map, ready to be performed by the sound engine :events => a lazy sequence of Alda events, which will produce a complete - score when applied sequentially to a new score + score when applied sequentially to a new score. Note that the sequence may + contain an error object if there is any error parsing, and the error is not + thrown. If it is desirable to throw an error, use :events-or-error. + + :events-or-error => equivalent to :events, but the sequence is fully realized + and an error is thrown in the event of a parse error. The default :output is :score." [input & {:keys [output] :or {output :score}}] @@ -128,5 +133,12 @@ (-> input tokenize parse-events aggregate-events build-score input tokenize parse-events aggregate-events stream-seq))) + (-> input tokenize parse-events aggregate-events stream-seq) + + :events-or-error + (let [events (parse-input input :output :events)] + (doseq [event events] + (if (instance? Throwable event) + (throw event))) + events))) diff --git a/src/alda/parser/aggregate_events.clj b/src/alda/parser/aggregate_events.clj index 14c032a..a2ca6e7 100644 --- a/src/alda/parser/aggregate_events.clj +++ b/src/alda/parser/aggregate_events.clj @@ -22,13 +22,50 @@ [parser event] (-> parser (update :buffer conj event))) +(defn take-chord + "Given a sequence of events AFTER an initial note, takes the first N events that can form a chord with the first note." + ([input-events] + (take-chord input-events [])) + ([[x & more] chord-events] + (if (or (not x) + (and (#{:note :rest} (:event-type x)) (not (:chord? x))) + (not (#{:note :rest :attribute-change} (:event-type x)))) + (if (some #(#{:note :rest} (:event-type %)) chord-events) + chord-events + ()) + (recur more (conj chord-events x))))) + +(defn aggregate-inner-events + ([input-events] + (aggregate-inner-events input-events [])) + ([[x & more] events] + (cond + (not x) + events + + (sequential? x) + (recur more (conj events (aggregate-inner-events x))) + + (:chord? x) + (throw (Exception. "No previous note with which to create a chord.")) + + (not (#{:note :rest} (:event-type x))) + (recur more (conj events x)) + + :else + (let [maybe-chord (take-chord more)] + (if (empty? maybe-chord) + (recur more (conj events x)) + (let [chord (->> (cons x maybe-chord) + (map #(if (map? %) (dissoc % :chord?) %)) + (apply event/chord))] + (recur (drop (count maybe-chord) more) + (conj events chord)))))))) + (defn flush-buffer! [{:keys [buffer] :as parser}] - (if (some :chord? buffer) - (let [chord (apply event/chord (map #(dissoc % :chord?) buffer))] - (emit-event! parser chord)) - (doseq [event buffer] - (emit-event! parser event))) + (doseq [event (aggregate-inner-events buffer)] + (emit-event! parser event)) (-> parser (update :buffer empty))) (defn push-event @@ -37,18 +74,27 @@ (instance? Throwable event) (-> parser (emit-event! event)) - (empty? buffer) - (if (#{:note :rest} (:event-type event)) - (-> parser (add-to-buffer event)) - (-> parser (emit-event! event))) + (= :EOF event) + (-> parser flush-buffer!) (#{:note :rest} (:event-type event)) - (if (:chord? event) + (if (or (empty? buffer) (:chord? event)) (-> parser (add-to-buffer event)) (-> parser flush-buffer! (add-to-buffer event))) (= :attribute-change (:event-type event)) - (-> parser (add-to-buffer event)) + (if (empty? buffer) + (-> parser (emit-event! event)) + (-> parser (add-to-buffer event))) + + (#{:cram :set-variable} (:event-type event)) + (let [events (aggregate-inner-events (:events event)) + event (assoc event :events events)] + (-> parser flush-buffer! (emit-event! event))) + + (sequential? event) + (let [events (aggregate-inner-events event)] + (-> parser flush-buffer! (emit-event! events))) :else (-> parser flush-buffer! (emit-event! event)))) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj index 38e8ea0..50bb665 100644 --- a/src/alda/parser/parse_events.clj +++ b/src/alda/parser/parse_events.clj @@ -54,14 +54,22 @@ [[_ _ content :as token]] content) +(defn validate-variable-event + [var-name [line column]] + (if (re-find #"\+|\-" (name var-name)) + (throw (Exception. + (format (str "Invalid variable name '%s' at line %s, column %s: " + "a variable name may not contain '+' or '-'.") + (name var-name) + line + column))))) + (declare alda-event-with-metadata) (defmulti alda-event :type) (defmethod alda-event :default [{:keys [type] :as event}] - ;; temp - (prn :event event) (throw (Exception. (format "Unrecognized event: %s" type)))) (defmethod alda-event :error @@ -107,8 +115,9 @@ (mapv alda-event-with-metadata content)) (defmethod alda-event :get-variable - [{:keys [content]}] - (event/get-variable content)) + [{:keys [content position] :as event}] + (validate-variable-event content position) + (event/get-variable (keyword content))) (defmethod alda-event :instrument-call [{:keys [content]}] @@ -190,9 +199,12 @@ (merge (when chord? {:chord? true}))))) (defmethod alda-event :set-variable - [{:keys [content] :as event}] + [{:keys [content position] :as event}] (let [[var-name events] content] - (apply event/set-variable var-name (map alda-event-with-metadata events)))) + (validate-variable-event var-name position) + (apply event/set-variable + (keyword var-name) + (map alda-event-with-metadata events)))) (defmethod alda-event :voice [{:keys [content] :as event}] @@ -210,9 +222,7 @@ (with-meta event metadata) event))) -(defmulti emit-event! (fn [parser event] (:type event))) - -(defmethod emit-event! :default +(defn emit-event! [{:keys [events-ch] :as parser} event] (>!! events-ch (alda-event-with-metadata event)) parser) @@ -249,6 +259,29 @@ (filter :open?) last)) +(def repeatable? + #{:clj-expr :note :rest :event-seq :get-variable :cram}) + +(defn error + [parser error-content] + (-> parser (emit-event! {:type :error :content error-content}) + (assoc :state :error))) + +(defn unexpected-token-error + [parser token] + (let [error-msg (if (sequential? token) + (let [[token [line column] content] token] + (format "Unexpected %s at line %s, column %s." + (if (= :EOF token) + "EOF" + (get token-names token token)) + line + column)) + (format "Unexpected token: %s." token))] + (-> parser (error error-msg)))) + +(declare push-set-variable) + (defn push-event [{:keys [stack] :as parser} event] (cond @@ -261,6 +294,26 @@ (= :duration (current-event-type parser)) (-> parser append-to-parent (push-event event)) + (= :repeat (:type event)) + (if (and (repeatable? (current-event-type parser)) + (not (:open? (current-event parser)))) + (let [repeats (Integer/parseInt (:content event)) + event-to-repeat (peek stack) + repeat-event (assoc event :content [repeats event-to-repeat])] + (-> parser + (update :stack #(-> % + pop + (conj repeat-event))))) + (-> parser (unexpected-token-error event))) + + ;; EOF can terminate a variable definition + (and (= :EOF event) (= :set-variable (:type (last-open-event parser)))) + (-> parser push-set-variable (push-event event)) + + ;; no other type of container can be open at the end of input + (and (= :EOF event) (last-open-event parser)) + (-> parser (unexpected-token-error event)) + (last-open-event parser) (-> parser (update :stack conj event)) @@ -296,7 +349,7 @@ (drop-while #(not= :set-variable (:type %))) first) set-var-event {:type :set-variable - :content [var-name var-events]}] + :content [(keyword var-name) var-events]}] (-> parser (update :stack #(->> % (drop-last (inc (count var-events))) @@ -325,9 +378,6 @@ (def push-event-seq (push-container :event-seq)) -(def push-voice - (push-container :voice)) - (defn push-instrument-call [{:keys [stack] :as parser}] {:pre [(= :instrument-call (:type (last-open-event parser)))]} @@ -342,24 +392,6 @@ (push-event {:type :instrument-call :content contents})))) -(defn error - [parser error-content] - (-> parser (emit-event! {:type :error :content error-content}) - (assoc :state :error))) - -(defn unexpected-token-error - [parser token] - (let [error-msg (if (sequential? token) - (let [[token [line column] content] token] - (format "Unexpected %s at line %s, column %s." - (if (= :EOF token) - "EOF" - (get token-names token token)) - line - column)) - (format "Unexpected token: %s." token))] - (-> parser (error error-msg)))) - (defn ensure-parsing "If the parser's state is not :parsing, short-circuits the parser so that the current state is passed through until the end. @@ -458,22 +490,9 @@ [parser token] (-> parser (push-event-when token :octave-change))) -(def repeatable? - #{:clj-expr :note :rest :event-seq :get-variable :cram}) - (defn parse-repeat [{:keys [stack] :as parser} token] - (when (token-is :repeat token) - (if (and (repeatable? (current-event-type parser)) - (not (:open? (current-event parser)))) - (let [repeats (Integer/parseInt (token-content token)) - events-to-repeat (peek stack)] - (-> parser - (update :stack pop) - (push-event {:type :repeat - :position (token-position token) - :content [repeats events-to-repeat]}))) - (-> parser (unexpected-token-error token))))) + (-> parser (push-event-when token :repeat))) (defn parse-voice [parser token] diff --git a/src/alda/parser/tokenize.clj b/src/alda/parser/tokenize.clj index 9ea4d13..78da95a 100644 --- a/src/alda/parser/tokenize.clj +++ b/src/alda/parser/tokenize.clj @@ -219,7 +219,7 @@ (defn start-parsing-clj-string [p c] - (start-parsing p c :clj-string {:start-char \"})) + (start-parsing p c :clj-string {:start-char \" :buffer-first-char true})) (defn start-parsing-comment [p c] @@ -517,11 +517,11 @@ (read-character! character))] (cond (and ((set "abcdefg") char1) - ((conj (set " \n+-_/~*}]<>0123456789") :EOF) character)) + ((conj (set "# \n+-_/~*}]<>0123456789") :EOF) character)) (-> parser (parse :note)) (and (= \r char1) - ((conj (set " \n/~*}]<>0123456789") :EOF) character)) + ((conj (set "# \n/~*}]<>0123456789") :EOF) character)) (-> parser (parse :rest)) ((set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") character) diff --git a/test/alda/examples_test.clj b/test/alda/examples_test.clj index 2574c12..703ca44 100644 --- a/test/alda/examples_test.clj +++ b/test/alda/examples_test.clj @@ -2,6 +2,7 @@ (:require [clojure.test :refer :all] [clojure.java.io :as io] [alda.parser :refer (parse-input)] + [alda.lisp.score :as score] [io.aviso.ansi :refer :all])) (def example-scores @@ -65,57 +66,42 @@ (let [score-text (-> (str score ".alda") io/resource io/file - slurp)] - (let [score-code (atom nil)] - (testing (format "parsing (as code) %s.alda" score) - (println \newline (str score ".alda")) - (printf " Parsing as code... ") - (flush) - (is - (try - (let [[result time-ms] (time+ (parse-input score-text :lisp))] - (println (green "OK") (format "(%s ms)" time-ms)) - (reset! score-code result) - true) - (catch Exception e - (println (red "FAIL")) - (throw e))))) - (testing (format "evaluating score code parsed from %s.alda" score) - (printf " Evaluating score code... ") - (flush) - (is - (try - (let [[result time-ms] (time+ (eval @score-code))] - (println (green "OK") (format "(%s ms)" time-ms)) - true) - (catch Exception e - (println (red "FAIL")) - (throw e)))))) - - (println) - - (let [parsed-score (atom nil)] - (testing (format "parsing (as score) %s.alda" score) - (printf " Parsing as score... ") - (flush) - (is - (try - (let [[result time-ms] (time+ (parse-input score-text :events))] - (println (green "OK") (format "(%s ms)" time-ms)) - (reset! parsed-score result) - true) - (catch Exception e - (println (red "FAIL")) - (throw e))))) - (testing (format "realizing parsed score %s.alda" score) - (printf " Realizing parsed score... ") - (flush) - (is - (try - (let [[result time-ms] - (time+ (apply (resolve 'alda.lisp/score) @parsed-score))] - (println (green "OK") (format "(%s ms)" time-ms)) - true) - (catch Exception e - (println (red "FAIL")) - (throw e)))))))))) + slurp) + events (atom nil)] + (testing (format "[%s.alda] parsing events" score) + (println \newline (str score ".alda")) + (printf " Parsing events... ") + (flush) + (is + (try + (let [[result time-ms] (time+ (doall + (parse-input score-text + :output :events)))] + (println (green "OK") (format "(%s ms)" time-ms)) + (reset! events result) + true) + (catch Exception e + (println (red "FAIL")) + (throw e))))) + (testing (format "[%s.alda] building score from parsed events" score) + (printf " Building score from events... ") + (flush) + (is + (try + (let [[result time-ms] (time+ (apply score/score @events))] + (println (green "OK") (format "(%s ms)" time-ms)) + true) + (catch Exception e + (println (red "FAIL")) + (throw e))))) + (testing (format "[%s.alda] parsing score" score) + (printf " Parsing score directly... ") + (flush) + (is + (try + (let [[result time-ms] (time+ (parse-input score-text))] + (println (green "OK") (format "(%s ms)" time-ms)) + true) + (catch Exception e + (println (red "FAIL")) + (throw e))))))))) diff --git a/test/alda/lisp/notes_test.clj b/test/alda/lisp/notes_test.clj index f639640..9dd6485 100644 --- a/test/alda/lisp/notes_test.clj +++ b/test/alda/lisp/notes_test.clj @@ -1,6 +1,8 @@ (ns alda.lisp.notes-test (:require [clojure.test :refer :all] - [alda.test-helpers :refer (get-instrument dur->ms)] + [alda.test-helpers :refer (get-instrument + dur->ms + calculate-pitch)] [alda.lisp :refer :all])) (deftest note-tests @@ -8,7 +10,7 @@ (let [s (score (part "piano")) piano (get-instrument s "piano") start (:current-offset piano) - c ((pitch :c) (:octave piano) (:key-signature piano)) + c (calculate-pitch :c [] (:octave piano) (:key-signature piano)) s (continue s (note (pitch :c) (duration (note-length 4)) :slur)) piano (get-instrument s "piano") diff --git a/test/alda/lisp/pitch_test.clj b/test/alda/lisp/pitch_test.clj index d9ffef8..7fb6eb1 100644 --- a/test/alda/lisp/pitch_test.clj +++ b/test/alda/lisp/pitch_test.clj @@ -1,30 +1,31 @@ (ns alda.lisp.pitch-test (:require [clojure.test :refer :all] - [alda.test-helpers :refer (get-instrument)] + [alda.test-helpers :refer (get-instrument + calculate-pitch)] [alda.lisp :refer :all])) (deftest pitch-tests (testing "pitch converts a note in a given octave to frequency in Hz" - (is (== 440 ((pitch :a) 4 {}))) - (is (== 880 ((pitch :a) 5 {}))) - (is (< 261 ((pitch :c) 4 {}) 262))) + (is (== 440 (calculate-pitch :a [] 4 {}))) + (is (== 880 (calculate-pitch :a [] 5 {}))) + (is (< 261 (calculate-pitch :c [] 4 {}) 262))) (testing "flats and sharps" - (is (> ((pitch :c :sharp) 4 {}) - ((pitch :c) 4 {}))) - (is (> ((pitch :c) 5 {}) - ((pitch :c :sharp) 4 {}))) - (is (< ((pitch :b :flat) 4 {}) - ((pitch :b) 4 {}))) - (is (== ((pitch :c :sharp) 4 {}) - ((pitch :d :flat) 4 {}))) - (is (== ((pitch :c :sharp :sharp) 4 {}) - ((pitch :d) 4 {}))) - (is (== ((pitch :f :flat) 4 {}) - ((pitch :e) 4 {}))) - (is (== ((pitch :a :flat :flat) 4 {}) - ((pitch :g) 4 {}))) - (is (== ((pitch :c :sharp :flat :flat :sharp) 4 {}) - ((pitch :c) 4 {}))))) + (is (> (calculate-pitch :c [:sharp] 4 {}) + (calculate-pitch :c [] 4 {}))) + (is (> (calculate-pitch :c [] 5 {}) + (calculate-pitch :c [:sharp] 4 {}))) + (is (< (calculate-pitch :b [:flat] 4 {}) + (calculate-pitch :b [] 4 {}))) + (is (== (calculate-pitch :c [:sharp] 4 {}) + (calculate-pitch :d [:flat] 4 {}))) + (is (== (calculate-pitch :c [:sharp :sharp] 4 {}) + (calculate-pitch :d [] 4 {}))) + (is (== (calculate-pitch :f [:flat] 4 {}) + (calculate-pitch :e [] 4 {}))) + (is (== (calculate-pitch :a [:flat :flat] 4 {}) + (calculate-pitch :g [] 4 {}))) + (is (== (calculate-pitch :c [:sharp :flat :flat :sharp] 4 {}) + (calculate-pitch :c [] 4 {}))))) (deftest key-tests (testing "you can set and get a key signature" @@ -53,13 +54,13 @@ (is (= {:f [:sharp]} (:key-signature piano))))) (testing "the pitch of a note is affected by the key signature" - (is (= ((pitch :b) 4 {:b [:flat]}) - ((pitch :b :flat) 4 {}))) - (is (= ((pitch :b :natural) 4 {:b [:flat]}) - ((pitch :b) 4 {}))) + (is (= (calculate-pitch :b [] 4 {:b [:flat]}) + (calculate-pitch :b [:flat] 4 {}))) + (is (= (calculate-pitch :b [:natural] 4 {:b [:flat]}) + (calculate-pitch :b [] 4 {}))) (let [s (score (part "piano" (key-signature "f+"))) piano (get-instrument s "piano") - f-sharp-4 ((pitch :f) 4 (:key-signature piano))] - (is (= f-sharp-4 ((pitch :f :sharp) 4 {})))))) + f-sharp-4 (calculate-pitch :f [] 4 (:key-signature piano))] + (is (= f-sharp-4 (calculate-pitch :f [:sharp] 4 {})))))) diff --git a/test/alda/parser/clj_exprs_test.clj b/test/alda/parser/clj_exprs_test.clj index e072cb8..141c974 100644 --- a/test/alda/parser/clj_exprs_test.clj +++ b/test/alda/parser/clj_exprs_test.clj @@ -5,83 +5,83 @@ (deftest attribute-tests (testing "volume change" - (is (= (parse-input "(volume 50)" :output :events) [(volume 50)]))) + (is (= [(volume 50)] (parse-input "(volume 50)" :output :events)))) (testing "tempo change" - (is (= (parse-input "(tempo 100)" :output :events) [(tempo 100)]))) + (is (= [(tempo 100)] (parse-input "(tempo 100)" :output :events)))) (testing "quantization change" - (is (= (parse-input "(quant 75)" :output :events) [(quant 75)]))) + (is (= [(quant 75)] (parse-input "(quant 75)" :output :events)))) (testing "panning change" - (is (= (parse-input "(panning 0)" :output :events) [(panning 0)])))) + (is (= [(panning 0)] (parse-input "(panning 0)" :output :events))))) (deftest multiple-attribute-change-tests (testing "attribute changes" - (is (= (parse-input "(list (vol 50) (tempo 100))" :output :events) - [(list (vol 50) (tempo 100))])) - (is (= (parse-input "(list (quant! 50) (tempo 90))" :output :events) - [(list (quant! 50) (tempo 90))]))) + (is (= [(list (vol 50) (tempo 100))] + (parse-input "(list (vol 50) (tempo 100))" :output :events))) + (is (= [(list (quant! 50) (tempo 90))] + (parse-input "(list (quant! 50) (tempo 90))" :output :events)))) (testing "global attribute changes" - (is (= (parse-input "(tempo! 126)" :output :events) - [(tempo! 126)])) - (is (= (parse-input "(list (tempo! 130) (quant! 80))" :output :events) - [(list (tempo! 130) (quant! 80))])))) + (is (= [(tempo! 126)] + (parse-input "(tempo! 126)" :output :events))) + (is (= [(list (tempo! 130) (quant! 80))] + (parse-input "(list (tempo! 130) (quant! 80))" :output :events))))) (deftest comma-and-semicolon-tests (testing "commas/semicolons can exist in strings" - (is (= (parse-input "(println \"hi; hi, hi\")" :output :events) - [(println "hi; hi, hi")]))) + (is (= [:nil] + (parse-input "(println \"hi; hi, hi\")" :output :events)))) (testing "commas inside [brackets] and {braces} won't break things" - (is (= (parse-input "(prn [1,2,3])" :output :events) - [(prn [1 2 3])])) - (is (= (parse-input "(prn {:a 1, :b 2})" :output :events) - [(prn {:a 1 :b 2})]))) + (is (= [:nil] + (parse-input "(prn [1,2,3])" :output :events))) + (is (= [:nil] + (parse-input "(prn {:a 1, :b 2})" :output :events)))) (testing "comma/semicolon character literals are OK too" - (is (= (parse-input "(println \\, \\;)" :output :events) - [(println \, \;)])))) + (is (= [:nil] + (parse-input "(println \\, \\;)" :output :events))))) (deftest paren-tests (testing "parens inside of a string are NOT a clj-expr" - (is (= (parse-input "(prn \"a string (with parens)\")" :output :events) - [(prn "a string (with parens)")])) - (is (= (parse-input "(prn \"a string with just a closing paren)\")" :output :events) - [(prn "a string with just a closing paren)")]))) + (is (= [:nil] + (parse-input "(prn \"a string (with parens)\")" :output :events))) + (is (= [:nil] + (parse-input "(prn \"a string with just a closing paren)\")" :output :events)))) (testing "paren character literals don't break things" - (is (= (parse-input "(prn \\()" :output :events) - [(prn \()])) - (is (= (parse-input "(prn \\))" :output :events) - [(prn \))])) - (is (= (parse-input "(prn \\( (+ 1 1) \\))" :output :events) - [(prn \( (+ 1 1) \))])))) + (is (= [:nil] + (parse-input "(prn \\()" :output :events))) + (is (= [:nil] + (parse-input "(prn \\))" :output :events))) + (is (= [:nil] + (parse-input "(prn \\( (+ 1 1) \\))" :output :events))))) (deftest vector-tests (testing "vectors are a thing" - (is (= (parse-input "(prn [1 2 3 \\a :b \"c\"])" :output :events) - [(prn [1 2 3 \a :b "c"])]))) + (is (= [:nil] + (parse-input "(prn [1 2 3 \\a :b \"c\"])" :output :events)))) (testing "vectors can have commas in them" - (is (= (parse-input "(prn [1, 2, 3])" :output :events) - [(prn [1 2 3])])))) + (is (= [:nil] + (parse-input "(prn [1, 2, 3])" :output :events))))) (deftest map-tests (testing "maps are a thing" - (is (= (parse-input "(prn {:a 1 :b 2 :c 3})" :output :events) - [(prn {:a 1 :b 2 :c 3})]))) + (is (= [:nil] + (parse-input "(prn {:a 1 :b 2 :c 3})" :output :events)))) (testing "maps can have commas in them" - (is (= (parse-input "(prn {:a 1, :b 2, :c 3})" :output :events) - [(prn {:a 1 :b 2 :c 3})])))) + (is (= [:nil] + (parse-input "(prn {:a 1, :b 2, :c 3})" :output :events))))) (deftest set-tests (testing "sets are a thing" - (is (= (parse-input "(prn #{1 2 3})" :output :events) - [(prn #{1 2 3})]))) + (is (= [:nil] + (parse-input "(prn #{1 2 3})" :output :events)))) (testing "sets can have commas in them" - (is (= (parse-input "(prn #{1, 2, 3})" :output :events) - [(prn #{1 2 3})])))) + (is (= [:nil] + (parse-input "(prn #{1, 2, 3})" :output :events))))) (deftest nesting-things (testing "things can be nested and it won't break shit" - (is (= (parse-input "(prn [1 2 [3 4] 5])" :output :events) - [(prn [1 2 [3 4] 5])])) - (is (= (parse-input "(prn #{1 2 #{3 4} 5})" :output :events) - [(prn #{1 2 #{3 4} 5})])) - (is (= (parse-input "(prn (+ 1 [2 {3 #{4 5}}]))" :output :events) - [(prn (+ 1 [2 {3 #{4 5}}]))])))) + (is (= [:nil] + (parse-input "(prn [1 2 [3 4] 5])" :output :events))) + (is (= [:nil] + (parse-input "(prn #{1 2 #{3 4} 5})" :output :events))) + (is (= [:nil] + (parse-input "(prn (list 1 [2 {3 #{4 5}}]))" :output :events))))) diff --git a/test/alda/parser/comments_test.clj b/test/alda/parser/comments_test.clj index 9814648..cb1ae4a 100644 --- a/test/alda/parser/comments_test.clj +++ b/test/alda/parser/comments_test.clj @@ -3,19 +3,21 @@ [alda.parser :refer (parse-input)])) (def expected - '(alda.lisp/score - (alda.lisp/part {:names ["piano"]} - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :e))))) + [(alda.lisp/part {:names ["piano"]}) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :e))]) (deftest short-comment-tests (testing "a short comment" (is (= expected (parse-input "piano: c # d - e"))) + e" + :output :events))) (testing "at the end of a line" (is (= expected (parse-input "piano: c # d - e"))) + e" + :output :events))) (testing "without a leading space" - (is (= expected (parse-input "piano: c#d\ne"))))))) + (is (= expected (parse-input "piano: c#d\ne" + :output :events))))))) diff --git a/test/alda/parser/event_sequences_test.clj b/test/alda/parser/event_sequences_test.clj index a0e8a02..3c2d438 100644 --- a/test/alda/parser/event_sequences_test.clj +++ b/test/alda/parser/event_sequences_test.clj @@ -4,32 +4,30 @@ (deftest event-sequence-tests (testing "event sequences" - (is (= (parse-input "[]" :output :events) [[]])) - (is (= (parse-input "[ ]" :output :events) [[]])) - (is (= (parse-input "[ c d e f c/e/g ]" :output :events) - [[(alda.lisp/note (alda.lisp/pitch :c)) + (is (= [[]] (parse-input "[]" :output :events))) + (is (= [[]] (parse-input "[ ]" :output :events))) + (is (= [[(alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :d)) (alda.lisp/note (alda.lisp/pitch :e)) (alda.lisp/note (alda.lisp/pitch :f)) (alda.lisp/chord (alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :g)))]])) - (is (= (parse-input "[c d [e f] g]" :output :events) - [[(alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :g)))]] + (parse-input "[ c d e f c/e/g ]" :output :events))) + (is (= [[(alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :d)) [(alda.lisp/note (alda.lisp/pitch :e)) (alda.lisp/note (alda.lisp/pitch :f))] - (alda.lisp/note (alda.lisp/pitch :g))]]))) + (alda.lisp/note (alda.lisp/pitch :g))]] + (parse-input "[c d [e f] g]" :output :events)))) (testing "voices within event sequences parse successfully" - (is (= (parse-input "[V1: e b d V2: a c f]" :output :events) - [[(alda.lisp/voice - 1 - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :b)) - (alda.lisp/note (alda.lisp/pitch :d))) - (alda.lisp/voice - 2 - (alda.lisp/note (alda.lisp/pitch :a)) - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :f)))]])))) + (is (= [[(alda.lisp/voice 1) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :b)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/voice 2) + (alda.lisp/note (alda.lisp/pitch :a)) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :f))]] + (parse-input "[V1: e b d V2: a c f]" :output :events))))) diff --git a/test/alda/parser/repeats_test.clj b/test/alda/parser/repeats_test.clj index 75cd504..1819339 100644 --- a/test/alda/parser/repeats_test.clj +++ b/test/alda/parser/repeats_test.clj @@ -4,32 +4,32 @@ (deftest repeat-tests (testing "repeated events" - (is (= (parse-input "[c d e] *4" :output :events) - [(alda.lisp/times 4 + (is (= [(alda.lisp/times 4 [(alda.lisp/note (alda.lisp/pitch :c)) (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e))])])) - (is (= (parse-input "[ c > ]*5" :output :events) - [(alda.lisp/times 5 + (alda.lisp/note (alda.lisp/pitch :e))])] + (parse-input "[c d e] *4" :output :events))) + (is (= [(alda.lisp/times 5 [(alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/octave :up)])])) - (is (= (parse-input "[ c > ] * 5" :output :events) - [(alda.lisp/times 5 + (alda.lisp/octave :up)])] + (parse-input "[ c > ]*5" :output :events))) + (is (= [(alda.lisp/times 5 [(alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/octave :up)])])) - (is (= (parse-input "c8*7" :output :events) - [(alda.lisp/times 7 + (alda.lisp/octave :up)])] + (parse-input "[ c > ] * 5" :output :events))) + (is (= [(alda.lisp/times 7 (alda.lisp/note (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 8))))])) - (is (= (parse-input "c8 *7" :output :events) - [(alda.lisp/times 7 + (alda.lisp/duration (alda.lisp/note-length 8))))] + (parse-input "c8*7" :output :events))) + (is (= [(alda.lisp/times 7 (alda.lisp/note (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 8))))])) - (is (= (parse-input "c8 * 7" :output :events) - [(alda.lisp/times 7 + (alda.lisp/duration (alda.lisp/note-length 8))))] + (parse-input "c8 *7" :output :events))) + (is (= [(alda.lisp/times 7 (alda.lisp/note (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 8))))])))) + (alda.lisp/duration (alda.lisp/note-length 8))))] + (parse-input "c8 * 7" :output :events))))) diff --git a/test/alda/parser/score_test.clj b/test/alda/parser/score_test.clj index c7eb94f..622f2ea 100644 --- a/test/alda/parser/score_test.clj +++ b/test/alda/parser/score_test.clj @@ -3,22 +3,22 @@ [alda.parser :refer (parse-input)])) (deftest score-tests - (is (= (parse-input "theremin: c d e") - '(alda.lisp/score - (alda.lisp/part {:names ["theremin"]} - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e)))))) - (is (= (parse-input "trumpet/trombone/tuba \"brass\": f+1") - '(alda.lisp/score - (alda.lisp/part {:names ["trumpet" "trombone" "tuba"] - :nickname "brass"} - (alda.lisp/note (alda.lisp/pitch :f :sharp) - (alda.lisp/duration (alda.lisp/note-length 1))))))) - (is (= (parse-input "guitar: e - bass: e") - '(alda.lisp/score - (alda.lisp/part {:names ["guitar"]} - (alda.lisp/note (alda.lisp/pitch :e))) - (alda.lisp/part {:names ["bass"]} - (alda.lisp/note (alda.lisp/pitch :e))))))) + (is (= [(alda.lisp/part {:names ["theremin"]}) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e))] + (parse-input "theremin: c d e" :output :events))) + (is (= [(alda.lisp/part {:names ["trumpet" "trombone" "tuba"] + :nickname "brass"}) + (alda.lisp/note + (alda.lisp/pitch :f :sharp) + (alda.lisp/duration (alda.lisp/note-length 1)))] + (parse-input "trumpet/trombone/tuba \"brass\": f+1" + :output :events))) + (is (= [(alda.lisp/part {:names ["guitar"]}) + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/part {:names ["bass"]}) + (alda.lisp/note (alda.lisp/pitch :e))] + (parse-input "guitar: e + bass: e" + :output :events)))) diff --git a/test/alda/parser/variables_test.clj b/test/alda/parser/variables_test.clj index c501582..e521eea 100644 --- a/test/alda/parser/variables_test.clj +++ b/test/alda/parser/variables_test.clj @@ -11,15 +11,21 @@ (parse-input "aaa" :output :events))) (is (= [(alda.lisp/get-variable :HI)] (parse-input "HI" :output :events))) - (is (thrown? Exception (parse-input "x" :output :events))) - (is (thrown? Exception (parse-input "y2" :output :events))) - (is (thrown? Exception (parse-input "1234kittens" :output :events))) - (is (thrown? Exception (parse-input "r2d2" :output :events))) - (is (thrown? Exception (parse-input "i_like_underscores" :output :events)))) + (is (thrown? Exception (parse-input "x" + :output :events-or-error))) + (is (thrown? Exception (parse-input "y2" + :output :events-or-error))) + (is (thrown? Exception (parse-input "1234kittens" + :output :events-or-error))) + (is (thrown? Exception (parse-input "i_like_underscores" + :output :events-or-error)))) (testing "can't contain pluses or minuses" - (is (thrown? Exception (parse-input "jar-jar-binks" :output :events))) - (is (thrown? Exception (parse-input "han+leia" :output :events))) - (is (thrown? Exception (parse-input "ionlyprograminc++" :output :events)))) + (is (thrown? Exception (parse-input "jar-jar-binks" + :output :events-or-error))) + (is (thrown? Exception (parse-input "han+leia" + :output :events-or-error))) + (is (thrown? Exception (parse-input "ionlyprograminc++" + :output :events-or-error)))) (testing "can contain digits" (is (= [(alda.lisp/get-variable :celloPart2)] (parse-input "celloPart2" :output :events))) @@ -35,46 +41,41 @@ (deftest variable-get-tests (testing "variable getting" - (is (= [(alda.lisp/score - (alda.lisp/part {:names ["flute"]} - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/get-variable :flan) - (alda.lisp/note (alda.lisp/pitch :f))))] + (is (= [(alda.lisp/part {:names ["flute"]}) + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/get-variable :flan) + (alda.lisp/note (alda.lisp/pitch :f))] (parse-input "flute: c flan f" :output :events))) - (is (= [(alda.lisp/score - (alda.lisp/part {:names ["clarinet"]} - (alda.lisp/get-variable :pudding123)))] + (is (= [(alda.lisp/part {:names ["clarinet"]}) + (alda.lisp/get-variable :pudding123)] (parse-input "clarinet: pudding123" :output :events))))) (deftest variable-set-tests (testing "variable setting" (testing "within an instrument part" - (is (= [alda.lisp/score - (alda.lisp/part {:names ["harpsichord"]} - (alda.lisp/set-variable :custard_ - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/chord - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :g)))))] + (is (= [(alda.lisp/part {:names ["harpsichord"]}) + (alda.lisp/set-variable :custard_ + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/chord + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :g))))] (parse-input "harpsichord:\n\ncustard_ = c d e/g" :output :events))) - (is (= [(alda.lisp/score - (alda.lisp/part {:names ["glockenspiel"]} - (alda.lisp/set-variable :sorbet - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/chord - (alda.lisp/note (alda.lisp/pitch :e)) - (alda.lisp/note (alda.lisp/pitch :g)))) - (alda.lisp/note (alda.lisp/pitch :c))))] + (is (= [(alda.lisp/part {:names ["glockenspiel"]}) + (alda.lisp/set-variable :sorbet + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/chord + (alda.lisp/note (alda.lisp/pitch :e)) + (alda.lisp/note (alda.lisp/pitch :g)))) + (alda.lisp/note (alda.lisp/pitch :c))] (parse-input "glockenspiel:\n\nsorbet=c d e/g\nc" :output :events)))) (testing "at the top of a score" - (is (= [(alda.lisp/score - (alda.lisp/set-variable :GELATO - (alda.lisp/note (alda.lisp/pitch :d)) - (alda.lisp/note (alda.lisp/pitch :e))) - (alda.lisp/part {:names ["clavinet"]} - (alda.lisp/chord - (alda.lisp/note (alda.lisp/pitch :c)) - (alda.lisp/note (alda.lisp/pitch :f)))))] + (is (= [(alda.lisp/set-variable :GELATO + (alda.lisp/note (alda.lisp/pitch :d)) + (alda.lisp/note (alda.lisp/pitch :e))) + (alda.lisp/part {:names ["clavinet"]}) + (alda.lisp/chord + (alda.lisp/note (alda.lisp/pitch :c)) + (alda.lisp/note (alda.lisp/pitch :f)))] (parse-input "GELATO=d e\n\nclavinet: c/f" :output :events)))))) diff --git a/test/alda/test_helpers.clj b/test/alda/test_helpers.clj index 2bf6e1c..2a7e989 100644 --- a/test/alda/test_helpers.clj +++ b/test/alda/test_helpers.clj @@ -1,6 +1,7 @@ (ns alda.test-helpers (:require [clojure.string :as str] - [alda.lisp.model.duration :refer (calculate-duration)])) + [alda.lisp.model.duration :refer (calculate-duration)] + [alda.lisp.model.pitch :refer (midi->hz determine-midi-note)])) (defn get-instrument "Returns the first instrument in :instruments whose id starts with inst-name." @@ -20,3 +21,11 @@ (dur->ms (duration (note-length 8)) 120) => 250" [{:keys [beats ms]} tempo & [time-scaling]] (calculate-duration beats tempo (or time-scaling 1) ms)) + +(defn calculate-pitch + [letter accidentals octave key-sig] + (let [midi-note (determine-midi-note {:letter letter + :accidentals accidentals} + octave + key-sig)] + (midi->hz midi-note))) From e40959097315389038e8de4f2a252601c01b71c6 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Mon, 8 May 2017 09:12:00 -0400 Subject: [PATCH 17/22] require alda.lisp earlier in the pipeline --- src/alda/parser.clj | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/alda/parser.clj b/src/alda/parser.clj index 7b0fe8b..a5c27d4 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -55,6 +55,10 @@ If there is an error, the error is included in the stream." [tokens-ch] + ;; alda.lisp must be required and referred in order to use inline Clojure + ;; expressions. + (when-not (resolve 'ALDA-LISP-LOADED) + (require '[alda.lisp :refer :all])) (let [events-ch (chan)] (thread (loop [parser (event/parser events-ch)] @@ -72,6 +76,10 @@ If there is an error, the error is included in the stream." [events-ch] + ;; alda.lisp must be required and referred in order to use inline Clojure + ;; expressions. + (when-not (resolve 'ALDA-LISP-LOADED) + (require '[alda.lisp :refer :all])) (let [events-ch2 (chan)] (thread (loop [parser (agg/parser events-ch2)] @@ -89,6 +97,10 @@ If there was an error in the a previous part of the pipeline, it is thrown here." [events-ch2] + ;; alda.lisp must be required and referred in order to use inline Clojure + ;; expressions. + (when-not (resolve 'ALDA-LISP-LOADED) + (require '[alda.lisp :refer :all])) (go-loop [score (score/score)] (let [event ( input tokenize parse-events aggregate-events build-score Date: Mon, 8 May 2017 09:14:18 -0400 Subject: [PATCH 18/22] consistency: always pass errors through as exception objects --- src/alda/parser/parse_events.clj | 37 ++++++++++++++++---------------- src/alda/parser/tokenize.clj | 36 ++++++++++++++++++------------- 2 files changed, 39 insertions(+), 34 deletions(-) diff --git a/src/alda/parser/parse_events.clj b/src/alda/parser/parse_events.clj index 50bb665..cc5efa9 100644 --- a/src/alda/parser/parse_events.clj +++ b/src/alda/parser/parse_events.clj @@ -72,13 +72,6 @@ [{:keys [type] :as event}] (throw (Exception. (format "Unrecognized event: %s" type)))) -(defmethod alda-event :error - [{:keys [content]}] - ;; Emit the error itself on the stream so it can be thrown at the end. - (if (instance? Throwable content) - content - (Exception. content))) - (defmethod alda-event :at-marker [{:keys [content]}] (event/at-marker content)) @@ -222,11 +215,22 @@ (with-meta event metadata) event))) -(defn emit-event! - [{:keys [events-ch] :as parser} event] - (>!! events-ch (alda-event-with-metadata event)) +(defn emit! + [{:keys [events-ch] :as parser} x] + (>!! events-ch x) parser) +(defn emit-event! + [parser event] + (-> parser (emit! (alda-event-with-metadata event)))) + +(defn emit-error! + [parser e-or-msg] + (let [error (if (instance? Throwable e-or-msg) + e-or-msg + (Exception. e-or-msg))] + (-> parser (emit! error) (assoc :state :error)))) + (defn pop-and-emit-event! [{:keys [stack] :as parser}] (if-let [event (peek stack)] @@ -262,11 +266,6 @@ (def repeatable? #{:clj-expr :note :rest :event-seq :get-variable :cram}) -(defn error - [parser error-content] - (-> parser (emit-event! {:type :error :content error-content}) - (assoc :state :error))) - (defn unexpected-token-error [parser token] (let [error-msg (if (sequential? token) @@ -278,7 +277,7 @@ line column)) (format "Unexpected token: %s." token))] - (-> parser (error error-msg)))) + (-> parser (emit-error! error-msg)))) (declare push-set-variable) @@ -405,8 +404,8 @@ "If there was an error in a previous stage of the parsing pipeline, propagate it through and stop parsing." [parser token] - (when (token-is :error token) - (-> parser (error (token-content token))))) + (when (instance? Throwable token) + (-> parser (emit-error! token)))) (defn finish-parsing [{:keys [stack] :as parser} token] @@ -658,4 +657,4 @@ (finish-parsing p t) (unexpected-token-error p t)) (catch Throwable e - (error p e)))) + (emit-error! p e)))) diff --git a/src/alda/parser/tokenize.clj b/src/alda/parser/tokenize.clj index 78da95a..f417234 100644 --- a/src/alda/parser/tokenize.clj +++ b/src/alda/parser/tokenize.clj @@ -60,14 +60,26 @@ [parser] (-> parser (update :stack #(if (empty? %) % (pop %))))) +(defn emit! + [{:keys [tokens-ch] :as parser} x] + (>!! tokens-ch x) + parser) + (defn emit-token! - [{:keys [tokens-ch] :as parser} & {:keys [token content pop-stack?]}] - (>!! tokens-ch [(or token (current-token-type parser)) - (starting-line-and-column parser) - (or content (current-token-content parser))]) - (if pop-stack? - (-> parser pop-stack) - parser)) + [parser & {:keys [token content pop-stack?]}] + (let [maybe-pop-stack #(if pop-stack? (pop-stack %) %)] + (-> parser + (emit! [(or token (current-token-type parser)) + (starting-line-and-column parser) + (or content (current-token-content parser))]) + maybe-pop-stack))) + +(defn emit-error! + [parser e-or-msg] + (let [error (if (instance? Throwable e-or-msg) + e-or-msg + (Exception. e-or-msg))] + (-> parser (emit! error) (assoc :state :error)))) (defn unexpected-char-error [{:keys [line column] :as parser} character] @@ -81,13 +93,7 @@ "") line column)] - (-> parser (emit-token! :token :error :content error-msg) - (assoc :state :error)))) - -(defn caught-error - [parser e] - (-> parser (emit-token! :token :error :content e) - (assoc :state :error))) + (-> parser (emit-error! error-msg)))) (defn reject-chars [parser character blacklist] @@ -692,4 +698,4 @@ (skip-whitespace p c) (unexpected-char-error p c)) (catch Throwable e - (caught-error p e)))) + (emit-error! p e)))) From 1da749fba18347360d552301a3b20d834e984902 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Tue, 9 May 2017 09:24:13 -0400 Subject: [PATCH 19/22] upgrade dependencies --- build.boot | 37 +++++-------------------------------- 1 file changed, 5 insertions(+), 32 deletions(-) diff --git a/build.boot b/build.boot index a1a0d60..ab1062d 100755 --- a/build.boot +++ b/build.boot @@ -4,16 +4,16 @@ :dependencies '[ ; dev [adzerk/bootlaces "0.1.13" :scope "test"] - [adzerk/boot-test "1.1.2" :scope "test"] - [alda/sound-engine-clj "0.1.0" :scope "test"] + [adzerk/boot-test "1.2.0" :scope "test"] + [alda/sound-engine-clj "0.1.2" :scope "test"] [org.clojure/tools.namespace "0.3.0-alpha3" :scope "test"] ; used in examples_test.clj [io.aviso/pretty "0.1.33" :scope "test"] ; alda.core [org.clojure/clojure "1.8.0"] - [org.clojure/core.async "0.2.395"] - [com.taoensso/timbre "4.7.4"] + [org.clojure/core.async "0.3.442"] + [com.taoensso/timbre "4.10.0"] [djy "0.1.4"] [potemkin "0.4.3"] [clj_manifest "0.2.0"]]) @@ -40,34 +40,7 @@ target {:dir #{"target"}} - test {:namespaces '#{; general tests - alda.parser.barlines-test - alda.parser.clj-exprs-test - alda.parser.event-sequences-test - alda.parser.comments-test - alda.parser.duration-test - alda.parser.events-test - alda.parser.octaves-test - alda.parser.repeats-test - alda.parser.score-test - alda.parser.variables-test - alda.lisp.attributes-test - alda.lisp.cram-test - alda.lisp.chords-test - alda.lisp.code-test - alda.lisp.duration-test - alda.lisp.global-attributes-test - alda.lisp.markers-test - alda.lisp.notes-test - alda.lisp.parts-test - alda.lisp.pitch-test - alda.lisp.score-test - alda.lisp.variables-test - alda.lisp.voices-test - alda.util-test - - ; benchmarks / smoke tests - alda.examples-test}}) + test {:include #"-test$"}) (deftask package "Builds jar file." From 853c94e0d80ba4484d509af96b86ca5189e9fdfa Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Wed, 10 May 2017 07:48:42 -0400 Subject: [PATCH 20/22] documentation updates --- README.md | 17 +-- doc/development-guide.md | 253 ++++++++++++++++++++++++++++++--------- 2 files changed, 207 insertions(+), 63 deletions(-) diff --git a/README.md b/README.md index f5a6f03..e6c5834 100644 --- a/README.md +++ b/README.md @@ -4,9 +4,9 @@ The core machinery of [Alda](https://github.com/alda-lang/alda), implemented in ## Components -* **alda.parser** (reads Alda code and transforms it into Clojure code in the context of the `alda.lisp` namespace) +* **alda.lisp**: a Clojure DSL for building a musical score -* **alda.lisp** (a Clojure DSL which provides the context for evaluating an Alda score, in its Clojure code form) +* **alda.parser**: reads Alda code, interprets it as music events, and builds a score using `alda.lisp` For more details about how each component works, see the alda-core [development guide](doc/development-guide.md). @@ -20,11 +20,12 @@ Development on the Alda core library requires that you have the [Boot](http://bo To run the unit test suite, run `boot test`. -#### Adding tests +When developing, you can run `boot watch test` in a separate terminal and the +tests will re-run every time you make a change to a file. -It is generally good to add to the existing tests wherever it makes sense, i.e. whenever there is a new test case that Alda needs to consider. [Test-driven development](https://en.wikipedia.org/wiki/Test-driven_development) is a good idea. +#### Adding tests -If you find yourself adding a new file to the tests, be sure to add its namespace to the list of test namespaces in `build.boot` so that it will be included when you run the tests. +It is generally good to add new test cases when fixing bugs and adding features. [Test-driven development](https://en.wikipedia.org/wiki/Test-driven_development) is a good workflow when developing alda-core. The automated test battery includes smoke tests where we parse and evaluate all of the example Alda scores in the `examples/` directory. If you add an additional example score, be sure to add it to the list of score files in `test/alda/examples_test.clj`. @@ -38,12 +39,12 @@ To override this setting (e.g. for development and debugging), you can set the ` To see debug logs, for example, you can do this: - export TIMBRE_LEVEL=debug + export TIMBRE_LEVEL=:debug -When running tests via `boot test` and troubleshooting a failing test, it may be helpful to use debug-level logging by running `TIMBRE_LEVEL=debug boot test`. +When running tests via `boot test` and troubleshooting a failing test, it may be helpful to use debug-level logging by running `TIMBRE_LEVEL=:debug boot test`. ## License -Copyright © 2016 Dave Yarwood et al +Copyright © 2017 Dave Yarwood et al Distributed under the Eclipse Public License version 1.0. diff --git a/doc/development-guide.md b/doc/development-guide.md index 53f7eb3..70d823b 100644 --- a/doc/development-guide.md +++ b/doc/development-guide.md @@ -2,66 +2,33 @@ ## Components -* [alda.parser](#aldaparser) * [alda.lisp](#aldalisp) +* [alda.parser](#aldaparser) -### alda.parser - -Parsing begins with the `parse-input` function in the [`alda.parser`](https://github.com/alda-lang/alda/blob/master/server/src/alda/parser.clj) namespace. This function uses a series of parsers built using [Instaparse](https://github.com/Engelberg/instaparse), an excellent parser-generator library for Clojure. -The grammars for each step of the parsing process are composed from [small files written in BNF](https://github.com/alda-lang/alda/blob/master/server/grammar) (with some Instaparse-specific sugar); if you find yourself editing any of these files, it may be helpful to read up on Instaparse. [The tutorial in the Instaparse README](https://github.com/Engelberg/instaparse) is comprehensive and excellent. - -The parsers transform Alda code into an intermediate AST, which looks something like this: - -```clojure -[:score - [:part - [:calls [:name "piano"]] - [:note - [:pitch "c"] - [:duration - [:note-length [:positive-number "8"]]]] - [:note - [:pitch "e"]] - [:note - [:pitch "g"]] - [:chord - [:note - [:pitch "c"] - [:duration [:note-length [:positive-number "1"]]]] - [:note - [:pitch "f"]] - [:note - [:pitch "a"]]]]] -``` - -These parse trees are then [transformed](https://github.com/Engelberg/instaparse#transforming-the-tree) into Clojure code which, when run, will produce a data representation of a musical score. +### alda.lisp -Clojure is a Lisp; in Lisp, code is data and data is code. This powerful concept allows us to represent a morsel of code as a list of elements. The first element in the list is a function, and every subsequent element is an argument to that function. These code morsels can even be nested, just like our parse tree. Alda's parser's transformation phase translates each type of node in the parse tree into a Clojure expression that can be evaluated with the help of the `alda.lisp` namespace. +Alda is implemented as a [domain-specific language (DSL)](https://en.wikipedia.org/wiki/Domain-specific_language) that can be used to construct a musical score: ```clojure -alda.parser=> (parse-input "piano: c8 e g c1/f/a") - -(alda.lisp/score - (alda.lisp/part {:names ["piano"]} - (alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 8))) - (alda.lisp/note - (alda.lisp/pitch :e)) - (alda.lisp/note - (alda.lisp/pitch :g)) - (alda.lisp/chord - (alda.lisp/note - (alda.lisp/pitch :c) - (alda.lisp/duration (alda.lisp/note-length 1))) - (alda.lisp/note - (alda.lisp/pitch :f)) - (alda.lisp/note - (alda.lisp/pitch :a))))) +(score + (part {:names ["piano"]} + (note + (pitch :c) + (duration (note-length 8))) + (note + (pitch :e)) + (note + (pitch :g)) + (chord + (note + (pitch :c) + (duration (note-length 1))) + (note + (pitch :f)) + (note + (pitch :a))))) ``` -### alda.lisp - When you evaluate a score [S-expression](https://en.wikipedia.org/wiki/S-expression) like the one above, the result is a map of score information, which provides all of the data that Alda's audio component needs in order to play your score. ```clojure @@ -156,9 +123,9 @@ There are a lot of different values in this map, most of which the sound engine A note event contains information such as the pitch, MIDI note and duration of a note, which instrument instance is playing the note, and what its offset is relative to the beginning of the score (i.e., where the note is in the score) -The sound engine decides how to play a note by looking at its instrument ID (which is defined on each event map) and looking it up in the overall map of instruments. Each instrument has a `:config`, which tells the sound engine things like whether or not it's a MIDI instrument, and if it is a MIDI instrument, which General MIDI patch to use. +The sound engine decides how to play a note by looking up its instrument ID (which is defined on each event map) in the `:instruments` map. Each instrument has a `:config`, which tells the sound engine things like whether or not it's a MIDI instrument, and if it is a MIDI instrument, which General MIDI patch to use. -The remaining keys in the map are used by the score evaluation process to keep track of the state of the score. This includes information like which instruments' parts the composer is currently writing, how far into the score each instrument is, and the current values of attributes like volume, octave, and panning for each instrument used in the score. +The remaining keys in the map are used by the score evaluation process to keep track of the state of the score. This includes information like which instruments' parts the composer is currently writing, how far into the score each instrument is (i.e. when that instrument's next note should come in), and the current values of attributes like volume, octave, and panning for each instrument used in the score. Because `alda.lisp` is a Clojure DSL, it's possible to use it to build scores within a Clojure program, as an alternative to using Alda syntax: @@ -179,3 +146,179 @@ Because `alda.lisp` is a Clojure DSL, it's possible to use it to build scores wi (note (pitch :c)))) ``` +Alda's parser also uses the `alda.lisp` implementation to construct scores from +Alda code. + +### alda.parser + +#### The parsing pipeline + +Alda parses a score in several stages: + +- [Tokenize](https://github.com/alda-lang/alda/blob/master/src/alda/parser/tokenize.clj) the input. +- [Parse events](https://github.com/alda-lang/alda/blob/master/src/alda/parser/parse_events.clj) from the sequence of tokens. +- [Aggregate events](https://github.com/alda-lang/alda/blob/master/src/alda/parser/aggregate_events.clj) from the sequence of tokens. +- [Build a score](https://github.com/alda-lang/alda-core/blob/master/src/alda/lisp/score.clj) by starting from a new (empty) score and applying the events in order. + +For optimal performance, the Alda parser performs the steps of this pipeline +asynchronously. As soon as the first token is parsed from the input string, it +goes on a [core.async](http://www.braveclojure.com/core-async) channel and the +tokenizing continues while the next stage of the parser begins to consume the +tokens from the channel and parse events from them. This means that we can start +to build a score almost instantly, without having to wait for the rest of the +parsing pipeline to finish. + +There are two convenience functions in the `alda.parser` namespace for working +with the streams of tokens/events resulting from each step of the pipeline: + +- `print-stream` prints items asynchronously as they are received. +- `stream-seq` produces a [lazy sequence](https://clojure.org/reference/sequences) of items received from the stream. + +Using `print-stream` in a Clojure REPL, we can get an idea of what results from +each stage of the parsing pipeline: + +```clojure +;; Wherever you see #object[...ManyToManyChannel...] below, that is the return +;; value of each stage of the pipeline: a channel from which events can be received +;; at the next stage of the pipeline. This is what allows us to thread each stage +;; into the next via the threading (->) operator. +;; +;; Note that because the printing (via print-stream) is happening asynchronously, +;; the REPL often prints the return value before all of the events are done being +;; printed. + +;; STAGE 1: input => tokens +alda.parser=> (-> "piano: c8 e g > c4/e" tokenize print-stream) +[:name [1 1] "piano"] +[:colon [1 6] ":"] +[:note [1 8] "c"] +[:note-length [1 9] "8"] +[:note [1 11] "e"] +[:note [1 13] "g"] +[:octave-change [1 15] ">"] +[:note [1 17] "c"] +[:note-length [1 18] "4"] +[:slash [1 19] "/"] +[:note [1 20] "e"] +[:EOF [1 21]] +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x6e85ec7b "clojure.core.async.impl.channels.ManyToManyChannel@6e85ec7b"] + +;; STAGE 2: tokens => individual events +alda.parser=> (-> "piano: c8 e g > c4/e" tokenize parse-events print-stream) +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x51a59f63 "clojure.core.async.impl.channels.ManyToManyChannel@51a59f63"] +{:event-type :part, :instrument-call {:names ["piano"]}, :events nil} +{:event-type :note, :letter :c, :accidentals [], :beats 0.5, :ms 0, :slur? nil} +{:event-type :note, :letter :e, :accidentals [], :beats nil, :ms nil, :slur? nil} +{:event-type :note, :letter :g, :accidentals [], :beats nil, :ms nil, :slur? nil} +{:event-type :attribute-change, :attr :octave, :val :up} +{:event-type :note, :letter :c, :accidentals [], :beats 1.0, :ms 0, :slur? nil} +{:event-type :note, :letter :e, :accidentals [], :beats nil, :ms nil, :slur? nil, :chord? true} +:EOF + +;; STAGE 3: individual events => aggregated events +;; (e.g. notes => chords) +alda.parser=> (-> "piano: c8 e g > c4/e" tokenize parse-events aggregate-events print-stream) +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x5bd8f56f "clojure.core.async.impl.channels.ManyToManyChannel@5bd8f56f"] +{:event-type :part, :instrument-call {:names ["piano"]}, :events nil} +{:event-type :note, :letter :c, :accidentals [], :beats 0.5, :ms 0, :slur? nil} +{:event-type :note, :letter :e, :accidentals [], :beats nil, :ms nil, :slur? nil} +{:event-type :note, :letter :g, :accidentals [], :beats nil, :ms nil, :slur? nil} +{:event-type :attribute-change, :attr :octave, :val :up} +{:event-type :chord, :events ({:event-type :note, :letter :c, :accidentals [], :beats 1.0, :ms 0, :slur? nil} {:event-type :note, :letter :e, :accidentals [], :beats nil, :ms nil, :slur? nil})} + +;; STAGE 4: events => score +;; note that this only returns a single value on the stream, the final score +alda.parser=> (-> "piano: c8 e g > c4/e" tokenize parse-events aggregate-events build-score print-stream) +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x6bbc10cb "clojure.core.async.impl.channels.ManyToManyChannel@6bbc10cb"] +{:chord-mode false, :current-instruments #{"piano-57rju"}, :events #{#alda.lisp.model.records.Note{:offset 250.0, :instrument "piano-57rju", :volume 1.0, :track-volume 0.7874015748031497, :panning 0.5, :midi-note 64, :pitch 329.6275569128699, :duration 225.0, :voice nil} #alda.lisp.model.records.Note{:offset 500.0, :instrument "piano-57rju", :volume 1.0, :track-volume 0.7874015748031497, :panning 0.5, :midi-note 67, :pitch 391.99543598174927, :duration 225.0, :voice nil} #alda.lisp.model.records.Note{:offset 750.0, :instrument "piano-57rju", :volume 1.0, :track-volume 0.7874015748031497, :panning 0.5, :midi-note 72, :pitch 523.2511306011972, :duration 450.0, :voice nil} #alda.lisp.model.records.Note{:offset 750.0, :instrument "piano-57rju", :volume 1.0, :track-volume 0.7874015748031497, :panning 0.5, :midi-note 76, :pitch 659.2551138257398, :duration 450.0, :voice nil} #alda.lisp.model.records.Note{:offset 0, :instrument "piano-57rju", :volume 1.0, :track-volume 0.7874015748031497, :panning 0.5, :midi-note 60, :pitch 261.6255653005986, :duration 225.0, :voice nil}}, :beats-tally nil, :instruments {"piano-57rju" {:octave 5, :current-offset #alda.lisp.model.records.AbsoluteOffset{:offset 1250.0}, :key-signature {}, :config {:type :midi, :patch 1}, :duration {:beats 1.0, :ms 0}, :min-duration nil, :volume 1.0, :last-offset #alda.lisp.model.records.AbsoluteOffset{:offset 750.0}, :id "piano-57rju", :quantization 0.9, :duration-inside-cram nil, :tempo 120, :panning 0.5, :current-marker :start, :time-scaling 1, :stock "midi-acoustic-grand-piano", :track-volume 0.7874015748031497}}, :markers {:start 0}, :cram-level 0, :global-attributes {}, :nicknames {}, :beats-tally-default nil} +``` + +#### Error handling + +One consequence of parsing input asynchronously like this is that errors are not +thrown immediately. When an error occurs at an earlier stage in the parsing +pipeline, the error object is placed onto the channel so that a later stage can +handle it. Only during the score-building phase do we throw the error. + +Notice what happens in the REPL when we try to parse a score that produces an +error: + +```clojure +;; STAGE 1: tokenize +;; (The error is caught here and passed along through the pipeline.) +alda.parser=> (-> "piano: c8 d e f atoek;;ceo c/e/g" tokenize print-stream) +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x31d8b6ba "clojure.core.async.impl.channels.ManyToManyChannel@31d8b6ba"] +[:name [1 1] "piano"] +[:colon [1 6] ":"] +[:note [1 8] "c"] +[:note-length [1 9] "8"] +[:note [1 11] "d"] +[:note [1 13] "e"] +[:note [1 15] "f"] +[:name [1 17] "atoek"] +#error { + :cause "Unexpected ';' at line 1, column 22." + :via + [{:type java.lang.Exception + :message "Unexpected ';' at line 1, column 22." + :at [sun.reflect.NativeConstructorAccessorImpl newInstance0 "NativeConstructorAccessorImpl.java" -2]}] + :trace + [...]} +[:EOF [1 22]] + +;; STAGE 2: parse events +alda.parser=> (-> "piano: c8 d e f atoek;;ceo c/e/g" tokenize parse-events print-stream) +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x36df8301 "clojure.core.async.impl.channels.ManyToManyChannel@36df8301"] +{:event-type :part, :instrument-call {:names ["piano"]}, :events nil} +{:event-type :note, :letter :c, :accidentals [], :beats 0.5, :ms 0, :slur? nil} +{:event-type :note, :letter :d, :accidentals [], :beats nil, :ms nil, :slur? nil} +{:event-type :note, :letter :e, :accidentals [], :beats nil, :ms nil, :slur? nil} +{:event-type :note, :letter :f, :accidentals [], :beats nil, :ms nil, :slur? nil} +#error { + :cause "Unexpected ';' at line 1, column 22." + :via + [{:type java.lang.Exception + :message "Unexpected ';' at line 1, column 22." + :at [sun.reflect.NativeConstructorAccessorImpl newInstance0 "NativeConstructorAccessorImpl.java" -2]}] + :trace + [...]} +:EOF + +;; STAGE 3: aggregate events +alda.parser=> (-> "piano: c8 d e f atoek;;ceo c/e/g" tokenize parse-events aggregate-events print-stream) +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x531ebf8a "clojure.core.async.impl.channels.ManyToManyChannel@531ebf8a"] +{:event-type :part, :instrument-call {:names ["piano"]}, :events nil} +{:event-type :note, :letter :c, :accidentals [], :beats 0.5, :ms 0, :slur? nil} +{:event-type :note, :letter :d, :accidentals [], :beats nil, :ms nil, :slur? nil} +{:event-type :note, :letter :e, :accidentals [], :beats nil, :ms nil, :slur? nil} +#error { + :cause "Unexpected ';' at line 1, column 22." + :via + [{:type java.lang.Exception + :message "Unexpected ';' at line 1, column 22." + :at [sun.reflect.NativeConstructorAccessorImpl newInstance0 "NativeConstructorAccessorImpl.java" -2]}] + :trace + [...]} +{:event-type :note, :letter :f, :accidentals [], :beats nil, :ms nil, :slur? nil} + +;; STAGE 4: build score +;; (At this point, the error is thrown.) +alda.parser=> (-> "piano: c8 d e f atoek;;ceo c/e/g" tokenize parse-events aggregate-events build-score print-stream) +#object[clojure.core.async.impl.channels.ManyToManyChannel 0x70bac373 "clojure.core.async.impl.channels.ManyToManyChannel@70bac373"] +Uncaught exception in thread async-dispatch-1: + java.lang.Thread.run Thread.java: 745 +java.util.concurrent.ThreadPoolExecutor$Worker.run ThreadPoolExecutor.java: 617 + java.util.concurrent.ThreadPoolExecutor.runWorker ThreadPoolExecutor.java: 1142 + ... + clojure.core.async/thread-call/fn async.clj: 439 + alda.parser/tokenize/fn parser.clj: 43 + alda.parser.tokenize/read-character! tokenize.clj: 668 + alda.parser.tokenize/parse-name tokenize.clj: 438 + alda.parser.tokenize/read-character! tokenize.clj: 699 + alda.parser.tokenize/unexpected-char-error tokenize.clj: 96 + alda.parser.tokenize/emit-error! tokenize.clj: 79 + ... +java.lang.Exception: Unexpected ';' at line 1, column 22. + java.lang.Error: java.lang.Exception: Unexpected ';' at line 1, column 22. +``` + From eb22ba7c69278257969f381f3bd427ef09545e80 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Wed, 10 May 2017 10:41:49 -0400 Subject: [PATCH 21/22] details for changelog --- CHANGELOG.md | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index dd2671d..3af7aed 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,63 @@ # CHANGELOG +## Unreleased + +* Re-implemented the parser from the ground up in a more efficient way. The new + parser implementation uses core.async channels to complete the stages of the + parsing pipeline in parallel. + + Performance is roughly the same (only slightly better) for scores under ~100 + lines, but significantly better for larger scores. + + More importantly, parsing asynchronously opens the door for us to make playing + a score happen almost immediately in the near future. + + See [#37](https://github.com/alda-lang/alda-core/pull/37) for more details. + +* An added benefit of the new parser implementation is that it fixes issue + [#12](https://github.com/alda-lang/alda-core/issues/12). Line and column + numbers are now correct, and error messages are more informative when a score + fails to parse. + +* The `alda.parser-util` namespace, which included the `parse-to-*-with-context` + functions, has been removed. See [this commit](https://github.com/alda-lang/alda-core/pull/37/commits/5f35d659927952e99ea7ec9ab0ee2f4bb2f681aa) for more details. + +* The Alda parser no longer generates alda.lisp code. + + Originally, the Alda parser created a score by generating alda.lisp code and + then evaluating it. This actually changed some time ago to a system where the + parser generated a sequence of events directly and then used them to build the + score. We kept the code that generates alda.lisp code, even though it was no + longer an implementation detail of the parser, just an alternate "mode" of + parsing. + + With these changes to the parser, it would take some additional work to + generate alda.lisp code. Since it is no longer necessary to do that, + generating alda.lisp code is no longer a feature of Alda. We could + re-implement this feature in the future as part of the new parser, if there is + a demand for it. + +* Miscellaneous implementation changes that could be relevant if you use Alda + as a Clojure library: + + * `alda.parser/parse-input` returns a score map, rather than an unevaluated + S-expression. Calling this function will require and refer `alda.lisp` for + you if you haven't already done so in the namespace where you're using it. + + * `alda.lisp/alda-code` does not throw an exception by itself if the code is + not valid Alda; instead, the output contains an Exception object, which gets + thrown when used inside of a score + + * Whereas `alda.lisp/pitch` used to return a function to be applied to the + current octave and key signature, now it returns a map that includes its + `:letter` and `:accidentals`. This is more consistent with other alda.lisp + functions, and it allows notes to have equality semantics. + + In other words, whereas `(= (note (pitch :c)) (note (pitch :c)))` used to be + `false`, now it is `true` because we aren't comparing anonymous functions. + + * `(alda.lisp/barline)` now returns `{:event-type :barline}` instead of `nil`. + ## 0.1.2 (2016-12-05) * Fixed [#27](https://github.com/alda-lang/alda-core/issues/27), a bug where, when using note durations specified in seconds/milliseconds, the subsequent "default" note duration was not being set. From 6182cfc56250932cbb628ef56a3812dc7e266e23 Mon Sep 17 00:00:00 2001 From: Dave Yarwood Date: Fri, 12 May 2017 08:40:27 -0400 Subject: [PATCH 22/22] ensure events channel is totally consumed Otherwise (e.g. if one of the events is an error), I think the channel hangs around in memory forever waiting to continue being consumed. --- src/alda/parser.clj | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/alda/parser.clj b/src/alda/parser.clj index a5c27d4..261c942 100644 --- a/src/alda/parser.clj +++ b/src/alda/parser.clj @@ -102,13 +102,14 @@ (when-not (resolve 'ALDA-LISP-LOADED) (require '[alda.lisp :refer :all])) (go-loop [score (score/score)] - (let [event (