1/* Part of plumdrum 2 Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL) 3 4 This program is free software; you can redistribute it and/or 5 modify it under the terms of the GNU Lesser General Public License 6 as published by the Free Software Foundation; either version 2 7 of the License, or (at your option) any later version. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 GNU Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17*/ 18 19:- module(humdrum_world, [ assert_humdrum/3, retract_humdrum/1, with_kern_module/4 ]). 20 21:- use_module(library(dcg_core)). 22:- use_module(library(humdrum)). 23:- use_module(library(data/env)). 24 25% :- meta_predicate with_kern_module(+,+,+,0). 26:- module_transparent with_kern_module/4. 27 28humdrum_predicates( 29 [ spine/4 % spine( xinterp, spine, record, record). 30 , ref/3 % ref(refcode, lang, text). 31 , duration/1 % duration( duration). 32 , num_spines/1 % num_spines( natural). 33 , num_records/1 % num_records( natural). 34 35 , time/2 % time( time, record). 36 , duration/2 % duration( duration, record). 37 , new_spine/2 % new_spine( spine, record). 38 , init_spine/3 % init_spine( xinterp, spine, record). 39 , change_spine/5 % change_spine( xinterp, xinterp, spine, spine, record). 40 , term_spine/3 % term_spine( xinterp, spine, record). 41 , join_spines/4 % join_spines( spine, spine, spine, record). 42 , split_spines/4 % split_spines( spine, spine, spine, record). 43 44 , interp/3 % interp( interp, spine, record). 45 , data/3 % data( data, spine, record). 46 ]). 47 48:- use_module(library(apply_macros)). 49:- use_module(library(dcg_macros)).
55retract_humdrum(Mod) :-
56 humdrum_predicates(Preds),
57 Mod:maplist(abolish,Preds).The newly created module contains a number of predicates which can be used to access information in the Humdrum object. They can all be used with any instantiation pattern. The predicates are:
duration( D:rational)num_spines( N:natural)num_records( N:natural)ref( R:refcode, L:lang, T:text)time( T:rational, R:natural)data( D, S:spine, R:record)spine( X:xinterp, S:spine, R1:natural, R2:natural)duration( -D:rational, +R:natural)new_spine( -S:spine, -R:natural)init_spine( X:xinterp, S:spine, R:record)change_spine( xinterp, xinterp, spine, spine, record)term_spine( X:xinterp, S:spine, R:record)join_spines( S1:spine, S2:spine, S3:spine, R:record)split_spines( S1:spine, S2:spine, S3:spine, R:record)interp( I:interp, S:spine, R:record)104assert_humdrum(BaseMod,Recs,Mod) :- 105 Mod:use_module(BaseMod), 106 declare_predicates_in(Mod), 107 with_env( 108 ins_key(module,Mod) >> 109 run_records(Recs,N,R,T) >> 110 module_assert(num_spines(N)) >> 111 module_assert(num_records(R)) >> 112 module_assert(duration(T)) 113 ), 114 T1 is float(T), 115 debug(humdrum,'% spines:~w ~15| records:~w ~30| time:~w\n',[N,R,T1]). 116% format('\n------------------------------\n'), 117% format('~tspines consumed ~20|: ~w.\n',[N]), 118% format( '~telapsed time ~20|: ~w.\n',[T1]), 119% format( '~tnumber of records ~20|: ~w.\n',[R]). 120 121 122declare_predicates_in(Mod) :- 123 humdrum_predicates(Preds), 124 Mod:maplist(dynamic,Preds). 125 126run_records(Recs,N,R,T) --> 127 ins_keys( 128 [ (time,0) 129 , (timebase,none) 130 , (tied,[]), (pending,[]) 131 , (numspines,0) 132 , (spines,[]), (records,0) 133 ]), 134 135 seqmap(count(exec),Recs), 136 137 sel_keys( 138 [ (numspines,N) 139 , (pending,_), (tied,_) 140 , (timebase,_), (time,T) 141 , (spines,_), (records,R) 142 ]). 143 144count(P,X,S1,S3) :- 145 with_key(records,succ,S1,S2), 146 catch( call(P,X,S2,S3), Ex, 147 ( get_key(records,N,S2,_), 148 throw(level2_parse_error(N,Ex)) 149 )). 150 151prologmessage(level2_parse_error(Line,Ex)) --> 152 ['Level 2 parse error on record ~d'-[Line], nl], 153 prolog:message(Ex). 154 155exec(comment(_)) --> []. 156exec(comments(_)) --> []. 157 158exec(ref(Prop,Lang,Val)) --> module_assert(ref(Prop,Lang,Val)). 159 160exec(xinterps(X)) --> 161 get_key(spines,R1), 162 apply_xinterps(X,x_pathop,R1,R2), 163 set_key(spines,R2). 164 165exec(pathops(X)) --> 166 get_key(spines,R1), 167 apply_pathops(X,x_pathop,R1,R2), 168 set_key(spines,R2). 169 170exec(interps(X)) --> 171 get_key(spines,S1), 172 ( {X=[X1|_]}, global_interp(X1,X), ! 173 ; seqmap(local_interp,X,S1,S2), 174 set_key(spines,S2) 175 ). 176 177exec(data(X)) --> 178 get_key(spines,Spines), 179 get_key(time,T), 180 record_assert(time(T)), 181 seqmap(assert_spine_data,Spines,X), 182 183 ( key_val( timebase, delta(DT)) -> nop 184 ; with_key( pending, delta_time(Spines,X,DT)), 185 record_assert(duration(DT)) 186 ), 187 with_key( time, add_dur(DT)). 188 189add_dur(_,none,none) :- !. 190add_dur(X,Y,Z) :- Z is Y+X. 191 192 193delta_time(Spines,Events,DT,P1,P2) :- 194 maplist(spine_rep,Spines,Reps), 195 slice_duration(Reps,Events,DT,P1,P2). 196 197global_interp(tb(TB),All) --> 198 { maplist(=(tb(TB)),All) -> true 199 ; throw(humdrum_semantics(timebase_mismatch(All))) 200 }, 201 {recip_to_rational(TB,DT)}, 202 set_key(timebase,delta(DT)). 203 204local_interp(Interp,S,S) --> spine_assert(S,interp(Interp)). 205 206module_assert(Fact) --> 207 get_key(module,Mod), 208 { assert(Mod:) }. 209 210record_assert(Fact) --> 211 get_key(records,R), 212 {add_arg(R,Fact,Fact1)}, 213 module_assert(Fact1). 214 215spine_assert(sp(N,_,_),Fact) --> 216 {add_arg(N,Fact,Fact1)}, 217 record_assert(Fact1). 218 219assert_spine_data(S,X) --> spine_assert(S,data(X)). 220assert_spine_rep(S) --> { spine_rep(S,R) }, spine_assert(S,xinterp(R)). 221 222 223% ------------------------------------------------ 224 225 226next_spine(N) --> with_key(numspines, (succ, get(N))). 227 228spine_rep(sp(_,R,_),R). 229 230% path op token to spine operation mapping 231x_pathop( new(sp(N,null,null))) --> 232 next_spine(N), 233 record_assert(new_spine(N)). 234 235x_pathop( init(R,sp(N,R,I))) --> 236 next_spine(N), 237 get_key(records,I), 238 record_assert(init_spine(R,N)). 239 240x_pathop( term(sp(N,R,I))) --> 241 get_key(records,J), {succ(JJ,J)}, 242 record_assert(term_spine(R,N)), 243 ( {R\=null} 244 -> module_assert(spine(R,N,I,JJ)) 245 ; nop). 246 247x_pathop( chrep(R,sp(N,R0,I),sp(M,R,J))) --> 248 next_spine(M), 249 get_key(records,J), {succ(JJ,J)}, 250 record_assert(change_spine(R0,R,N,M)), 251 ( {R0\=null} 252 -> module_assert(spine(R0,N,I,JJ)) 253 ; nop). 254 255x_pathop( join(sp(N1,R,I1),sp(N2,R,I2),sp(M,R,J))) --> 256 next_spine(M), 257 get_key(records,J), {succ(JJ,J)}, 258 record_assert(join_spines(N1,N2,M)), 259 ( {R\=null} 260 -> module_assert(spine(R,N1,I1,JJ)), 261 module_assert(spine(R,N2,I2,JJ)) 262 ; nop). 263 264x_pathop( split(sp(N,R,I),sp(M1,R,J),sp(M2,R,J))) --> 265 next_spine(M1), next_spine(M2), 266 get_key(records,J), {succ(JJ,J)}, 267 record_assert(split_spines(N,M1,M2)), 268 ( {R\=null} 269 -> module_assert(spine(R,N,I,JJ)) 270 ; nop). 271 272add_arg(X,T1,T2) :- 273 T1=..L1, append(L1,[X],L2), 274 T2=..L2. 275 276with_kern_module(File,Enc,Mod,Goal) :- 277 context_module(CM), 278 hum_read(File,Enc,Recs), 279 in_temporary_module(Mod, 280 assert_humdrum(library(humdrum/kern_rules),Recs,Mod), 281 @(Goal,CM)). 282 % Mod='tmp$mod', 283 % setup_call_cleanup( 284 % assert_humdrum(library(humdrum/kern_rules),Recs,Mod), 285 % Goal, retract_humdrum(Mod)).