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, [ 20 hum_read/2 % Load a Humdrum file to list of records 21 , hum_read/3 % with selectable encoding 22 , hum_has/3 % Reference information for list of records 23 , hum_prop_desc/2 % Description of reference property 24 25 , apply_xinterps/6 % stateful 26 , apply_pathops/6 % stateful version 27 , event_duration/3 28 , beats_to_secs/3 29 , recip_to_rational/2 30 , slice_duration/5 31 ]). 32 33:- meta_predicate apply_pathops(+,3,?,?,?,?). 34:- meta_predicate apply_xinterps(+,3,?,?,?,?).

Humdrum file format reading

This module provides facilities for reading and decoding Humdrum files. It provides an extensible framework whereby new exclusive interpretation types can be added by adding clauses to the multifile predicates hum_data_hook//2, hum_interp_hook//1 and hum_duration_hook/3.

Types:


record --> ref(atom,atom,atom)
         ; comment(atom)
         ; comment(list(atom))
         ; xinterps(list(interp))
         ; interps(list(tandem))
         ; pathops(list(pathop))
         ; data(list(data))
         .

interp ---> null ; x(xinterp) ; t(list(code)) ; p(pathop).

pathop ---> null  ; term ; new
          ; split ; join ; exch
          ; init(xinterp)
          ; chx(xinterp).

spine_ed(A) == pred( path_action(A), S, S).

path_action(A) ---> term(A)
                  ; split(A,A,A)
                  ; join(A,A,A)
                  ; new(A)
                  ; init(xinterp,A)
                  ; chx(xinterp,A)
                  .

75:- dynamic current_humdrum_file/3. 76:- multifile 77 hum_interp_hook//1 78 , hum_data_hook//2 79 , hum_duration_hook/3 . 81 82:- use_module(library(dcg_core)). 83:- use_module(library(dcg_pair)). 84:- use_module(library(dcg_codes)). 85:- use_module(library(dcg_macros)). 86:- use_module(library(fileutils)). 87:- use_module(library(humdrum/humutils)). 88:- use_module(library(humdrum/refcodes)). 89:- use_module(library(humdrum/interps)). 90:- use_module(library(humdrum/reps)). 91:- use_module(library(apply_macros)). 92 93:- set_prolog_flag(double_quotes,codes).

125hum_read(File,Records2) :- hum_read(File,iso_latin_1,Records2). 126hum_read(File,Enc,Records2) :- 127 with_stream(Str, open(File,read,Str,[encoding(Enc)]), read_stream_to_codes(Str,Codes)), 128 catch(( 129 humdrum(Records1,0-Codes,NumLines-[]), !, % level 1 parse 130 debug(humdrum,'% Read ~w lines from ~w.\n',[NumLines,File]), 131 seqmap(nofail(count(humdrum)),Records1,Records2, 0-[], _-[]), ! 132 ), % level 2 parse 133 Ex, throw(error_in_file(File,Ex)) 134 ). 135 136 137nofail(P,A,B,C,D) :- 138 ( catch(call(P,A,B,C,D),Ex,throw(exception(Ex,call(P,A,B,C,D)))) -> true 139 ; throw(failed(call(P,A,B,C,D))) 140 ).

