19
20:- module(plml_dcg,
21 [ term_mlstring/3 22 , term_texatom/2 23
24 , op(650,fy,'`') 25 , op(160,xf,'``') 26 , op(100,fy,@) 27
28 29 30 , op(210,xfy,.^) 31 , op(410,yfx,.*) 32 , op(410,yfx,./) 33 , op(410,xfy,.\) 34 , op(400,xfy,\) 35 , op(100,yfx,#) 36 , op(750,fy,\\) 37 , op(750,xfy,\\) 38 ]). 39
40
41:- multifile user:pl2ml_hook/2, pl2ml_hook/3.
195:- use_module(library(dcg_core)). 196:- use_module(library(dcg_codes)). 197
198:- set_prolog_flag(back_quotes,symbol_char). 199:- set_prolog_flag(double_quotes,codes). 200
201:- op(650,fy,`). % quoting things
202:- op(160,xf,``). % postfix transpose operator
203:- op(100,fy,@). % function handles
204:- op(200,xfy,.^). % array exponentiation
205:- op(410,yfx,.*). % array times
206:- op(410,yfx,./). % array division
207:- op(410,xfy,.\). % array reverse division
208:- op(400,xfy,\). % matrix reverse division
209:- op(100,yfx,#). % field indexing (note left-associativity)
210
211:- dynamic current_engine/1.
212
213
214%% pl2ml_hook(+I:engine,+X:term,-Y:ml_expr) is nondet.
215%% pl2ml_hook(+X:term,-Y:ml_expr) is nondet.
216% Clauses of pl2ml_hook/2 allow for extensions to the Matlab expression
217% language such that =|V[$X] = V[Y]|= if =|pl2ml_hook(X,Y)|=.
218pl2ml_hook(_,X,Y) :- pl2ml_hook(X,Y).
219
220/*
221 * DCG for term to matlab conversion
222 * the big problem with Matlab syntax is that you cannot always replace
223 * a name representing a value with an expression that reduces to that
224 * value. Eg
225 * X=magic(5), X(3,4)
226 * is ok, but
227 * (magic(5))(3,4)
228 * is not. Similarly x=@sin, x(0.5) but not (@sin)(0.5)
229 * This is really infuriating.
230 */
231
232
233% top level statement rules
234stmt(I,hide(A)) --> !, stmt(I,(A;nop)).
235stmt(I,(A;B)) --> !, stmt(I,A), ";", stmt(I,B).
236stmt(I,(A,B)) --> !, stmt(I,A), ",", stmt(I,B).
237stmt(I,A=B) --> !, ml_expr(I,A), "=", ml_expr(I,B).
238stmt(I,if(A,B)) --> !, "if ",ml_expr(I,A), ", ", stmt(I,B), ", end".
239stmt(I,if(A,B,C)) --> !, "if ",ml_expr(I,A), ", ", stmt(I,B), ", else ", stmt(I,C), ", end".
240stmt(I,Expr) --> !, ml_expr(I,Expr).
241
242
243%% ml_expr(+Id:ml_eng,+X:ml_expr(A))// is nondet.
244% Convert Matlab expression as a Prolog term to string representation.
245ml_expr(_,\X) --> !, phrase(X).
246ml_expr(I,$X) --> !, {pl2ml_hook(I,X,Y)}, ml_expr(I,Y).
247ml_expr(I,q(X)) --> !, q(stmt(I,X)).
248ml_expr(I,qq(X)) --> !, qq(stmt(I,X)).
249ml_expr(_,tq(X)) --> !, q(pl2tex(X)).
250ml_expr(_,atom(X)) --> !, atm(X).
251ml_expr(_,term(X)) --> !, wr(X). % this could be dangerous
252ml_expr(_,mat(X,Y)) --> !, "dbload(", loc(X,Y), ")".
253ml_expr(_,loc(L)) --> !, { L=mat(X,Y) }, loc(X,Y).
254ml_expr(I,mx(X)) --> !, ml_expr(I,$mx(X)). % punt these out to the pl2ml_hook, to be picked up plml_core
255ml_expr(I,ws(A)) --> !, ml_expr(I,$ws(A)). % ditto
256ml_expr(I,wsseq(A)) --> !, ml_expr(I,$ws(A)).
257ml_expr(_,noeval(_)) --> !, {fail}. % causes evaluation to fail.
258
259ml_expr(_,'Infinity') --> !, "inf".
260ml_expr(_,'Nan') --> !, "nan".
261
262ml_expr(I,A+B) --> !, "plus", args(I,A,B).
263ml_expr(I,A-B) --> !, "minus", args(I,A,B).
264ml_expr(I, -B) --> !, "uminus", args(I,B).
265ml_expr(I, +B) --> !, "uplus", args(I,B).
266ml_expr(I,A^B) --> !, "mpower", args(I,A,B).
267ml_expr(I,A*B) --> !, "mtimes", args(I,A,B).
268ml_expr(I,A/B) --> !, "mrdivide", args(I,A,B).
269ml_expr(I,A\B) --> !, "mldivide", args(I,A,B).
270ml_expr(I,A.^B)--> !, "power", args(I,A,B).
271ml_expr(I,A.*B)--> !, "times", args(I,A,B).
272ml_expr(I,A./B)--> !, "rdivide", args(I,A,B).
273ml_expr(I,A.\B)--> !, "ldivide", args(I,A,B).
274ml_expr(I,A>B) --> !, "gt",args(I,A,B).
275ml_expr(I,A<B) --> !, "lt",args(I,A,B).
276ml_expr(I,A>=B)--> !, "ge",args(I,A,B).
277ml_expr(I,A=<B)--> !, "le",args(I,A,B).
278ml_expr(I,A==B)--> !, "eq",args(I,A,B).
279ml_expr(I,A:B) --> !, range(I,A,B).
280
281ml_expr(_,[]) --> !, "[]".
282ml_expr(_,{}) --> !, "{}".
283ml_expr(I,[X]) --> !, "[", matrix(v,I,X), "]".
284ml_expr(I,[X|XX]) --> !, "[", ml_expr(I,X), seqmap(do_then_call(",",ml_expr(I)),XX), "]".
285ml_expr(I,{X}) --> !, "{", matrix(_,I,X), "}".
286ml_expr(_,atom_list(L)) --> !, "[", seqmap_with_sep(",",atm,L), "]".
287
288ml_expr(I, `B) --> !, q(stmt(I,B)).
289ml_expr(I,A#B) --> !, "getfield", args(I,A,q(B)).
290ml_expr(I,B``) --> !, "ctranspose", args(I,B).
291ml_expr(_,@B) --> !, "@", atm(B).
292ml_expr(I, \\B) --> !, "@()", ml_expr(I,B).
293ml_expr(I, A\\B) --> !, { term_variables(A,V), varnames(V) },
294 "@(", varlist(A), ")", ml_expr(I,B).
295ml_expr(I,lambda(A,B)) --> !, ml_expr(I,A\\B).
296ml_expr(I,thunk(B)) --> !, ml_expr(I, \\B).
297
298
304ml_expr(I,apply(A,B)) --> !, ml_expr(I,A), arglist(I,B).
305ml_expr(I,cref(A,B)) --> !, ml_expr(I,A), "{", clist(I,B), "}".
306
308ml_expr(I,arr($X)) --> !, { pl2ml_hook(I,X,L) }, ml_expr(I,arr(L)).
309ml_expr(I,arr(L)) --> !, { array_dims(L,D) }, array(D,I,L).
310ml_expr(I,arr(D,L)) --> !, array(D,I,L).
311ml_expr(I,arr(D,L,P)) --> !, array(D,I,P,L).
312ml_expr(I,atvector(L))--> !, "[", clist_at(I,L), "]".
313ml_expr(I,vector(L)) --> !, "[", clist(I,L), "]".
314ml_expr(I,cell(L)) --> !, "{", clist(I,L), "}".
315ml_expr(_,'$VAR'(N)) --> !, "p_", atm(N).
316
318ml_expr(_,hide(A)) --> {throw(ml_illegal_expression(hide(A)))}.
319ml_expr(_,(A;B)) --> {throw(ml_illegal_expression((A;B)))}.
320ml_expr(_,(A,B)) --> {throw(ml_illegal_expression((A,B)))}.
321ml_expr(_,A=B) --> {throw(ml_illegal_expression(A=B))}.
322
325ml_expr(_,A) --> {string(A)}, !, q(str(A)).
326ml_expr(_,A) --> {atomic(A)}, !, atm(A).
327ml_expr(I,F) --> {F=..[H|AX]}, atm(H), arglist(I,AX).
328
329ml_expr_with(I,Lambda,Y) --> {copy_term(Lambda,Y\\PY)}, ml_expr(I,PY).
330
331
333array_dims([X|_],M) :- !, array_dims(X,N), succ(N,M).
334array_dims(_,0).
343array(0,I,X) --> !, ml_expr(I,X).
344array(1,I,L) --> !, "[", seqmap_with_sep(";",ml_expr(I),L), "]".
345array(2,I,L) --> !, "[", seqmap_with_sep(",",array(1,I),L), "]".
346array(N,I,L) --> {succ(M,N)}, "cat(", atm(N), ",", seqmap_with_sep(",",array(M,I),L), ")".
347
348array(0,I,P,X) --> !, ml_expr_with(I,P,X).
349array(1,I,P,L) --> !, "[", seqmap_with_sep(";",ml_expr_with(I,P),L), "]".
350array(2,I,P,L) --> !, "[", seqmap_with_sep(",",array(1,I,P),L), "]".
351array(N,I,P,L) --> {succ(M,N)}, "cat(", atm(N), ",", seqmap_with_sep(",",array(M,I,P),L), ")".
352
353matrix(h,I,(A,B)) --> !, ml_expr(I,A), ",", matrix(h,I,B).
354matrix(v,I,(A;B)) --> !, ml_expr(I,A), ";", matrix(v,I,B).
355matrix(_,I,A) --> !, ml_expr(I,A).
356
357
359range(I,A,B:C) --> !, "colon", arglist(I,[A,B,C]).
360range(I,A,B) --> !, "colon", args(I,A,B).
365varlist((A,B)) --> !, atm(A), ",", varlist(B).
366varlist(A) --> !, atm(A).
371clist(_,[]) --> [].
372clist(I,[L1|LX]) --> ml_expr(I,L1), seqmap(do_then_call(",",ml_expr(I)),LX).
377clist_at(_,[]) --> [].
378clist_at(_,[L1|LX]) --> atm(L1), seqmap(do_then_call(",",atm),LX).
384arglist(I,X) --> "(", clist(I,X), ")".
392args(I,X,Y) --> "(", ml_expr(I,X), ",", ml_expr(I,Y), ")".
393args(I,X) --> "(", ml_expr(I,X), ")".
398atm(A,C,T) :- format(codes(C,T),'~w',[A]).
399
400varnames(L) :- varnames(1,L).
401varnames(_,[]).
402varnames(N,[TN|Rest]) :-
403 atom_concat(p_,N,TN), succ(N,M),
404 varnames(M,Rest).
409term_mlstring(I,Term,String) :- phrase(stmt(I,Term),String), !.
413term_texatom(Term,Atom) :- phrase(pl2tex(Term),String), !, atom_codes(Atom,String).
414
415
416
431loc(X,Y) --> "'", wr(X),"|",atm(Y), "'".
437pl2tex(A=B) --> !, pl2tex(A), "=", pl2tex(B).
438pl2tex(A+B) --> !, pl2tex(A), "+", pl2tex(B).
439pl2tex(A-B) --> !, pl2tex(A), "-", pl2tex(B).
440pl2tex(A*B) --> !, pl2tex(A), "*", pl2tex(B).
441pl2tex(A.*B) --> !, pl2tex(A), "*", pl2tex(B).
442pl2tex(A/B) --> !, pl2tex(A), "/", pl2tex(B).
443pl2tex(A./B) --> !, pl2tex(A), "/", pl2tex(B).
444pl2tex(A\B) --> !, pl2tex(A), "\\", pl2tex(B).
445pl2tex(A.\B) --> !, pl2tex(A), "\\", pl2tex(B).
446pl2tex(A^B) --> !, pl2tex(A), "^", brace(pl2tex(B)).
447pl2tex(A.^B) --> !, pl2tex(A), "^", brace(pl2tex(B)).
448pl2tex((A,B))--> !, pl2tex(A), ", ", pl2tex(B).
449pl2tex(A;B)--> !, pl2tex(A), "; ", pl2tex(B).
450pl2tex(A:B)--> !, pl2tex(A), ": ", pl2tex(B).
451pl2tex({A}) --> !, "\\{", pl2tex(A), "\\}".
452pl2tex([]) --> !, "[]".
453pl2tex([X|XS]) --> !, "[", seqmap_with_sep(", ",pl2tex,[X|XS]), "]".
454
455pl2tex(A\\B) --> !, "\\lambda ", pl2tex(A), ".", pl2tex(B).
456pl2tex(@A) --> !, "@", pl2tex(A).
457pl2tex(abs(A)) --> !, "|", pl2tex(A), "|".
458pl2tex(A) --> {atomic(A)}, escape_with(0'\\,0'_,at(A)).
459pl2tex(A) -->
460 {compound(A), A=..[H|T] },
461 pl2tex(H), paren(seqmap_with_sep(", ",pl2tex,T))
Matlab DCG
Types
ml_stmt - A Matlab statement
Matlab expression syntax
The Matlab expression syntax adopted by this module allows Prolog terms to represent or denote Matlab expressions. Let T be the domain of recognised Prolog terms (corresponding to the type ml_expr), and M be the domain of Matlab expressions written in Matlab syntax. Then V : T->M is the valuation function which maps Prolog term X to Matlab expression V[X]. These are some of the constructs it recognises:
Constructs valid only in top level statements, not subexpressions:
Things that look and work like Matlab syntax (more or less):
Things that do not look like Matlab syntax but provide standard Matlab features:
Referencing different value representations.
Tricky bits.
Things to bypass default formatting
All other Prolog atoms are written using write/1, while other Prolog terms are assumed to be calls to Matlab functions named according to the head functor. Thus V[ <head>( <arg1>, <arg2>, ...) ] = <head>(V[<arg1>, V[<arg2>], ...).
There are some incompatibilities between Matlab syntax and Prolog syntax, that is, syntactic structures that Prolog cannot parse correctly:
save('x','Y')
" can be written as "save x Y" in Matlab, but in Prolog, you must use function call syntax with quoted arguments: save(`x,`'Y').ctranspose(x)
".cref(x,1,2)
".mat(I)
andtmp(I)
as types to include engine Id.Clarify relationship between return values and valid Matlab denotation.
Reshape/2 array representation:
reshape([ ... ],Size)
Expression language:arr(Vals,Shape,InnerFunctor)
- allows efficient representation of arrays of arbitrary things. Will require more strict nested list form.Deprecate old array(Vals::Type) and cell(Vals::Type) left-value syntax.
Remove I from ml_expr//2 and add to mx type? */