Karya, built on 2023-08-29T07:47:28 (patch 7a412d5d6ba4968ca4155ef276a062ccdeb9109a)
Safe HaskellSafe-Inferred

Derive.Deriver.Monad

Description

Implementation for the Deriver monad.

This module should contain only Deriver and the definitions needed to implement it. Unfortunately that winds up being quite a lot. Deriver carries a State, which is depended upon directly by all derivation, so it's just as complicated as derivation itself, which is to say, very.

Since State only really requires data types, the majority of this module is data declarations, with the exception of a few constructors which are intimately concerned with the type they are constructing. The library of functions to manipulate these types are split into Derive.Deriver.Lib.

This module is way too big. Unfortunately it's hard to split up because of circular imports. Anyone who directly or indirectly needs Deriver (e.g. calls) needs to import Derive. However, anything directly or indirectly used by State must be imported by Derive. Since State is the central type that must hold anything that persists beyond the evaluation of a single note, that winds up being a lot. At one point I tried to reign in the madness with hs-boot files, but I decided that hs-boot was worse.

Synopsis

Deriver

modify :: (st -> st) -> DeriveM.Deriver st err () Source #

gets :: (st -> a) -> DeriveM.Deriver st err a Source #

put :: st -> DeriveM.Deriver st err () Source #

run :: st -> DeriveM.Deriver st err a -> DeriveM.RunResult st err a Source #

error

data Error Source #

Instances

Instances details
Monoid NoteDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Semigroup NoteDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Error Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

ShowVal.ShowVal ControlDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

ShowVal.ShowVal NoteDeriver Source #

This is an invalid instance, because a deriver has no literal syntax. But this lets me put a deriver in a defaulted argument, and get documentation for it.

Instance details

Defined in Derive.Deriver.Monad

ShowVal.ShowVal PitchDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Typecheck ControlDeriver Source # 
Instance details

Defined in Derive.Sig

Typecheck NoteDeriver Source # 
Instance details

Defined in Derive.Sig

Typecheck PitchDeriver Source # 
Instance details

Defined in Derive.Sig

Log.LogMonad Deriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

write :: Log.Msg -> Deriver () Source #

Pretty.Pretty Error Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

ToLibrary (Transformer Control) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Note) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Pitch) Source # 
Instance details

Defined in Derive.Library

data ErrorVal Source #

Instances

Instances details
Show ErrorVal Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty ErrorVal Source # 
Instance details

Defined in Derive.Deriver.Monad

data CallError Source #

Constructors

TypeError !TypeErrorT

Error typechecking an argument.

CallNotFound !Expr.Symbol

Couldn't even call the thing because the name was not found.

ArgError !Text

Calling error that doesn't fit into the above categories.

Instances

Instances details
Show CallError Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty CallError Source # 
Instance details

Defined in Derive.Deriver.Monad

data ErrorPlace Source #

Where a type error came from. The arg number starts at 0.

Instances

Instances details
Show ErrorPlace Source # 
Instance details

Defined in Derive.Deriver.Monad

Eq ErrorPlace Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty ErrorPlace Source # 
Instance details

Defined in Derive.Deriver.Monad

data EvalSource Source #

Constructors

Literal

The value in error came from a literal expression.

Quoted !DeriveT.Quoted

The value in error came from a DeriveT.VQuoted bit of code.

SubTrack !(Either Text TrackId)

The error came from a SubT.Track. The value is either a track index into ctx_sub_events or a TrackId from ctx_sub_tracks.

Instances

Instances details
Show EvalSource Source # 
Instance details

Defined in Derive.Deriver.Monad

annotate :: (Error -> Error) -> Deriver a -> Deriver a Source #

Catch and rethrow an error, presumably to annotate it with more information.

require_right :: HasCallStack => (err -> Text) -> Either err a -> Deriver a Source #

derived types

class Callable call Source #

Each kind of deriver looks a different scope for its calls. By making this a class method, I can figure out which scope to look in just from the type.

This is essentially a translation from dynamically typed ScopesT and Scopes to statically typed Generator Note etc. The class itself should be closed, and correspond exactly to the fields of ScopesT * Scopes. Surely there is some more direct way to express this, but I haven't figured it out yet. TODO what would this look like in idris?

Minimal complete definition

get_builtins_scope, get_scopes_scope, callable_name

Instances