150hum_prop_desc(Prop,Desc) :- refcode(Prop,_,Desc). 151 152 153 154count(P) --> \> P, \< succ. 155count(P,X) --> \> call(P,X), \< succ. 156count(P,X,Y) --> \> call(P,X,Y), \< succ. 157 158% --------------- humdrum file -------------------------------------------- 159 160% Level 1 parse - transforms list of charactes to list of records 161% which are terms, one of: 162% comment(list(char)) ~ a single string 163% comments(list(list(char))) ~ one string per spine 164% interps(list(list(char))) ~ interpretations, one per spine 165% data(list(list(char))) ~ data tokens, one per spine 166% 167% The top level rules assume that the DCG state is (LineNum,DLState) 168% where DLState the usual DCG difference list state thingy. It 169% pushes a new variable into the state to keep track of the current 170% number of spines, which must go from zero to zero. 171humdrum(Records) --> records(Records). 172 173eol([],[]). 174 175% read records while keeping track of the line number 176% in the dcg state: (LineNumber, DLState) 177records([L1|LX]) --> \> (rec(L1), cr), !, \< succ, records(LX). 178records([L1]) --> \> (rec(L1), eol), !, \< succ, 179 {print_message(warning,humdrum_syntax(end_of_file))}. 180 181records([]) --> \> eol. 182records(_) --> 183 \< (succ,get(LineNumber)), 184 \> charsex(text,[],"\n",Codes), 185 { throw(humdrum_syntax(unknown(LineNumber,Codes))) }. 186 187rec(comment(A)) --> peek("!!"), !, global_comment(A). 188rec(comments(A)) --> peek("!"), !, for_spines(local_comment,A). 189rec(interps(A)) --> peek("*"), !, for_spines(interp,A). 190rec(data(A)) --> for_spines(token,A). 191 192for_spines(P,[A|AX]) --> call(P,A), for_spines1(P,AX). 193for_spines1(P,[A|AX]) --> tb, !, call(P,A), for_spines1(P,AX). 194for_spines1(_,[]) --> []. 195 196global_comment(A) --> "!!", charsex(text,[],"\n",A). 197local_comment(A) --> "!", charsex(text,"!","\t\n",A). 198 199token(null) --> ".". 200token(A) --> {A=[_|_]}, charsex(graph,"!*."," \t\n",A). 201token(s(A)) --> {A=[_,_|_]}, seqmap_with_sep(" ",subtoken,A). 202subtoken(A) --> {A=[_|_]}, charsex(graph,"!*"," \t\n",A). 203interp(A) --> "*", int1(A). 204 205int1(x(A)) --> "*", !, charsex(graph,[],"\t\n",Codes), {atom_codes(A,Codes)}. 206int1(t(A)) --> {A=[_|_]}, charsex(text,"*+-v^x","\t\n",A). 207int1(p(A)) --> [C],{str_pathop([C],A)}. 208int1(null) --> charsex(graph,"*","\t\n",[]). 209 210str_pathop("-",term). 211str_pathop("+",new). 212str_pathop("^",split). 213str_pathop("x",exch). 214str_pathop("v",join). 215 216 217% ----------------------------------------------------------------------- 218% Level 2 parse - transforms list of records to list of parsed records. 219% 220% The parse checks that the spine structure is properly adhered to 221% and fails if the wrong number of spines is encountered at any point. 222 223 224humdrum(comment(A), ref(Prp,Lng,Vl)) --> {phrase(ref(Prp,Lng,Codes),A)}, !, {atom_codes(Vl,Codes)}. 225humdrum(comment(A), comment(B)) --> {atom_codes(B,A)}. 226humdrum(comments(A), comments(B)) --> map_spines(atom_codes,B,A). 227humdrum(data(A), data(B)) --> once(map_spines_with_reps(data,A,B)). 228humdrum(interps(A), interps(B)) --> {maplist(tandem,A)}, !, map_spines_with_reps(tinterp,A,B). 229humdrum(interps(A), xinterps(A)) --> {memberchk(x(_),A)}, !, apply_xinterps(A). 230humdrum(interps(A), pathops(B)) --> {memberchk(p(_),A)}, !, apply_pathops(A,B). 231 232 233 234% ............... reference comments ............................. 235ref(Code,Lang,Text) --> 236 "!", !, charsex(text,[],":@",CC), lang(Lang), 237 ":", charsex(space,[],[],_), charsex(text," \t",[],Text), 238 {atom_codes(Code1,CC), upcase_atom(Code1,Code)}. 239 240% NB. according to the spec, language codes should have 3 characters, but 241% in practice, many seem to have only two. 242lang(def) --> []. 243lang(pri-Lang) --> "@@", charsex(text,[],":@",L), {atom_codes(Lang,L)}. 244lang(sec-Lang) --> "@", charsex(text,[],":@",L), {atom_codes(Lang,L)}. 245% ............... interpretations ....................... 246 247% check that interpretation is null or tandem only 248tandem(null). 249tandem(t(_)). 250 251% check that interpreation is null or path op only 252% and convert to stripped path op 253pathop(null,null). 254pathop(p(Op),Op). 255 256% ............... spines and paths and x interps ....................... 257 258% apply exclusive interpretations to current spine list 259apply_xinterps(Ints,SX1,SX2) :- apply_xinterps(Ints,run_pathop,SX1,SX2,[],[]). 260 261% apply path operation interpretations to current spine list 262% and create list of path-ops for later use. 263apply_pathops(Ints,Ops,L1,L2) :- 264 map_spines(pathop,Ints,Ops,L1,L1), 265 apply_pathops(Ops,run_pathop,L1,L2,[],[]). 266 267 268% run path operation with state X. 269run_pathop( term(_), X, X). 270run_pathop( new(null(_)), X, X). 271run_pathop( split(R,R,R), X, X). 272run_pathop( join(R,R,R), X, X). 273run_pathop( init(R,R), X, X). 274run_pathop( chx(R,_,R), X, X). 275 276% ............... data tokens ............................. 277 278 279data( _, null, null) :- !. 280data( null(_), _, _) :- !, throw(humdrum_semantics(no_xinter)). 281data( Rep, s(ST), sub(Terms)) :- maplist(data1(Rep),ST,Terms), !. 282data( Rep, s(ST), unknown(Rep,sub(ST))) :- !. 283data( Rep, Codes, tok(Term)) :- data1(Rep,Codes,Term), !. 284data( Rep, Codes, unknown(Rep,Codes)). 285 286data1( _, Codes, bar(Sigs)) :- peek("=",Codes,_), !, bar(Sigs,Codes,[]). 287data1( Rep, Codes, Term) :- hum_data_hook(Rep,Term,Codes,[]). 288 289% ............... tandem interpretations ............................. 290 291tinterp( _, null, null) :- !. 292tinterp( Rep, t(Codes), Term) :- atom(Rep), tinterp(Codes,Term). 293 294tinterp( Codes, Term) :- hum_interp_hook(Term,Codes,[]), !. 295tinterp( Codes, unknown(Codes)). 296 297map_spines_with_reps(P,A,B,SX,SX) :- maplist(P,SX,A,B). 298map_spines(P,A,B,S,S) :- length(S,N), length(A,N), maplist(P,A,B). 299 300% --------------- spine operations --------------------------

