Artifact dd830f1c1c5b41c00336cd6950b7187070c0a66e9260396f86a5657fad739975:
- Executable file
r38/packages/mathml/ir2om.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 11243) [annotate] [blame] [check-ins using] [more...]
% Description: This module defines all functions necessary to pass from the % intermediate representation to OpenMath. They print out the % OpenMath expression on the screen. % % Date: 2 May 2000 % % Author: Luis Alvarez Sobreviela % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % The following tables are used by the functions in this file % % in order to map properly intermediate representation tokens % % to OpenMath elements and symbols. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% mmltypes!*:= '((complex_cartesian . (complex_cartesian_type)) (complex_polar . (complex_polar_type)) (constant . (constant_type)) (integer . (integer_type)) (list . (list_type)) (matrix . (matrix_type)) (rational . (rational_type)) (real . (real_type)) (set . (set_type))); % Maps MathML <interval> attribute values % to OpenMath symbols interval!*:= '((open . (interval_oo)) (closed . (interval_cc)) (open!-closed . (interval_oc)) (closed!-open . (interval_co))); % Maps MathML constants to OpenMath constant symbols % and their CDs. constantsOM!*:= '((!&ImaginaryI!; . (nums1 i)) (!&ExponentialE!; . (nums1 e)) (!&pi!; . (nums1 pi)) (!&NotANumber!; . (nums1 nan)) (!&gamma!; . (nums1 gamma)) (!&infin!; . (nums1 infinity)) (!&false!; . (logic1 false)) (!&true!; . (logic1 true))); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % The function ir2om starts the process of translating intermediate % % representation into OpenMath IR->OpenMath % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% symbolic procedure ir2om( elem ); begin; ind:=2; indent:=0; printout("<OMOBJ>"); indent!* t; objectOM( elem ); indent!* nil; printout("</OMOBJ>"); end; symbolic procedure objectOM(elem); begin scalar aa;; if PAIRP elem then << if (aa:=assoc(car elem, ir2mml!*)) then << apply(cadddr aa, list elem) >> else fnOM(elem); >> else basicOM(elem); end; symbolic procedure strOM(elem); begin; printout "<OMSTR> ";princ cadr elem; princ " </OMSTR>"; end; % Recieves an element which is not a list % and prints out OpenMath accordingly. symbolic procedure basicOM(elem); begin; if NUMBERP elem then << if FIXP elem then integerOM(elem); if FLOATP elem then floatOM(elem) >> else if IDP elem then variableOM(elem); end; % Prints out integers symbolic procedure integerOM(elem); begin; printout("<OMI> "); princ elem; princ " </OMI>" end; % Prints out decimal floats symbolic procedure floatOM(elem); begin; printout("<OMF "); princ "dec="""; princ elem; princ """/>"; end; % Prints out OpenMath variables symbolic procedure variableOM(elem); begin scalar aa; aa:=assoc(intern elem, constantsOM!*); if aa neq nil then << printout("<OMS "); princ "cd="""; princ cadr aa; princ """ "; princ "name="""; princ caddr aa; princ """/>"; >> else << if elem neq nil then << printout("<OMV "); princ "name="""; princ elem; princ """/>"; >> >>; end; % Prints out all OpenMath symbols of 1, 2, or more arguments % constructed by application. symbolic procedure naryOM(elem); begin scalar cd, name; name:=car elem; if name='var then name:='variance; cd := assoc(name, valid_om!*); if cd neq nil then cd:=cadr cd; if cadr elem neq nil then << if cadr elem = 'multiset then cd:=cadr elem; >>; printout "<OMA>"; indent:=indent+2; printout "<OMS cd="""; princ cd; princ """ name="""; princ name; princ """>"; multiOM(cddr elem); indent:=indent-2; printout "</OMA>"; end; symbolic procedure multiOM(elem); begin; if ((length elem)=1) then objectOM( car elem ) else <<objectOM car elem ; multiOM( cdr elem );>> end; % Prints out the OpenMath matrix_selector or % vector_selector symbols symbolic procedure selectOM(elem); begin scalar name; if caaddr elem ='matrix then name:='matrix_selector else name:='vector_selector; printout "<OMA>"; indent:=indent+2; printout "<OMS cd=""linalg3"" name="""; princ name; princ """/>"; multiOM(cdddr elem); objectOM caddr elem; indent:=indent-2; printout "</OMA>"; end; % Prints out elements which are % containers in MathML. symbolic procedure containerOM(elem); begin scalar cd, att, name; att:=cadr elem; name:=car elem; printout "<OMA>"; indent!* t; if name = 'vectorml then name:= 'vector; cd := cadr assoc(name, valid_om!*); if car elem = 'set and PAIRP att then << if intern cadr car att='multiset then cd:='multiset1; >>; if car elem = 'vectorml then name:= "vector"; if car elem = 'vectorml then elem:= 'vector . cdr elem; printout "<OMS cd="""; princ cd; princ """ name="""; princ name; princ """/>"; multiOM(cddr elem); indent!* nil; printout "</OMA>"; end; % Prints out OpenMath intervals symbolic procedure intervalOM(elem); begin scalar aa, att, name, cd; att:=cadr elem; name:=car elem; if name = 'lowupperlimit then <<name:='integer_interval; att:=nil; elem:=car elem . nil . cdr elem>>; cd := cadr assoc(name, valid_om!*); if att neq nil then << aa:=assoc(intern cadr car att, interval!*); name:=cadr aa; >>; printout "<OMA>"; indent!* t; printout "<OMS cd="""; princ cd; princ """ name="""; princ name; princ """/>"; multiOM(cddr elem); indent!* nil; printout "</OMA>"; end; % Prints matrices according to the definition % in CD linalg1 symbolic procedure matrixOM(elem); begin; printout "<OMA>"; indent!* t; printout "<OMS cd=""linalg1"" name=""matrix""/>"; matrixrowOM(cadddr elem); indent!* nil; printout "</OMA>"; end; symbolic procedure matrixrowOM(elem); begin; if elem neq nil then << printout "<OMA>"; indent!* t; printout "<OMS cd=""linalg1"" name=""matrixrow""/>"; multiOM(car elem); indent!* nil; printout "</OMA>"; matrixrowOM cdr elem; >>; end; % Prints out variables which posses % an attribute symbolic procedure ciOM(elem); begin; printout "<OMATTR>"; indent!* t; printout "<OMATP>"; indent!* t; printout "<OMS cd=""typmml"" name=""type"">"; printout "<OMS cd=""typmml"" name="""; princ assoc(intern cadr car cadr elem, mmltypes!*); princ cadr assoc(intern cadr car cadr elem, mmltypes!*); princ """>"; indent!* nil; printout "</OMATP>"; objectOM(caddr elem); indent!* nil; printout "</OMATTR>"; end; % Prints out constants such as pi, gamma etc... symbolic procedure numOM(elem); begin; printout "<OMA>"; indent!* t; printout "<OMS cd=""nums1"" name="""; princ car elem; princ """/>"; objectOM cadr elem; if car elem='based_integer then strOM cadr caddr elem else objectOM caddr elem; indent!* nil; printout "</OMA>"; end; symbolic procedure fnOM(elem); begin; printout "<OMA>"; indent!* t; printout "<OMATTR>"; indent!* t; printout "<OMATP>"; indent!* t; printout "<OMS cd=""typmml"" name=""type""/>"; printout "<OMS cd=""typmml"" name="""; princ "fn_type"; princ """/>"; indent!* nil; printout "</OMATP>"; objectOM car elem; indent!* nil; printout "</OMATTR>"; multiOM(cddr elem); indent!* nil; printout "</OMA>"; end; % Prints out partial differentiation expressions symbolic procedure partialdiffOM(elem); begin scalar cd, var, fun, name; cd := assoc(car elem, valid_om!*); if cd neq nil then cd:=cadr cd; name:=car elem; var:=cdr reverse cddr elem; fun:=car reverse elem; if length var = 1 then symbolsOM('diff . cdr elem); end; % Prints out elements such as sum, prod, diff and int. symbolic procedure symbolsOM(elem); begin scalar cd, var, fun, int, name; cd := assoc(car elem, valid_om!*); if cd neq nil then cd:=cadr cd; name:=car elem; var:=caddr elem; fun:=car reverse elem; if name neq 'diff then int:=cadddr elem; % This error states that a <sum> will not be translated to MathML if int neq nil then if car int = 'condition then errorML("<condition> tag not supported in MathML", 1); printout "<OMA>"; indent!* t; if int neq nil AND name='int then name:='defint; printout "<OMS cd="""; princ cd; princ """ name="""; princ name; princ """/>"; if int neq nil then objectOM int; lambdaOM ('lambda . nil . var . list fun); indent!* nil; printout "</OMA>"; end; % Prints out lambda expressions symbolic procedure lambdaOM(elem); begin scalar var, fun; var:= cadr caddr elem; fun:=car reverse elem; printout "<OMBIND>"; indent!* t; printout "<OMS cd=""fns1"" name=""lambda""/>"; printout "<OMBVAR>"; indent!* t; objectOM var; indent!* nil; printout "</OMBVAR>"; objectOM fun; indent!* nil; printout "</OMBIND>"; end; % Does not work... symbolic procedure semanticOM(elem); begin scalar sem; printout "<OMA>"; indent!* t; sem:=cadr cadr elem; list2string sem; multiOM cddr elem; indent!* nil; printout "</OMA>"; end; % Prints out limit expressions symbolic procedure limitOM(elem); begin scalar limit, fun, var, tendsto; var:=caddr elem; limit:=cadddr elem; fun:=car reverse elem; printout "<OMA>"; indent!* t; printout "<OMS cd=""limit1"" name=""limit""/>"; if car limit = 'lowlimit then << objectOM cadr limit; printout "<OMS cd=""limit1"" name=""null""/>" >>; if car limit = 'condition then << objectOM car reverse cadr limit; tendsto:= cadr car cadr cadr limit; printout "<OMS cd=""limit1"" name="""; princ tendsto; princ """/>" >>; lambdaOM ('limit . nil . var . list fun); indent!* nil; printout "</OMA>"; end; % Prints out OpenMath quantifiers symbolic procedure quantOM(elem); begin; if cadr reverse elem neq nil then errorML("condition tag not supported in MathML ", 2); printout "<OMBIND>"; indent!* t; printout "<OMS cd=""quant1"" name="""; princ car elem; princ """/>"; printout "<OMBVAR>"; indent!* t; bvarOM cddr elem; indent!* nil; printout "</OMBVAR>"; objectOM car reverse elem; indent!* nil; printout "</OMBIND>"; end; symbolic procedure bvarOM(elem); begin; if PAIRP car elem then if car car elem = 'bvar then <<objectOM cadr car elem; bvarOM cdr elem>>; end; symbolic procedure printout( str ); begin; terpri!* t; for i := 1:indent do << princ " " >>; princ str; end; % This is the function the user types to % translate MathML to OpenMath symbolic procedure mml2om(); begin scalar a;; a:=mml2ir(); terpri!* t; princ "Intermediate representation: "; terpri!* t; print a; ir2om a; end; lisp operator mml2om; end;