Instances details
Callable ValCall Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Generator Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Generator Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Generator Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (TrackCall Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (TrackCall Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (TrackCall Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

callable_name :: Callable call => Proxy call -> Text Source #

What to call this call, for error msgs when lookup fails.

data Tagged Source #

This is for ctx_prev_val. Normally the previous value is available in all its untagged glory based on the type of the call, but ValCalls can occur with all the different types, so they need a tagged ctx_prev_val.

Instances

Instances details
Show Tagged Source # 
Instance details

Defined in Derive.Deriver.Monad

Taggable Tagged Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty Tagged Source # 
Instance details

Defined in Derive.Deriver.Monad

class (Show a, Pretty.Pretty a) => Taggable a where Source #

Instances

Instances details
Taggable Control Source # 
Instance details

Defined in Derive.Deriver.Monad

Taggable Note Source # 
Instance details

Defined in Derive.Deriver.Monad

Taggable Pitch Source # 
Instance details

Defined in Derive.Deriver.Monad

Taggable Tagged Source # 
Instance details

Defined in Derive.Deriver.Monad

type CallableExpr d = (Callable (Generator d), Callable (Transformer d), Callable (TrackCall d), Taggable d) Source #

Context for Callable on both Generator and Transformer. It has this name because top-level expression calls have this context.

lookup_call

state

data State Source #

All the state available during derivation.

Constructors

State 

Fields

  • state_threaded :: !Threaded

    Threaded state means deriving one event depends on the results of the previous event. This corresponds to StateT.

  • state_dynamic :: !Dynamic

    This data is modified in a dynamically scoped way, for sub-derivations. This corresponds to ReaderT.

  • state_collect :: !Collect

    This data is mappended. It functions like an implicit return value. This corresponds to WriterT.

  • state_constant :: !Constant

    This data is constant throughout the derivation.

Instances

Instances details
Monoid NoteDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Semigroup NoteDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

ShowVal.ShowVal ControlDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

ShowVal.ShowVal NoteDeriver Source #

This is an invalid instance, because a deriver has no literal syntax. But this lets me put a deriver in a defaulted argument, and get documentation for it.

Instance details

Defined in Derive.Deriver.Monad

ShowVal.ShowVal PitchDeriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Typecheck ControlDeriver Source # 
Instance details

Defined in Derive.Sig

Typecheck NoteDeriver Source # 
Instance details

Defined in Derive.Sig

Typecheck PitchDeriver Source # 
Instance details

Defined in Derive.Sig

Log.LogMonad Deriver Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

write :: Log.Msg -> Deriver () Source #

Callable (Transformer Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

ToLibrary (Transformer Control) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Note) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Pitch) Source # 
Instance details

Defined in Derive.Library

data Threaded Source #

State which is threaded linearly. This destroys the ability to parallelize derivation, so it's not so great. However, the only threaded state is state_prev_val, which is only needed within a track, so sibling tracks can still be parallelized.

Constructors

Threaded 

Fields

  • state_prev_val :: !(Map (BlockId, TrackId) Tagged)

    Keep track of the previous value for each track currently being evaluated. See NOTE [prev-val].

  • state_event_serial :: !Stack.Serial

    This is used for Stack.Frame to ensure a unique stack for multiple generator calls within a single track event. It's reset on the evaluation of each uninverted track event, and incremented after every Score.Event is emitted. See NOTE [event-serial] for history.

Instances

Instances details
Show Threaded Source # 
Instance details

Defined in Derive.Deriver.Monad

data Dynamic Source #

This is a dynamically scoped environment that applies to generated events inside its scope.

Constructors

Dynamic 

Fields

  • state_control_merge_defaults :: !(Map ScoreT.Control Merger)
     
  • state_pitch :: !DeriveT.PSignal

    The unnamed pitch signal currently in scope. This is the pitch signal that's applied to notes by default. It's split off from state_environ because it's convenient to guarentee that the main pitch signal is always present.

  • state_environ :: !DeriveT.Environ
     
  • state_warp :: !Warp.Warp
     
  • state_scopes :: !Scopes

    Calls currently in scope.

  • state_instrument_aliases :: !InstrumentAliases
     
  • state_control_damage :: !ControlDamage
     
  • state_under_invert :: !(NoteDeriver -> NoteDeriver)

    This is a delayed transform. If a call wants to evaluate under inversion, it composes itself on to this, which is then applied as a transformation to the eventual synthesized event at the bottom of the inversion.

  • state_inversion :: !Inversion
     
  • state_pitch_map :: !(Maybe (Maybe DeriveT.PSignal, [Log.Msg]))

    Each note track sets this to either an unsliced evaluation of the closest pitch track below it, or its surrounding state_pitch if there is no pitch track below. Calls can then use it to get neighboring pitches. It's lazily evaluated so there's no extra derivation if you don't need it.

    The PSignal is in TrackTime, not RealTime. This is because the call may run in an altered Warp (e.g. integrate runs Internal.in_real_time) which would render the PSignal times inaccurate.

    This is cleared when evaluating for itself, so there's no recursion. This means given two "next pitch"es in a row, they will both get Nothing. Then on real evaluation, the 2nd will get the next pitch, but the 1st will get whatever the 2nd does when it can't get a next pitch.

    TODO if they both emit no pitch, then the 1st will actually get the previous pitch, which seems error-prone. But I think for it to be an error, I'd have to have it return an error, e.g. Map TrackTime Pitch

  • state_note_track :: !(Maybe (BlockId, TrackId))

    This is set to the current note track being evaluated. It's useful to look up state_prev_val when evaluating other tracks in an inversion. It's set when entering a note track, and unset when entering a block.

  • state_stack :: !Stack.Stack

    This is the call stack for events. It's used for error reporting, and attached to events in case they want to emit errors later (say during performance).

  • state_mode :: !Mode
     

Instances

Instances details
DeepSeq.NFData Dynamic Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: Dynamic -> () #

Pretty.Pretty Dynamic Source # 
Instance details

Defined in Derive.Deriver.Monad

type InstrumentAliases = Map ScoreT.Instrument ScoreT.Instrument Source #

Instrument aliases as (alias, destination) pairs. Map through this before looking in state_lookup_instrument. The alias destination is always the final instrument, not another alias, so you never have to look up multiple times.

data Inversion Source #

When a note call inverts, it stashes its actual note-generating code so it can re-invoke track evaluation on the control tracks below it. It's kind of like saving a continuation.

Previously I did it by copying the text of the inverting call to the generated track. The problem was that I therefore had to keep the evaluated expression around in the call Context, and if I forgot to clear it in the right places things would be very confusing when a later inversion executed unexpected code. under_invert transforms are now also stored as code rather than data, in state_under_invert.

Constructors

NotInverted

Pre-inversion.

InversionInProgress !NoteDeriver

After inversion, but not yet at the bottom. The inverted generator is captured here.

Instances

Instances details
Pretty.Pretty Inversion Source # 
Instance details

Defined in Derive.Deriver.Monad

strip_dynamic :: Dynamic -> Dynamic Source #

Strip out fields that I don't need to remember in a TrackDynamic.

If I don't do this, I get a memory leak. Presumably the cause is that state_pitch_map has an unevaluated pitch derivation, which in turn somehow retains the previous derivation, and then the previous, and so on. This makes each derivation leak more space.

initial_controls :: ScoreT.ControlMap Source #

Initial control environment.

default_dynamic :: Signal.Y Source #

A default dynamic that's not 0 is useful because otherwise you have to add dyn to everything. Since control tracks multiply by default, 1 is the most convenient value.

scope

type Builtins = ScopesT (MkScopeCallMaps (Generator Note) (Generator Control) (Generator Pitch)) (MkScopeCallMaps (Transformer Note) (Transformer Control) (Transformer Pitch)) (MkScopeCallMaps (TrackCall Note) (TrackCall Control) (TrackCall Pitch)) (ModuleMap ValCall) Source #

This is the library of built-in calls, indexed by Module. On import, the imported CallMaps are inserted into Scopes at PrioBuiltin.

data CallMap call Source #

The map takes priority over the patterns.

Constructors

CallMap 

Fields

Instances

Instances details
Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Monoid (CallMap call) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

mempty :: CallMap call #

mappend :: CallMap call -> CallMap call -> CallMap call #

mconcat :: [CallMap call] -> CallMap call #

Semigroup (CallMap call) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(<>) :: CallMap call -> CallMap call -> CallMap call #

sconcat :: NonEmpty (CallMap call) -> CallMap call #

stimes :: Integral b => b -> CallMap call -> CallMap call #

Pretty.Pretty (CallMap call) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

pretty :: CallMap call -> Text Source #

format :: CallMap call -> Doc Source #

formatList :: [CallMap call] -> Doc Source #

type Scopes = ScopesT (Scope (ScopePriority (Generator Note)) (ScopePriority (Generator Control)) (ScopePriority (Generator Pitch))) (Scope (ScopePriority (Transformer Note)) (ScopePriority (Transformer Control)) (ScopePriority (Transformer Pitch))) (Scope (ScopePriority (TrackCall Note)) (ScopePriority (TrackCall Control)) (ScopePriority (TrackCall Pitch))) (ScopePriority ValCall) Source #

This represents all calls in scope. Different types of calls are in scope depending on the track type, except ValCalls, which are in scope everywhere. This is dynamic scope, not lexical scope.

Perhaps this should be called Namespaces, but Id.Namespace is already taken and Scopes is shorter.

data ScopesT gen trans track val Source #

TODO this could probably now do with a more general name maybe CallType for this, and CallKind for Scope? This is arg type, Scope is return type, or maybe TrackType.

Calls are in scope by expression position (generator, transformer, track, val) and then by track type (note, control, pitch). Expression position also determines the the argument type (generator: nothing, transformer: deriver, track: TrackTree.EventsTree), while track type determines the return type (Deriver Note, Deriver Control, Deriver Pitch).

Val calls are special in that they always have the same type (Args -> Val), and are in scope in val call exrpession position for all track types.

names: EScope, TScope for ExpressionScope and TrackScope? ExprScope, TrackScope? I'd want to update the names in CallDoc too.

Constructors

Scopes 

Fields

Instances

Instances details
Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

(Monoid gen, Monoid trans, Monoid track, Monoid val) => Monoid (ScopesT gen trans track val) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

mempty :: ScopesT gen trans track val #

mappend :: ScopesT gen trans track val -> ScopesT gen trans track val -> ScopesT gen trans track val #

mconcat :: [ScopesT gen trans track val] -> ScopesT gen trans track val #

(Semigroup gen, Semigroup trans, Semigroup track, Semigroup val) => Semigroup (ScopesT gen trans track val) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(<>) :: ScopesT gen trans track val -> ScopesT gen trans track val -> ScopesT gen trans track val #

sconcat :: NonEmpty (ScopesT gen trans track val) -> ScopesT gen trans track val #

stimes :: Integral b => b -> ScopesT gen trans track val -> ScopesT gen trans track val #

(Pretty.Pretty gen, Pretty.Pretty trans, Pretty.Pretty track, Pretty.Pretty val) => Pretty.Pretty (ScopesT gen trans track val) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

pretty :: ScopesT gen trans track val -> Text Source #

format :: ScopesT gen trans track val -> Doc Source #

formatList :: [ScopesT gen trans track val] -> Doc Source #

s_generator :: ScopesT gen trans track val :-> gen Source #

s_transformer :: ScopesT gen trans track val :-> trans Source #

s_track :: ScopesT gen trans track val :-> track Source #

s_val :: ScopesT gen trans track val :-> val Source #

data Scope note control pitch Source #

Constructors

Scope 

Fields

Instances

Instances details
Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

(Monoid note, Monoid control, Monoid pitch) => Monoid (Scope note control pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

mempty :: Scope note control pitch #

mappend :: Scope note control pitch -> Scope note control pitch -> Scope note control pitch #

mconcat :: [Scope note control pitch] -> Scope note control pitch #

(Semigroup note, Semigroup control, Semigroup pitch) => Semigroup (Scope note control pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(<>) :: Scope note control pitch -> Scope note control pitch -> Scope note control pitch #

sconcat :: NonEmpty (Scope note control pitch) -> Scope note control pitch #

stimes :: Integral b => b -> Scope note control pitch -> Scope note control pitch #

DeepSeq.NFData (Scope a b c) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: Scope a b c -> () #

(Pretty.Pretty note, Pretty.Pretty control, Pretty.Pretty pitch) => Pretty.Pretty (Scope note control pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

pretty :: Scope note control pitch -> Text Source #

format :: Scope note control pitch -> Doc Source #

formatList :: [Scope note control pitch] -> Doc Source #

s_note :: Scope note control pitch :-> note Source #

s_control :: Scope note control pitch :-> control Source #

s_pitch :: Scope note control pitch :-> pitch Source #

newtype ScopePriority call Source #

An instrument or scale may put calls into scope. If that instrument or scale is replaced with another, the old calls must be replaced with the new ones.

Priority is determined by get_scopes, which returns them in the fields' declaration order.

The reason this can't be accomplished just by arranging imports in the right order is that when an instrument or scale comes into scope, it needs to replace existing instrument or scale calls. To do that, I need to keep each category separate. Also, this way I can import the ky file once at the toplevel, and it will still override PrioBuiltin calls.

Constructors

ScopePriority (Map CallPriority (CallMap call)) 

Instances

Instances details
Monoid (ScopePriority call) Source # 
Instance details

Defined in Derive.Deriver.Monad

Semigroup (ScopePriority call) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(<>) :: ScopePriority call -> ScopePriority call -> ScopePriority call #

sconcat :: NonEmpty (ScopePriority call) -> ScopePriority call #

stimes :: Integral b => b -> ScopePriority call -> ScopePriority call #

Pretty.Pretty (ScopePriority call) Source # 
Instance details

Defined in Derive.Deriver.Monad

data CallPriority Source #

Constructors

PrioOverride

Override calls shadow all others. They're useful when you want to prevent instruments from overriding calls, which the lilypond deriver needs to do.

PrioInstrument

These are instrument-specific calls implicitly imported by note tracks.

PrioBlock

Block calls are local definitions, so they should override builtin calls, but are still below instrument calls. Otherwise, it's easy to define a block that shadows a drum stroke and get confused. TODO there could be a mechanism to set PrioOverride in case I actually do want to shadow an instrument call.

PrioScale

This is for value calls introduced by a scale. They are implicitly imported by pitch tracks.

PrioBuiltin

Calls imported from the Builtins.

add_priority :: CallPriority -> CallMap call -> ScopePriority call -> ScopePriority call Source #

Add this call at this level of priority. It will shadow existing calls with the same name.

replace_priority :: CallPriority -> CallMap call -> ScopePriority call -> ScopePriority call Source #

Replace all calls at this level of priority.

data DocumentedCall Source #

This is like Call, but with only documentation. (name, CallDoc)

data PatternCall call Source #

Constructors

PatternCall 

Fields

Instances

Instances details
Pretty.Pretty (PatternCall call) Source # 
Instance details

Defined in Derive.Deriver.Monad

TrackCall

data TrackCall d Source #

Constructors

TrackCall 

Fields

Instances

Instances details
Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

Show (TrackCall d) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (TrackCall Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (TrackCall Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (TrackCall Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

ToLibrary (TrackCall Control) Source # 
Instance details

Defined in Derive.Library

ToLibrary (TrackCall Note) Source # 
Instance details

Defined in Derive.Library

ToLibrary (TrackCall Pitch) Source # 
Instance details

Defined in Derive.Library

Pretty.Pretty (TrackCall d) Source # 
Instance details

Defined in Derive.Deriver.Monad

track_call :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> TrackCallFunc d -> TrackCall d Source #

constant

data Constant Source #

Values that don't change during one derive run.

Constructors

Constant 

Fields

data Mode Source #

Derivation can run in a few distinct modes.

Constructors

Normal

Standard derivation.

ScoreDurationQuery

This indicates that I'm running the deriver just to find out its duration. There's a hack in Derive.Eval that will fill in collect_score_duration when it sees this mode. More detail in CallDuration.

RealDurationQuery 
Lilypond !Lilypond.Types.Config

Emit events intended for the lilypond backend. Calls that have corresponding staff notation (e.g. trills) emit special events with attached lilypond code in this mode.

Instances

Instances details
Show Mode Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty Mode Source # 
Instance details

Defined in Derive.Deriver.Monad

mergers :: Map Expr.Symbol Merger Source #

The built-in set of control Mergers.

merge_scale :: Merger Source #

Unlike the rest, this one is not associative.

instrument

data Instrument Source #

Mostly the deriver just deals with instruments as strings, and doesn't understand anything else about them. However, it does need a few other things, which are expressed here to avoid excessive dependencies between the systems.

Constructors

Instrument 

Fields

Instances

Instances details
Show Instrument Source # 
Instance details

Defined in Derive.Deriver.Monad

type InstrumentCalls = ScopesT (CallMap (Generator Note)) (CallMap (Transformer Note)) (CallMap (TrackCall Note)) (CallMap ValCall) Source #

Some ornaments only apply to a particular instrument, so each instrument can bring a set of note calls and val calls into scope, via the Scope type. This is like Builtins, but without the Module map, since they're all implicitly in PrioInstrument.

control

data Merge Source #

How to merge a control into Dynamic.

Constructors

DefaultMerge

Apply the default merge for this control.

Merge !Merger

Merge with a specific operator.

Instances

Instances details
Show Merge Source # 
Instance details

Defined in Derive.Deriver.Monad

DeepSeq.NFData Merge Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: Merge -> () #

Pretty.Pretty Merge Source # 
Instance details

Defined in Derive.Deriver.Monad

data Merger Source #

Combine two signals. The element should be an identity, like mempty. ControlMod uses it to avoid affecting signal outside of the modified range. The merge function is not obliged to be associative, so this isn't actually a monoid. TODO it's all the fault of merge_scale... do I lose something important with associativity?

Constructors

Merger !Text !(Signal.Control -> Signal.Control -> Signal.Control) !Signal.Y

name merge identity

Set

Replace the existing signal.

Unset

Replace only if there is no existing signal. TODO I thought I'd need this but I don't. If it turns out to never be useful I can delete it.

Instances

Instances details
Show Merger Source # 
Instance details

Defined in Derive.Deriver.Monad

DeepSeq.NFData Merger Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: Merger -> () #

ShowVal.ShowVal Merger Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

show_val :: Merger -> Text Source #

Pretty.Pretty Merger Source # 
Instance details

Defined in Derive.Deriver.Monad

collect

data Collect Source #

These are things that collect throughout derivation, and are cached in addition to the derived values. Effectively they are extra return values, which are combined with mappend. So this is the WriterT part of State.

Constructors

Collect 

Fields

Instances

Instances details
Monoid Collect Source # 
Instance details

Defined in Derive.Deriver.Monad

Semigroup Collect Source # 
Instance details

Defined in Derive.Deriver.Monad

DeepSeq.NFData Collect Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: Collect -> () #

Pretty.Pretty Collect Source # 
Instance details

Defined in Derive.Deriver.Monad

type SignalFragments = Map (BlockId, TrackId) (Map TrackTime Signal.Control) Source #

These are fragments of a signal, which will be later collected into collect_track_signals. This is part of a complicated mechanism to evaluate TrackSignals only once. When the sliced fragments of a track are evaluated, they collect signal fragments. When the track is fully evaluated, they are sorted and merged into collect_track_signals. If the track is then evaluated again, the monoid instance will discard the duplicate.

The signal fragments are indexed by the slice position. Since merge makes the earlier signals win in case of overlaps, this ensures a trimmed earlier fragment won't replace a more complete later one.

data ControlMod Source #

This is a hack so a call on a control track can modify other controls. The motivating case is pitch ornaments that also want to affect the dynamics. The modifications are a secondary return value from control and pitch calls. The track deriver will extract them and merge them into the dynamic environment. [NOTE control-modification]

Instances

Instances details
Show ControlMod Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty ControlMod Source # 
Instance details

Defined in Derive.Deriver.Monad

type TrackDynamic = Map (BlockId, TrackId) Dynamic Source #

Snapshots of the environ at each track. This is used by the Cmd layer to figure out what the scale and instrument are for a given track.

Originally this was a map from Stacks to Environ (and only the changed parts). The idea was that I could walk up the stack to find the Environ value in scope at a given point, and given Stack.Region, could even get e.g. per event instruments. Unfortunately, while it's easy to do that on the Derive side, it seems really complicated and somewhat expensive to try to retrace a complete stack on every cmd. Since this implementation doesn't store the entire stack, a track with a different instrument at different times will wind up with the last one.

This is a much simpler solution which will hopefully work well enough in practice.

NOTE [record-track-dynamics] One complication is that when I get controls from sliced tracks, the controls are also sliced. But I need the environ from the inverted version of the track so the common case of [>i, *scale] gets the correct scale. So I record TrackDynamic for both inverted and non inverted tracks and prefer the inverted tracks, but take controls from the non-inverted versions.

data CallDuration a Source #

This is the logical duration of a call. This may be different from its actual duration (which is to say, the end time of the last event it emits). Also, while most calls adjust their duration to the duration of the event they are called from, some of them have their own intrinsic duration. For example, a block call may stretch to its calling event's duration, but it also has its own duration that is used to align the block's end, or to sequence blocks.

Since the call duration is sometimes used to place the call in the first place (e.g. to align its end), I want to evaluate the minimum amount necessary to find the duration. The implementation is that each generator call has a gfunc_score_duration field. When Derive.Eval is evaluating a generator call, if it sees that state_mode is ScoreDurationQuery, instead of calling gfunc_f, it will call gfunc_score_duration and return the result via collect_score_duration. You shouldn't stick your fingers into this machinery, but instead use Derive.get_call_duration to do the gefingerpoken for you.

I'm not very happy with this implementation, but I tried several approaches and this is the only one that worked. Historical details are in NOTE [call-duration].

Constructors

Unknown 
CallDuration !a 

Instances

Instances details
Monoid (CallDuration a) Source # 
Instance details

Defined in Derive.Deriver.Monad

Semigroup (CallDuration a) Source # 
Instance details

Defined in Derive.Deriver.Monad

Show a => Show (CallDuration a) Source # 
Instance details

Defined in Derive.Deriver.Monad

Eq a => Eq (CallDuration a) Source # 
Instance details

Defined in Derive.Deriver.Monad

Show a => Pretty.Pretty (CallDuration a) Source # 
Instance details

Defined in Derive.Deriver.Monad

calls

data Context val Source #

Additional data for a call. This part is invariant for all calls on an event.

The events are not used for transform calls.

TODO make separate types so the irrelevent data need not be passed?

Constructors

Context 

Fields

  • ctx_prev_val :: !(Maybe val)

    Hack so control calls have access to the previous sample, since they tend to want to interpolate from that value.

    This used to be the only way a call could get the previous value, but now if the prev val is unset, then "Derive.Args.prev_val" will evaluate ctx_prev_events. But checking ctx_prev_val is cheaper, so I'll keep it around. The evaluation fallback has to exist because track slicing may snip off the previous event.

    See NOTE [prev-val] in Derive.Args for details.

  • ctx_event :: !Event.Event
     
  • ctx_prev_events :: ![Event.Event]
     
  • ctx_next_events :: ![Event.Event]
     
  • ctx_event_end :: !ScoreTime

    The extent of the note past its duration. Since notes have decay, its important to capture control for that. Normally this is the next event's start. If there's no next event because it's the last event of the block, this is the block end, otherwise if there's no next event because it was sliced off, this is where that event would have started.

    This is the same as the first element of ctx_next_events except of course it has a value even when there is no next event.

  • ctx_track_shifted :: !TrackTime
  • ctx_sub_tracks :: !TrackTree.EventsTree

    The track tree below note tracks. Not given for control tracks. TODO should this be Either with ctx_sub_events? I don't think I ever need both set.

  • ctx_sub_events :: !(Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]])

    If present, sub_events will directly return these sub events instead of slicing sub-tracks. Track evaluation will never set this, but calls can set this to reapply a note parent. It should be Events, but isn't to avoid circular imports.

  • ctx_track_type :: !(Maybe ParseTitle.Type)

    This is needed by val calls that want to evaluate events around them. Since val calls are the same on all track types, they need to know explicitly what the track type is to evaluate events on it.

Instances

Instances details
Functor Context Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

fmap :: (a -> b) -> Context a -> Context b #

(<$) :: a -> Context b -> Context a #

Pretty.Pretty val => Pretty.Pretty (Context val) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

pretty :: Context val -> Text Source #

format :: Context val -> Doc Source #

formatList :: [Context val] -> Doc Source #

ctx_track_range :: Context a -> (TrackTime, TrackTime) Source #

Range of the event in TrackTime.

dummy_context :: ScoreTime -> ScoreTime -> Text -> Context a Source #

Transformer calls don't necessarily apply to any particular event, and neither do generators for that matter.

tag_context :: Taggable a => Context a -> Context Tagged Source #

Taggable the polymorphic part of the Context so it can be given to a ValCall. Otherwise, ValCall would have to be polymorphic too, which means it would hard to write generic ones.

data Call func Source #

A Call will be called as either a generator or a transformer, depending on its position. A call at the end of a compose pipeline will be called as a generator while ones composed with it will be called as transformers, so in a | b, a is a transformer and b is a generator.

More details on this strange setup are in the Derive.Call haddock.

Constructors

Call 

Fields

Instances

Instances details
Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

Show (Call d) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

showsPrec :: Int -> Call d -> ShowS #

show :: Call d -> String.String #

showList :: [Call d] -> ShowS #

Callable (Generator Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Generator Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Generator Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

ToLibrary (Generator Control) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Generator Note) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Generator Pitch) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Control) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Note) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Pitch) Source # 
Instance details

Defined in Derive.Library

Pretty.Pretty (Call d) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

pretty :: Call d -> Text Source #

format :: Call d -> Doc Source #

formatList :: [Call d] -> Doc Source #

newtype CallName Source #

Each call has an intrinsic name. Since call IDs may be rebound dynamically, each call has its own name so that error msgs are unambiguous. It's also used along with ArgName for argument defaulting, so if you want that to work it should be short and parseable by p_unquoted_str. The name is not necessarily unique, and in fact may be intentionally non-unique to share defaults with another.

The documentation for all calls that differ only in name are grouped together, so it's easier to read if small modifications are reflected in the name only. If you put invalid identifiers in the name, it can't be used to set default arguments.

Constructors

CallName Text 

Instances

Instances details
String.IsString CallName Source # 
Instance details

Defined in Derive.Deriver.Monad

Show CallName Source # 
Instance details

Defined in Derive.Deriver.Monad

Eq CallName Source # 
Instance details

Defined in Derive.Deriver.Monad

Ord CallName Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty CallName Source # 
Instance details

Defined in Derive.Deriver.Monad

newtype ArgName Source #

Each call argument has its own name, which is used for documentation as well as argument defaulting, as documented in Derive.Sig.

Constructors

ArgName Text 

Instances

Instances details
String.IsString ArgName Source # 
Instance details

Defined in Derive.Deriver.Monad

Show ArgName Source # 
Instance details

Defined in Derive.Deriver.Monad

Eq ArgName Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(==) :: ArgName -> ArgName -> Bool #

(/=) :: ArgName -> ArgName -> Bool #

Ord ArgName Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty ArgName Source # 
Instance details

Defined in Derive.Deriver.Monad

data CallDoc Source #

Documentation for a call. The documentation is in markdown format, except that a single newline will be replaced with two, so a single n is enough to start a new paragraph. Also, single quotes are turned into links as per Util.Texts.haddockUrl.

Instances

Instances details
Show CallDoc Source # 
Instance details

Defined in Derive.Deriver.Monad

Eq CallDoc Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(==) :: CallDoc -> CallDoc -> Bool #

(/=) :: CallDoc -> CallDoc -> Bool #

Ord CallDoc Source # 
Instance details

Defined in Derive.Deriver.Monad

data ArgDoc Source #

Instances

Instances details
Show ArgDoc Source # 
Instance details

Defined in Derive.Deriver.Monad

Eq ArgDoc Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(==) :: ArgDoc -> ArgDoc -> Bool #

(/=) :: ArgDoc -> ArgDoc -> Bool #

Ord ArgDoc Source # 
Instance details

Defined in Derive.Deriver.Monad

data ArgParser Source #

These enumerate the different ways an argumnt can be parsed, and correspond to parsers in Derive.Sig.

data EnvironDefault Source #

This configures how an argument looks for a default in the environ.

Constructors

None

Don't default from environ at all.

Prefixed

Look for callname-argname.

Unprefixed

Look for argname. This is useful for generic parameters that should configure many calls simultaneously.

Both

First look for a prefixed key, then for an unprefixed one.

type WithArgDoc f = (f, [ArgDoc]) Source #

A value annotated with argument docs. This is returned by the functions in Derive.Sig, and accepted by the Call constructors here.

data PassedArgs val Source #

Data passed to a Call.

Constructors

PassedArgs 

Fields

Instances

Instances details
Functor PassedArgs Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

fmap :: (a -> b) -> PassedArgs a -> PassedArgs b #

(<$) :: a -> PassedArgs b -> PassedArgs a #

Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

Callable (Transformer Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Transformer Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

ToLibrary (Transformer Control) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Note) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Transformer Pitch) Source # 
Instance details

Defined in Derive.Library

Pretty.Pretty val => Pretty.Pretty (PassedArgs val) Source # 
Instance details

Defined in Derive.Deriver.Monad

generator

data GeneratorFunc d Source #

Constructors

GeneratorFunc 

Fields

Instances

Instances details
Show Builtins Source # 
Instance details

Defined in Derive.Deriver.Monad

Show InstrumentCalls Source # 
Instance details

Defined in Derive.Deriver.Monad

Show Library Source # 
Instance details

Defined in Derive.Library

Callable (Generator Control) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Generator Note) Source # 
Instance details