307apply_xinterps(Ints,P,[],SX) --> !, seqmap(init_rep(P),Ints,SX). 308apply_xinterps(Ints,P,SX1,SX2) --> !, seqmap(apply_rep(P),Ints,SX1,SX2). 309 310init_rep(P,x(R),S) --> call(P,init(R,S)). 311apply_rep(P,x(R),S1,S2) --> call(P,chx(R,S1,S2)). 312apply_rep(_,null,S,S) --> [].

317apply_pathops(Ops,Interp,L1,L2) --> once(edit_spines(Interp,no,Ops,L1,L2)). 318 319% --------------- paths ---------------------------------------------- 320 321% edit_spines(+E:spine_ed(A), +Ops:list(pathop(A)),+In:list(A),-Out:list(A))// is det. 322% 323% Relates the spine configurations before and after a path operation. 324% 325 326% exch can exchange non-adjactent spines 327% join can join multiple adjacent spines 328% State indicates the state of the current exchange operation if there is one, 329% and can be one of 330% * no - There is no exchange operation and one can occur. 331% * S1/S2 - spine S1 is being exchanged with S2 when it is found. 332% * ex - An exchange has happened and no more can occur. 333 334%:- index(edit_spines(0,1,1,0,0,0,0)). 335 336edit_spines(_, no, [],[],[]) --> []. 337edit_spines(_, ex, [],[],[]) --> []. 338 339edit_spines(P, Ex, [null |OX], [S|In], [S|Out]) --> edit_spines(P,Ex,OX,In,Out). 340edit_spines(P, Ex, [term |OX], [S|In], Out) --> call(P,term(S)), edit_spines(P,Ex,OX,In,Out). 341edit_spines(P, Ex, [split|OX], [S|In], [S1,S2|Out]) --> call(P,split(S,S1,S2)), edit_spines(P,Ex,OX,In,Out). 342edit_spines(P, Ex, [new |OX], [S|In], [S,T|Out]) --> call(P,new(T)), edit_spines(P,Ex,OX,In,Out). 343 344edit_spines(P, S/T,[exch |OX], [T|In], [S|Out]) --> edit_spines(P,ex,OX,In,Out). 345edit_spines(P, no, [exch, exch |OX], [S,T|In], [T,S|Out]) --> !, edit_spines(P,ex,OX,In,Out). 346edit_spines(P, no, [exch, Op |OX], [S,U|In], [T,V|Out]) --> edit_spines(P,S/T,[Op|OX],[U|In],[V|Out]). 347 348edit_spines(_, no, [join],[S1],[S1]) --> []. 349edit_spines(_, ex, [join],[S1],[S1]) --> []. 350edit_spines(P, Ex, [join,join|OX],[S,T|In],[U|Out]) --> !, call(P,join(S,T,V)), 351 edit_spines(P,Ex,[join|OX],[V|In],[U|Out]). 352edit_spines(P, Ex, [join,Op |OX],[S|In],[S|Out]) --> edit_spines(P,Ex,[Op|OX],In,Out). 353 354 355 356% ----------------- DURATIONS --------------------