Defined in Derive.Deriver.Monad

Callable (Generator Pitch) Source # 
Instance details

Defined in Derive.Deriver.Monad

ToLibrary (Generator Control) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Generator Note) Source # 
Instance details

Defined in Derive.Library

ToLibrary (Generator Pitch) Source # 
Instance details

Defined in Derive.Library

generator :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (GeneratorF d) -> Generator d Source #

Create a generator that expects a list of derived values (e.g. Score.Event or Signal.Control), with no logs mixed in. The result is wrapped in LEvent.Event.

generator_events :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs d -> Deriver [d]) -> Generator d Source #

Make a generator from a function which returns events in sorted order. TODO this just trusts that the events will be sorted. Is there a safer way?

generator1 :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (PassedArgs d -> Deriver d) -> Generator d Source #

Since Signals themselves are collections, there's little reason for a signal generator to return a Stream of events. So wrap the generator result in a Stream singleton.

TODO call this signal_generator?

with_score_duration :: (PassedArgs d -> Deriver (CallDuration ScoreTime)) -> Generator d -> Generator d Source #

Set the gfunc_score_duration field to get ScoreTime CallDuration.

transformer

type TransformerF d = PassedArgs d -> Deriver (Stream.Stream d) -> Deriver (Stream.Stream d) Source #

args -> deriver -> deriver

transformer :: Module.Module -> CallName -> Tags.Tags -> Doc.Doc -> WithArgDoc (TransformerF d) -> Transformer d Source #

Just make_call with a more specific signature.

val

cache types

The cache types are nominally exported from Derive.Cache, but must be defined here to avoid circular dependencies.

newtype Cache Source #

Constructors

Cache (Map CacheKey Cached) 

Instances

Instances details
Monoid Cache Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

mempty :: Cache #

mappend :: Cache -> Cache -> Cache #

mconcat :: [Cache] -> Cache #

Semigroup Cache Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

(<>) :: Cache -> Cache -> Cache #

sconcat :: NonEmpty Cache -> Cache #

stimes :: Integral b => b -> Cache -> Cache #

DeepSeq.NFData Cache Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: Cache -> () #

Pretty.Pretty Cache Source # 
Instance details

Defined in Derive.Deriver.Monad

newtype CacheKey Source #

Ideally, the cache would be keyed by all data that can affect derivation, which would mean all of Dynamic and Threaded. Effectively a deriver is a function that takes State as its input, and this would be memoizing that function. But in practice, there's too much junk in there, so I have to do an approximation.

The first approximation is the stack, which is a proxy for the things that are likely to affect derivation. Different calls in the stack are likely to result in a different environment, or a different Stack.Region likely means a different warp. Stack.Frame attempts to ensure that multiple generators within a single event also have unique stacks.