369slice_duration(Reps,Events,DT1,P1,P2) :- 370 events_durations(Reps,Events,Durations), 371 append(Durations,P1,P1a), 372 minlist(P1a,none,DT), 373 ( DT=none -> P2=P1, DT1=0 374 ; filter_durations(DT,P1a,P2), DT1=DT 375 ). 376 377events_durations([],[],[]). 378events_durations([R|RX],[E|EX],DX1) :- 379 (event_duration(R,E,Dur) -> DX1=[Dur|DX] ; DX1=DX), 380 events_durations(RX,EX,DX). 381 382minlist([],T,T). 383minlist([none|XT],T1,T3) :- !, minlist(XT,T1,T3). 384minlist([X|XT],none,T) :- !, minlist(XT,X,T). 385minlist([X|XT],T1,T3) :- (X<T1 -> T2=X; T2=T1), minlist(XT,T2,T3). 386 387filter_durations(_,[],[]). 388filter_durations(DT,[D1|DX1],DDX2) :- 389 D2 is D1-DT, 390 (D2>0 -> DDX2=[D2|DX2]; DDX2=DX2), 391 filter_durations(DT,DX1,DX2). 392 393 394 395% ------------------ MESSAGES -------------------- 396 397prolog:message(humdrum_syntax(dot_null_interp)) --> 398 [ 'Use of "." as null interpretation - use "*" instead.'-[], nl]. 399 400prolog:message(humdrum_syntax(end_of_file)) --> 401 [ 'Last line of Humdrum file not properly terminated.'-[], nl]. 402 403prolog:message(humdrum_syntax(unknown(LineNum,Codes))) --> 404 [ 'Humdrum syntax error on line ~w:'-[LineNum], nl, '~s'-[Codes], nl]. 405 406prolog:message(error_in_file(File,Error)) --> 407 [ 'Error in file ~w'-[File], nl], 408 prolog:message(Error). 409 410prolog:message(failed(Goal)) --> 411 [ 'Goal not allowed to fail: ~q'-[Goal], nl]. 412 413prolog:message(exception(Ex,Goal)) --> 414 [ 'While calling ~q'-[Goal], nl], 415 prolog:message(Ex)