Constructors

CacheKey 

Instances

Instances details
Show CacheKey Source # 
Instance details

Defined in Derive.Deriver.Monad

DeepSeq.NFData CacheKey Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: CacheKey -> () #

Eq CacheKey Source # 
Instance details

Defined in Derive.Deriver.Monad

Ord CacheKey Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty CacheKey Source # 
Instance details

Defined in Derive.Deriver.Monad

data Cached Source #

When cache entries are invalidated by ScoreDamage, a marker is left in their place. This is just for a nicer log msg that can tell the difference between never evaluated and damaged.

Constructors

Cached !CacheEntry 
Invalid 

Instances

Instances details
DeepSeq.NFData Cached Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: Cached -> () #

Pretty.Pretty Cached Source # 
Instance details

Defined in Derive.Deriver.Monad

data CacheEntry Source #

Since an entire track is one type but will have many different calls of different types, the deriver type division goes above the call type division.

Instances

Instances details
DeepSeq.NFData CacheEntry Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: CacheEntry -> () #

Pretty.Pretty CacheEntry Source # 
Instance details

Defined in Derive.Deriver.Monad

data CallType d Source #

The type here should match the type of the stack it's associated with, but I'm not quite up to those type gymnastics yet.

Constructors

CallType !Collect !(Stream.Stream d) 

Instances

Instances details
DeepSeq.NFData d => DeepSeq.NFData (CallType d) Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: CallType d -> () #

newtype BlockDeps Source #

Constructors

BlockDeps (Set BlockId) 

Instances

Instances details
Monoid BlockDeps Source # 
Instance details

Defined in Derive.Deriver.Monad

Semigroup BlockDeps Source # 
Instance details

Defined in Derive.Deriver.Monad

Show BlockDeps Source # 
Instance details

Defined in Derive.Deriver.Monad

DeepSeq.NFData BlockDeps Source # 
Instance details

Defined in Derive.Deriver.Monad

Methods

rnf :: BlockDeps -> () #

Eq BlockDeps Source # 
Instance details

Defined in Derive.Deriver.Monad

Pretty.Pretty BlockDeps Source # 
Instance details

Defined in Derive.Deriver.Monad

damage

data ScoreDamage Source #

Modified ranges in the score.

Constructors

ScoreDamage 

Fields

newtype ControlDamage Source #

Control damage indicates that a section of control signal has been modified. It's dynamically scoped over the same range as the control itself, so that events that depend on it can be rederived.

util

scale

data ScaleCall Source #

Like ValCall, but specialized to return Scale, which is not a first class Val.

data Scale Source #

Constructors

Scale 

Fields

Instances

Instances details
Pretty.Pretty Scale Source # 
Instance details

Defined in Derive.Deriver.Monad

newtype LookupScale Source #

A scale can configure itself by looking in the environment and by looking up other scales.

Instances

Instances details
Show LookupScale Source # 
Instance details

Defined in Derive.Deriver.Monad

type Transpose = Transposition -> DeriveT.Environ -> Pitch.Step -> Pitch.Pitch -> Either DeriveT.PitchError Pitch.Pitch Source #

Scales may ignore Transposition if they don't support it.

Transposition could almost always succeed, and leaving the error reporting to scale_show. But for some scales it has to parse the Pitch.Key from the environ, which can fail. Parsing the key is pretty unfortunate, since it winds up getting repeated for scale_read and scale_show, but I don't want to make the Key type concrete, since each scale has a different one.

TODO could make the key an existential type and export scale_parse_key?

data Transposition Source #

Constructors

Chromatic 
Diatonic 

Instances

Instances details
Show Transposition Source # 
Instance details

Defined in Derive.Deriver.Monad

type Enharmonics = DeriveT.Environ -> Pitch.Note -> Either DeriveT.PitchError [Pitch.Note] Source #

Get the enharmonics of the note. The given note is omitted, and the enharmonics are in ascending order until they wrap around, so if you always take the head of the list you will cycle through all of the enharmonics.

type Layout = Vector.Vector Pitch.Semi Source #

The number of chromatic intervals between each Pitch.PitchClass, starting from 0, as returned by scale_read. The length is the number of degrees per octave. A diatonic-only scale will have all 1s, and a scale without octaves has an empty layout.

This is analogous to Layout, but is intended to be a minimal implementation that all scales can export, without having to support the full complexity of a chromatic scale.

Combined with scale_read and scale_show, I can use this to do math on scale degrees.

merge

testing

invalidate_damaged :: ScoreDamage -> Cache -> Cache Source #

Clear the damaged portions out of the cache so they will rederive.

Block damage also clears track caches that are on that block.