omparser.y 66 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519
  1. /*
  2. Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
  3. All rights reserved.
  4. Redistribution and use in source and binary forms, with or without
  5. modification, are permitted provided that the following conditions are
  6. met:
  7. - Redistributions of source code must retain the above copyright
  8. notice, this list of conditions and the following disclaimer.
  9. - Redistributions in binary form must reproduce the above copyright
  10. notice, this list of conditions and the following disclaimer in
  11. the documentation and/or other materials provided with the
  12. distribution.
  13. - Neither the name of The Numerical ALgorithms Group Ltd. nor the
  14. names of its contributors may be used to endorse or promote products
  15. derived from this software without specific prior written permission.
  16. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  17. IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  18. TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  19. PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
  20. OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  21. EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  22. PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES-- LOSS OF USE, DATA, OR
  23. PROFITS-- OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  24. LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  25. NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  26. SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27. */
  28. %{
  29. /* Note that BISON, from version 1.24 onwards, permits arbitrary use
  30. * of its output file despite the parser skeleton being under GPL not
  31. * LGPL. See the comments in the BISON output, and be careful to avoid
  32. * earlier releases of BISON.
  33. */
  34. #include <assert.h>
  35. #include <stdio.h>
  36. #include <stdlib.h>
  37. #include <stdarg.h>
  38. #include <string.h>
  39. #include <math.h>
  40. #include <float.h>
  41. #include <malloc.h>
  42. #include "machine.h"
  43. #include "tags.h"
  44. #include "cslerror.h"
  45. #include "externs.h"
  46. #include "entries.h"
  47. #include "arith.h"
  48. #include "read.h"
  49. #include <OM.h>
  50. #include <OMconn.h>
  51. #include "openmath.h"
  52. #define YYSTYPE Lisp_Object
  53. #define StrToLspM(S) qcar(Lmv_list(C_nil, Lintern(C_nil, make_string(S))))
  54. #define MkUndefSymM(x) make_undefined_symbol(x)
  55. /* Enable parser debugging. */
  56. #define YYDEBUG 0
  57. /* Prototypes for required parser interface functions. */
  58. int yyerror(char *);
  59. YYSTYPE yylex();
  60. /*
  61. * External CCL functions.
  62. */
  63. extern char *get_string_data(Lisp_Object name, char *why, int32 *l);
  64. /* Some global variables (yuk!). */
  65. static Lisp_Object ldev;
  66. static Lisp_Object inObj;
  67. /* End of preamble. */
  68. %}
  69. /*----------------------------------------------------------------------------
  70. * Adding support for a new CD:
  71. *
  72. * 1. Add a new token declaration for each symbol in the CD.
  73. * 2. Add a new rule which matches any of the symbols from that CD; add that
  74. * rule as one of the alternate forms for the om_symbol rule. This rule
  75. * should be called om_newcd_symbol, where newcd is the name of the CD.
  76. * 3. Add a new rule for matching an application of any symbol from that CD,
  77. * with the appropriate arguments; this should be called something like
  78. * om_apply_newcd_inner, where newcd is as before. This rule should be
  79. * added as one of the alternate forms matched by the om_apply_inner rule.
  80. * Note that (obviously) this rule should omit symbols which are only valid
  81. * as binders.
  82. * 4. Add a new rule for matching a bind with any symbol from that CD as a
  83. * binder; this should be called something like om_bind_newcd_inner, where
  84. * newcd is as before. This rule should be added as one of the alternate
  85. * forms matched by the om_bind_inner rule. Note that (obviously) this rule
  86. * should omit symbols which are not valid as binders.
  87. * 5. Add the symbols from the new CD to the symTable list in the C code
  88. * section.
  89. * 6. Test it!
  90. */
  91. /*
  92. * TOKEN DECLARATIONS
  93. */
  94. /* Token for signalling a parsing error. */
  95. %token OM_YYERROR
  96. /* Tokens for OpenMath primitives. */
  97. %token OM_INT OM_FLOAT OM_BYTEARRAY OM_VAR OM_STRING OM_SYMBOL
  98. %token OM_APP OM_ENDAPP
  99. %token OM_ATP OM_ENDATP OM_ATTR OM_ENDATTR
  100. %token OM_BIND OM_ENDBIND OM_BVAR OM_ENDBVAR
  101. %token OM_ERROR OM_ENDERROR
  102. %token OM_OBJECT OM_ENDOBJECT
  103. /* Tokens for symbols from the alg1 CD. */
  104. %token OM_SYM_alg1_zero
  105. %token OM_SYM_alg1_one
  106. /* Tokens for symbols from the arith1 CD. */
  107. %token OM_SYM_arith1_abs
  108. %token OM_SYM_arith1_divide
  109. %token OM_SYM_arith1_gcd
  110. %token OM_SYM_arith1_lcm
  111. %token OM_SYM_arith1_minus
  112. %token OM_SYM_arith1_plus
  113. %token OM_SYM_arith1_power
  114. %token OM_SYM_arith1_product
  115. %token OM_SYM_arith1_root
  116. %token OM_SYM_arith1_sum
  117. %token OM_SYM_arith1_times
  118. %token OM_SYM_arith1_unary_minus
  119. /* Tokens for symbols from the arith2 CD. */
  120. %token OM_SYM_arith2_arg
  121. %token OM_SYM_arith2_inverse
  122. %token OM_SYM_arith2_times
  123. /* Tokens for symbols from the bigfloat CD. */
  124. %token OM_SYM_bigfloat1_bigfloat
  125. /* Tokens for symbols from the calculus1 CD. */
  126. %token OM_SYM_calculus1_defint
  127. %token OM_SYM_calculus1_diff
  128. %token OM_SYM_calculus1_int
  129. %token OM_SYM_calculus1_partialdiff
  130. /* Tokens for symbols from the complex1 CD. */
  131. %token OM_SYM_complex1_argument
  132. %token OM_SYM_complex1_complex_cartesian
  133. %token OM_SYM_complex1_complex_polar
  134. %token OM_SYM_complex1_conjugate
  135. %token OM_SYM_complex1_imaginary
  136. %token OM_SYM_complex1_real
  137. /* Tokens for symbols from the fns1 CD. */
  138. %token OM_SYM_fns1_domain
  139. %token OM_SYM_fns1_range
  140. %token OM_SYM_fns1_image
  141. %token OM_SYM_fns1_identity
  142. %token OM_SYM_fns1_inverse
  143. %token OM_SYM_fns1_lambda
  144. %token OM_SYM_fns1_left_compose
  145. /* Tokens for symbols from the fns2 CD. */
  146. %token OM_SYM_fns2_apply_to_list
  147. %token OM_SYM_fns2_kernel
  148. %token OM_SYM_fns2_right_compose
  149. /* Tokens for symbols from the integer1 CD. */
  150. %token OM_SYM_integer1_factorial
  151. %token OM_SYM_integer1_factorof
  152. %token OM_SYM_integer1_quotient
  153. %token OM_SYM_integer1_remainder
  154. /* Tokens for symbols from the interval1 CD. */
  155. %token OM_SYM_interval1_integer_interval
  156. %token OM_SYM_interval1_interval
  157. %token OM_SYM_interval1_interval_cc
  158. %token OM_SYM_interval1_interval_co
  159. %token OM_SYM_interval1_interval_oc
  160. %token OM_SYM_interval1_interval_oo
  161. /* Tokens for symbols from the limit1 CD. */
  162. %token OM_SYM_limit1_above
  163. %token OM_SYM_limit1_below
  164. %token OM_SYM_limit1_both_sides
  165. %token OM_SYM_limit1_limit
  166. %token OM_SYM_limit1_null
  167. /* Tokens for symbols from the linalg1 CD. */
  168. %token OM_SYM_linalg1_determinant
  169. %token OM_SYM_linalg1_matrix_selector
  170. %token OM_SYM_linalg1_vector_selector
  171. %token OM_SYM_linalg1_transpose
  172. %token OM_SYM_linalg1_outerproduct
  173. %token OM_SYM_linalg1_scalarproduct
  174. %token OM_SYM_linalg1_vectorproduct
  175. /* Tokens for symbols from the linalg2 CD. */
  176. %token OM_SYM_linalg2_matrix
  177. %token OM_SYM_linalg2_matrixrow
  178. %token OM_SYM_linalg2_vector
  179. /* Tokens for symbols from the linalg3 CD. */
  180. %token OM_SYM_linalg3_matrix
  181. %token OM_SYM_linalg3_matrixcolumn
  182. %token OM_SYM_linalg3_vector
  183. /* Tokens for symbols from the list1 CD. */
  184. %token OM_SYM_list1_list
  185. %token OM_SYM_list1_map
  186. %token OM_SYM_list1_suchthat
  187. /* Tokens for symbols from the list2 CD. */
  188. %token OM_SYM_list2_cons
  189. %token OM_SYM_list2_first
  190. %token OM_SYM_list2_rest
  191. /* Tokens for symbols from the logic1 CD. */
  192. %token OM_SYM_logic1_and
  193. %token OM_SYM_logic1_false
  194. %token OM_SYM_logic1_implies
  195. %token OM_SYM_logic1_not
  196. %token OM_SYM_logic1_or
  197. %token OM_SYM_logic1_true
  198. %token OM_SYM_logic1_xor
  199. %token OM_SYM_logic1_equivalent
  200. /* Tokens for symbols from the minmax1 CD. */
  201. %token OM_SYM_minmax1_max
  202. %token OM_SYM_minmax1_min
  203. /* The CD multiset1 is not supported. */
  204. /* Tokens for symbols from the nums1 CD. */
  205. %token OM_SYM_nums1_based_integer
  206. %token OM_SYM_nums1_e
  207. %token OM_SYM_nums1_gamma
  208. %token OM_SYM_nums1_i
  209. %token OM_SYM_nums1_infinity
  210. %token OM_SYM_nums1_NaN
  211. %token OM_SYM_nums1_pi
  212. %token OM_SYM_nums1_rational
  213. /* The quant1 CD is not supported. */
  214. /* Tokens for symbols from the relation1 CD. */
  215. %token OM_SYM_relation1_eq
  216. %token OM_SYM_relation1_geq
  217. %token OM_SYM_relation1_gt
  218. %token OM_SYM_relation1_leq
  219. %token OM_SYM_relation1_lt
  220. %token OM_SYM_relation1_neq
  221. %token OM_SYM_relation1_approx
  222. /* Tokens for symbols from the rounding1 CD. */
  223. %token OM_SYM_rounding1_ceiling
  224. %token OM_SYM_rounding1_floor
  225. %token OM_SYM_rounding1_trunc
  226. %token OM_SYM_rounding1_round
  227. /* Tokens for symbols from the setname1 CD. */
  228. %token OM_SYM_setname1_C
  229. %token OM_SYM_setname1_N
  230. %token OM_SYM_setname1_P
  231. %token OM_SYM_setname1_Q
  232. %token OM_SYM_setname1_R
  233. %token OM_SYM_setname1_Z
  234. /* Tokens for symbols from the set1 CD. */
  235. %token OM_SYM_set1_cartesian_product
  236. %token OM_SYM_set1_emptyset
  237. %token OM_SYM_set1_in
  238. %token OM_SYM_set1_intersect
  239. %token OM_SYM_set1_map
  240. %token OM_SYM_set1_notin
  241. %token OM_SYM_set1_notprsubset
  242. %token OM_SYM_set1_notsubset
  243. %token OM_SYM_set1_prsubset
  244. %token OM_SYM_set1_set
  245. %token OM_SYM_set1_setdiff
  246. %token OM_SYM_set1_size
  247. %token OM_SYM_set1_subset
  248. %token OM_SYM_set1_suchthat
  249. %token OM_SYM_set1_union
  250. /* The stats1 CD is not supported. */
  251. /* Tokens for symbols from the transc1 CD. */
  252. %token OM_SYM_transc1_arccos
  253. %token OM_SYM_transc1_arcsin
  254. %token OM_SYM_transc1_arctan
  255. %token OM_SYM_transc1_cos
  256. %token OM_SYM_transc1_cosh
  257. %token OM_SYM_transc1_cot
  258. %token OM_SYM_transc1_coth
  259. %token OM_SYM_transc1_csc
  260. %token OM_SYM_transc1_csch
  261. %token OM_SYM_transc1_exp
  262. %token OM_SYM_transc1_ln
  263. %token OM_SYM_transc1_log
  264. %token OM_SYM_transc1_sec
  265. %token OM_SYM_transc1_sech
  266. %token OM_SYM_transc1_sin
  267. %token OM_SYM_transc1_sinh
  268. %token OM_SYM_transc1_tan
  269. %token OM_SYM_transc1_tanh
  270. %token OM_SYM_transc1_arccosh
  271. %token OM_SYM_transc1_arccot
  272. %token OM_SYM_transc1_arccoth
  273. %token OM_SYM_transc1_arccsc
  274. %token OM_SYM_transc1_arccsch
  275. %token OM_SYM_transc1_arcsec
  276. %token OM_SYM_transc1_arcsech
  277. %token OM_SYM_transc1_arcsinh
  278. %token OM_SYM_transc1_arctanh
  279. /* The CD veccalc1 is not supported. */
  280. %%
  281. /*
  282. * PARSING RULES
  283. */
  284. om_whole_object:
  285. OM_OBJECT om_object OM_ENDOBJECT
  286. { $$ = $2; inObj = $2; YYACCEPT; }
  287. ;
  288. om_attributes:
  289. /* empty */
  290. | om_symbol_inner om_object om_attributes
  291. { /* TODO */ }
  292. ;
  293. om_variables:
  294. /* empty */
  295. { $$ = C_nil; }
  296. | om_variable om_variables
  297. { $$ = cons($1, $2); }
  298. ;
  299. om_object:
  300. om_integer
  301. | om_float
  302. | om_bytearray
  303. | om_variable
  304. | om_string
  305. | om_symbol
  306. | om_apply
  307. | om_bind
  308. /* | om_error */
  309. ;
  310. om_integer:
  311. OM_INT
  312. { $$ = $1; }
  313. | OM_ATTR OM_ATP om_attributes OM_ENDATP OM_INT OM_ENDATTR
  314. { $$ = $5; }
  315. ;
  316. om_float:
  317. OM_FLOAT
  318. { $$ = $1; }
  319. | OM_ATTR OM_ATP om_attributes OM_ENDATP OM_FLOAT OM_ENDATTR
  320. { $$ = $5; }
  321. ;
  322. om_bytearray:
  323. OM_BYTEARRAY
  324. { $$ = $1; }
  325. | OM_ATTR OM_ATP om_attributes OM_ENDATP OM_BYTEARRAY OM_ENDATTR
  326. { $$ = $5; }
  327. ;
  328. om_variable:
  329. OM_VAR
  330. { $$ = $1; }
  331. | OM_ATTR OM_ATP om_attributes OM_ENDATP OM_VAR OM_ENDATTR
  332. { $$ = $5; }
  333. ;
  334. om_string:
  335. OM_STRING
  336. { $$ = $1; }
  337. | OM_ATTR OM_ATP om_attributes OM_ENDATP OM_STRING OM_ENDATTR
  338. { $$ = $5; }
  339. ;
  340. om_symbol:
  341. om_symbol_inner
  342. { $$ = $1; }
  343. | OM_ATTR OM_ATP om_attributes OM_ENDATP om_symbol_inner OM_ENDATTR
  344. { $$ = $5; }
  345. ;
  346. om_symbol_inner:
  347. OM_SYMBOL
  348. | om_alg1_symbol
  349. | om_arith1_symbol
  350. | om_arith2_symbol
  351. | om_bigfloat1_symbol
  352. | om_calculus1_symbol
  353. | om_complex1_symbol
  354. | om_fns1_symbol
  355. | om_fns2_symbol
  356. | om_integer1_symbol
  357. | om_interval1_symbol
  358. | om_limit1_symbol
  359. | om_linalg1_symbol
  360. | om_linalg2_symbol
  361. | om_linalg3_symbol
  362. | om_list1_symbol
  363. | om_list2_symbol
  364. | om_logic1_symbol
  365. | om_minmax1_symbol
  366. | om_nums1_symbol
  367. | om_relation1_symbol
  368. | om_rounding1_symbol
  369. | om_setname1_symbol
  370. | om_set1_symbol
  371. | om_transc1_symbol
  372. ;
  373. om_alg1_symbol:
  374. OM_SYM_alg1_zero
  375. | OM_SYM_alg1_one
  376. ;
  377. om_arith1_symbol:
  378. OM_SYM_arith1_abs
  379. | OM_SYM_arith1_divide
  380. | OM_SYM_arith1_gcd
  381. | OM_SYM_arith1_lcm
  382. | OM_SYM_arith1_minus
  383. | OM_SYM_arith1_plus
  384. | OM_SYM_arith1_power
  385. | OM_SYM_arith1_product
  386. | OM_SYM_arith1_root
  387. | OM_SYM_arith1_sum
  388. | OM_SYM_arith1_times
  389. | OM_SYM_arith1_unary_minus
  390. ;
  391. om_arith2_symbol:
  392. OM_SYM_arith2_arg
  393. | OM_SYM_arith2_inverse
  394. | OM_SYM_arith2_times
  395. ;
  396. om_bigfloat1_symbol:
  397. OM_SYM_bigfloat1_bigfloat
  398. ;
  399. om_calculus1_symbol:
  400. OM_SYM_calculus1_defint
  401. | OM_SYM_calculus1_diff
  402. | OM_SYM_calculus1_int
  403. | OM_SYM_calculus1_partialdiff
  404. ;
  405. om_complex1_symbol:
  406. OM_SYM_complex1_argument
  407. | OM_SYM_complex1_complex_cartesian
  408. | OM_SYM_complex1_complex_polar
  409. | OM_SYM_complex1_conjugate
  410. | OM_SYM_complex1_imaginary
  411. | OM_SYM_complex1_real
  412. ;
  413. om_fns1_symbol:
  414. OM_SYM_fns1_identity
  415. | OM_SYM_fns1_inverse
  416. | OM_SYM_fns1_lambda
  417. | OM_SYM_fns1_left_compose
  418. | OM_SYM_fns1_domain
  419. | OM_SYM_fns1_range
  420. | OM_SYM_fns1_image
  421. ;
  422. om_fns2_symbol:
  423. OM_SYM_fns2_apply_to_list
  424. | OM_SYM_fns2_kernel
  425. | OM_SYM_fns2_right_compose
  426. ;
  427. om_integer1_symbol:
  428. OM_SYM_integer1_factorial
  429. | OM_SYM_integer1_factorof
  430. | OM_SYM_integer1_quotient
  431. | OM_SYM_integer1_remainder
  432. ;
  433. om_interval1_symbol:
  434. OM_SYM_interval1_integer_interval
  435. | OM_SYM_interval1_interval
  436. | OM_SYM_interval1_interval_cc
  437. | OM_SYM_interval1_interval_co
  438. | OM_SYM_interval1_interval_oc
  439. | OM_SYM_interval1_interval_oo
  440. ;
  441. om_limit1_symbol:
  442. OM_SYM_limit1_above
  443. | OM_SYM_limit1_below
  444. | OM_SYM_limit1_both_sides
  445. | OM_SYM_limit1_limit
  446. | OM_SYM_limit1_null
  447. ;
  448. om_linalg2_symbol:
  449. OM_SYM_linalg2_matrix
  450. | OM_SYM_linalg2_matrixrow
  451. | OM_SYM_linalg2_vector
  452. ;
  453. om_linalg3_symbol:
  454. OM_SYM_linalg3_matrix
  455. | OM_SYM_linalg3_matrixcolumn
  456. | OM_SYM_linalg3_vector
  457. ;
  458. om_linalg1_symbol:
  459. OM_SYM_linalg1_determinant
  460. | OM_SYM_linalg1_matrix_selector
  461. | OM_SYM_linalg1_vector_selector
  462. | OM_SYM_linalg1_transpose
  463. | OM_SYM_linalg1_outerproduct
  464. | OM_SYM_linalg1_scalarproduct
  465. | OM_SYM_linalg1_vectorproduct
  466. ;
  467. om_list1_symbol:
  468. OM_SYM_list1_list
  469. | OM_SYM_list1_map
  470. | OM_SYM_list1_suchthat
  471. ;
  472. om_list2_symbol:
  473. OM_SYM_list2_cons
  474. | OM_SYM_list2_first
  475. | OM_SYM_list2_rest
  476. ;
  477. om_logic1_symbol:
  478. OM_SYM_logic1_and
  479. | OM_SYM_logic1_false
  480. | OM_SYM_logic1_implies
  481. | OM_SYM_logic1_not
  482. | OM_SYM_logic1_or
  483. | OM_SYM_logic1_true
  484. | OM_SYM_logic1_xor
  485. | OM_SYM_logic1_equivalent
  486. ;
  487. om_minmax1_symbol:
  488. OM_SYM_minmax1_max
  489. | OM_SYM_minmax1_min
  490. ;
  491. om_nums1_symbol:
  492. OM_SYM_nums1_based_integer
  493. | OM_SYM_nums1_e
  494. | OM_SYM_nums1_gamma
  495. | OM_SYM_nums1_i
  496. | OM_SYM_nums1_infinity
  497. | OM_SYM_nums1_NaN
  498. | OM_SYM_nums1_pi
  499. | OM_SYM_nums1_rational
  500. ;
  501. om_relation1_symbol:
  502. OM_SYM_relation1_eq
  503. | OM_SYM_relation1_geq
  504. | OM_SYM_relation1_gt
  505. | OM_SYM_relation1_leq
  506. | OM_SYM_relation1_lt
  507. | OM_SYM_relation1_neq
  508. | OM_SYM_relation1_approx
  509. ;
  510. om_rounding1_symbol:
  511. OM_SYM_rounding1_ceiling
  512. | OM_SYM_rounding1_floor
  513. | OM_SYM_rounding1_trunc
  514. | OM_SYM_rounding1_round
  515. ;
  516. om_setname1_symbol:
  517. OM_SYM_setname1_C
  518. | OM_SYM_setname1_N
  519. | OM_SYM_setname1_P
  520. | OM_SYM_setname1_Q
  521. | OM_SYM_setname1_R
  522. | OM_SYM_setname1_Z
  523. ;
  524. om_set1_symbol:
  525. OM_SYM_set1_cartesian_product
  526. | OM_SYM_set1_emptyset
  527. | OM_SYM_set1_map
  528. | OM_SYM_set1_size
  529. | OM_SYM_set1_suchthat
  530. | OM_SYM_set1_in
  531. | OM_SYM_set1_intersect
  532. | OM_SYM_set1_notin
  533. | OM_SYM_set1_notprsubset
  534. | OM_SYM_set1_notsubset
  535. | OM_SYM_set1_prsubset
  536. | OM_SYM_set1_set
  537. | OM_SYM_set1_setdiff
  538. | OM_SYM_set1_subset
  539. | OM_SYM_set1_union
  540. ;
  541. om_transc1_symbol:
  542. OM_SYM_transc1_arccos
  543. | OM_SYM_transc1_arcsin
  544. | OM_SYM_transc1_arctan
  545. | OM_SYM_transc1_cos
  546. | OM_SYM_transc1_cosh
  547. | OM_SYM_transc1_cot
  548. | OM_SYM_transc1_coth
  549. | OM_SYM_transc1_csc
  550. | OM_SYM_transc1_csch
  551. | OM_SYM_transc1_exp
  552. | OM_SYM_transc1_ln
  553. | OM_SYM_transc1_log
  554. | OM_SYM_transc1_sec
  555. | OM_SYM_transc1_sech
  556. | OM_SYM_transc1_sin
  557. | OM_SYM_transc1_sinh
  558. | OM_SYM_transc1_tan
  559. | OM_SYM_transc1_tanh
  560. | OM_SYM_transc1_arccosh
  561. | OM_SYM_transc1_arccot
  562. | OM_SYM_transc1_arccoth
  563. | OM_SYM_transc1_arccsc
  564. | OM_SYM_transc1_arccsch
  565. | OM_SYM_transc1_arcsec
  566. | OM_SYM_transc1_arcsech
  567. | OM_SYM_transc1_arcsinh
  568. | OM_SYM_transc1_arctanh
  569. ;
  570. /* A generic rule that will be used within some of the apply and bind rules. */
  571. om_nary_args:
  572. /* empty */
  573. { $$ = C_nil; }
  574. | om_object om_nary_args
  575. { $$ = cons($1, $2); }
  576. ;
  577. /* A generic rule that will be used within some of the apply and bind rules. */
  578. om_unary_func:
  579. om_variable
  580. /* Note: the variable must contain a unary function for
  581. * it to be valid here. */
  582. { Lisp_Object var = MkUndefSymM("x");
  583. push2($1,var);
  584. $$ = list2(list2($1, var), var);
  585. pop2(var,$1);
  586. }
  587. | om_symbol
  588. /* Note: the symbol must represent a unary function for it to be
  589. * valid here. */
  590. { Lisp_Object var = MkUndefSymM("x");
  591. push2($1,var);
  592. $$ = list2(list2($1, var), var);
  593. pop2(var,$1);
  594. }
  595. | om_apply
  596. /* Note: the _result_ of the om_apply must be a unary function for
  597. * it to be valid here. */
  598. { Lisp_Object var = MkUndefSymM("x");
  599. push2($1,var);
  600. $$ = list2(list2($1, var), var);
  601. pop2(var,$1);
  602. }
  603. | OM_BIND OM_SYM_fns1_lambda OM_BVAR om_variable OM_ENDBVAR om_object OM_ENDBIND
  604. /* This is the only kind of OMBIND that we allow here. */
  605. { push2($6, $4);
  606. $$ = list2($6, $4);
  607. pop2($4, $6);
  608. }
  609. ;
  610. om_apply:
  611. OM_APP om_apply_inner OM_ENDAPP
  612. { $$ = $2; }
  613. | OM_ATTR OM_ATP om_attributes OM_ENDATP OM_APP om_apply_inner OM_ENDAPP OM_ENDATTR
  614. { $$ = $6; }
  615. ;
  616. om_apply_inner:
  617. om_apply_alg1_inner
  618. | om_apply_arith1_inner
  619. | om_apply_arith2_inner
  620. | om_apply_bigfloat1_inner
  621. | om_apply_calculus1_inner
  622. | om_apply_complex1_inner
  623. | om_apply_fns1_inner
  624. | om_apply_fns2_inner
  625. | om_apply_integer1_inner
  626. | om_apply_interval1_inner
  627. | om_apply_limit1_inner
  628. | om_apply_linalg1_inner
  629. | om_apply_linalg2_inner
  630. | om_apply_linalg3_inner
  631. | om_apply_list1_inner
  632. | om_apply_list2_inner
  633. | om_apply_logic1_inner
  634. | om_apply_minmax1_inner
  635. | om_apply_nums1_inner
  636. | om_apply_relation1_inner
  637. | om_apply_rounding1_inner
  638. | om_apply_set1_inner
  639. | om_apply_transc1_inner
  640. | om_apply_boundexpr_inner
  641. ;
  642. om_apply_alg1_inner:
  643. OM_SYM_alg1_zero
  644. { $$ = fixnum_of_int(0); }
  645. | OM_SYM_alg1_one
  646. { $$ = fixnum_of_int(1); }
  647. ;
  648. om_apply_arith1_inner:
  649. OM_SYM_arith1_abs om_object
  650. { push2($1,$2);
  651. $$ = list2($1, $2);
  652. pop2($2, $1);
  653. }
  654. | OM_SYM_arith1_divide om_object om_object
  655. { push3($1, $2, $3);
  656. $$ = list3($1, $2, $3);
  657. pop3($3, $2, $1);
  658. }
  659. | OM_SYM_arith1_gcd om_nary_args
  660. { push2($1,$2);
  661. $$ = list2($1, $2);
  662. pop2($2, $1);
  663. }
  664. | OM_SYM_arith1_lcm om_nary_args
  665. { push2($1,$2);
  666. $$ = list2($1, $2);
  667. pop2($2, $1);
  668. }
  669. | OM_SYM_arith1_minus om_object om_object
  670. { push3($1, $2, $3);
  671. $$ = list3($1, $2, $3);
  672. pop3($3, $2, $1);
  673. }
  674. | OM_SYM_arith1_plus
  675. { $$ = fixnum_of_int(0); }
  676. | OM_SYM_arith1_plus om_arith1_plus_args
  677. { $$ = $2; }
  678. | OM_SYM_arith1_power om_object om_object
  679. { push3($1, $2, $3);
  680. $$ = list3($1, $2, $3);
  681. pop3($3, $2, $1);
  682. }
  683. | OM_SYM_arith1_product om_object om_object
  684. { push3($1, $2, $3);
  685. $$ = list3($1, $2, $3);
  686. pop3($3, $2, $1);
  687. }
  688. | OM_SYM_arith1_root om_object om_object
  689. { push3($1, $2, $3);
  690. $$ = list3($1, $2, $3);
  691. pop3($3, $2, $1);
  692. }
  693. | OM_SYM_arith1_sum om_object om_object
  694. { push3($1, $2, $3);
  695. $$ = list3($1, $2, $3);
  696. pop3($3, $2, $1);
  697. }
  698. | OM_SYM_arith1_times
  699. { $$ = $1; }
  700. | OM_SYM_arith1_times om_arith1_times_args
  701. { $$ = $2; }
  702. | OM_SYM_arith1_unary_minus om_object
  703. { push2($1,$2);
  704. $$ = list2($1, $2);
  705. pop2($2, $1);
  706. }
  707. ;
  708. om_arith1_plus_args:
  709. om_object
  710. { $$ = $1; }
  711. | om_object om_arith1_plus_args
  712. { Lisp_Object obj = StrToLspM("+");
  713. push3(obj, $1, $2);
  714. $$ = list3(obj, $1, $2);
  715. pop3($2, $1, obj);
  716. }
  717. ;
  718. om_arith1_times_args:
  719. om_object
  720. { $$ = $1; }
  721. | om_object om_arith1_times_args
  722. { Lisp_Object obj = StrToLspM("*");
  723. push3(obj, $1, $2);
  724. $$ = list3(obj, $1, $2);
  725. pop3($2, $1, obj);
  726. }
  727. ;
  728. om_apply_arith2_inner:
  729. OM_SYM_arith2_arg om_object
  730. { push2($1, $2);
  731. $$ = list2($1, $2);
  732. pop2($2, $1);
  733. }
  734. | OM_SYM_arith2_inverse om_object
  735. { push2($1, $2);
  736. $$ = list2($1, $2);
  737. pop2($2, $1);
  738. }
  739. | OM_SYM_arith2_times
  740. { $$ = $1; }
  741. | OM_SYM_arith2_times om_arith1_times_args
  742. /* Note: we intentionally reuse om_arith1_times_args rule here,
  743. * to save work. */
  744. { $$ = $2; }
  745. ;
  746. om_apply_bigfloat1_inner:
  747. OM_SYM_bigfloat1_bigfloat om_object om_object om_object
  748. { push4($1, $2, $3, $4);
  749. $$ = cons($1, list3($2, $4, $3));
  750. pop4($4, $3, $2, $1);
  751. }
  752. ;
  753. om_apply_calculus1_inner:
  754. OM_SYM_calculus1_defint om_calculus1_interval om_unary_func
  755. {/* (|integrate| function range) */
  756. /* FIXME: needs to treat more general cases as well... */
  757. push3($1, $2, $3);
  758. $$ = list3(
  759. $1,
  760. qcar($3),
  761. list3(
  762. StrToLspM("="),
  763. qcar(qcdr($3)),
  764. $2
  765. )
  766. );
  767. pop3($3, $2, $1);
  768. }
  769. | OM_SYM_calculus1_diff om_unary_func
  770. { $$ = cons($1, $2); }
  771. | OM_SYM_calculus1_int om_unary_func
  772. { push2($1, $2);
  773. $$ = $2;
  774. $$ = cons($1, $2);
  775. pop2($2, $1);
  776. }
  777. | OM_SYM_calculus1_partialdiff om_object om_calculus1_partialdiff_funcarg
  778. {/* (|differentiate| function (|construct| vars...)) */
  779. Lisp_Object varIndList, varList;
  780. Lisp_Object funcObj, quoteObj;
  781. push($2);
  782. varIndList = Ceval($2, C_nil);
  783. pop($2);
  784. push($3);
  785. varList = qcar($3);
  786. funcObj = qcar(qcdr($3));
  787. pop($3);
  788. /* Get names corresponding to variable indices.
  789. */
  790. quoteObj = StrToLspM("QUOTE");
  791. push3(quoteObj, varList, varIndList);
  792. varList = list3(
  793. StrToLspM("MAPCAR"),
  794. list2(
  795. quoteObj,
  796. list3(
  797. StrToLspM("LAMBDA"),
  798. cons(MkUndefSymM("i"), C_nil),
  799. list3(
  800. StrToLspM("NTH"),
  801. list3(
  802. StrToLspM("-"),
  803. MkUndefSymM("i"),
  804. fixnum_of_int(1)),
  805. list2(quoteObj, varList)))),
  806. list2(quoteObj, varIndList));
  807. pop3(varIndList, varList, quoteObj);
  808. push(varList);
  809. varList = Ceval(varList, C_nil);
  810. varList = cons(
  811. StrToLspM("construct"),
  812. varList);
  813. pop(varList);
  814. push3($1, funcObj, varList);
  815. $$ = list3($1, funcObj, varList);
  816. pop3(varList, funcObj, $1);
  817. }
  818. ;
  819. om_calculus1_interval:
  820. OM_APP OM_SYM_interval1_integer_interval om_object om_object OM_ENDAPP
  821. { /* (|segment| lo hi) */
  822. push3($2, $3, $4);
  823. $$ = list3($2, $3, $4);
  824. pop3($4, $3, $2);
  825. }
  826. | OM_APP om_calculus1_interval_symbol om_object om_object OM_ENDAPP
  827. { Lisp_Object segObj = StrToLspM("segment");
  828. Lisp_Object coerceObj = StrToLspM("::");
  829. Lisp_Object typeObj = list2(StrToLspM("Fraction"), StrToLspM("Integer"));
  830. push3(segObj, coerceObj, typeObj);
  831. $$ = list3(
  832. segObj,
  833. list3(coerceObj, $3, typeObj),
  834. list3(coerceObj, $4, typeObj)
  835. );
  836. pop3(typeObj, coerceObj, segObj);
  837. }
  838. ;
  839. om_calculus1_interval_symbol:
  840. OM_SYM_interval1_interval
  841. | OM_SYM_interval1_interval
  842. | OM_SYM_interval1_interval
  843. | OM_SYM_interval1_interval
  844. | OM_SYM_interval1_interval
  845. ;
  846. /* This will make sure that the semantic value returned is of the form
  847. * ((vars) func) to make life easier... */
  848. om_calculus1_partialdiff_funcarg:
  849. OM_BIND OM_SYM_fns1_lambda OM_BVAR om_variables OM_ENDBVAR om_object OM_ENDBIND
  850. { push2($4, $6);
  851. $$ = list2($4, $6);
  852. pop2($6, $4);
  853. }
  854. ;
  855. om_apply_complex1_inner:
  856. OM_SYM_complex1_argument om_object
  857. { push2($1, $2);
  858. $$ = list2($1, $2);
  859. pop2($2, $1);
  860. }
  861. | OM_SYM_complex1_complex_cartesian om_object om_object
  862. { push3($1, $2, $3);
  863. $$ = list3($1, $2, $3);
  864. pop3($3, $2, $1);
  865. }
  866. | OM_SYM_complex1_complex_polar om_object om_object
  867. { push3($1, $2, $3);
  868. /* Unhandled Symbol */
  869. $$ = list3($1, make_string("complex_polar"), make_string("complex1"));
  870. pop3($3, $2, $1);
  871. }
  872. | OM_SYM_complex1_conjugate om_object
  873. { push2($1, $2);
  874. $$ = list2($1, $2);
  875. pop2($2, $1);
  876. }
  877. | OM_SYM_complex1_imaginary om_object
  878. { push2($1, $2);
  879. $$ = list2($1, $2);
  880. pop2($2, $1);
  881. }
  882. | OM_SYM_complex1_real om_object
  883. { push2($1, $2);
  884. $$ = list2($1, $2);
  885. pop2($2, $1);
  886. }
  887. ;
  888. /* Note that the lambda symbol does not appear here because it is only valid
  889. * as a binder. */
  890. om_apply_fns1_inner:
  891. OM_SYM_fns1_identity om_object
  892. { $$ = $2; }
  893. | OM_SYM_fns1_inverse om_object
  894. { $$ = list3($1, make_string("inverse"), make_string("fns1")); }
  895. | OM_SYM_fns1_image om_object
  896. { push2($1, $2);
  897. $$ = list3($1, make_string("image"), make_string("fns1"));
  898. pop2($1, $2);
  899. }
  900. | OM_SYM_fns1_range om_object
  901. { push2($1, $2);
  902. $$ = list3($1, make_string("range"), make_string("fns1"));
  903. pop2($1, $2);
  904. }
  905. | OM_SYM_fns1_domain om_object
  906. { push2($1, $2);
  907. $$ = list3($1, make_string("domain"), make_string("fns1"));
  908. pop2($1, $2);
  909. }
  910. | OM_SYM_fns1_left_compose om_unary_func om_unary_func
  911. {/* (ADEF (bv2) (NIL NIL) (NIL NIL) (func1 (func2 bv2))) */
  912. Lisp_Object types, bv1, bv2, func1, func2;
  913. types = list2(C_nil, C_nil);
  914. func1 = qcar($2);
  915. bv1 = qcar(qcdr($2));
  916. func2 = qcar($3);
  917. bv2 = qcar(qcdr($3));
  918. push3(func1, func2, bv1);
  919. func1 = Ceval(
  920. cons(
  921. StrToLspM("SUBST"),
  922. list3(
  923. list2(StrToLspM("QUOTE"), func2),
  924. list2(StrToLspM("QUOTE"), bv1),
  925. list2(StrToLspM("QUOTE"), func1)
  926. )
  927. ),
  928. C_nil
  929. );
  930. pop3(bv1, func2, func1);
  931. push4($1, bv2, types, func1);
  932. $$ = cons($1, cons(cons(bv2, C_nil), list3(types, types, func1)));
  933. pop4(func1, types, bv2, $1);
  934. }
  935. ;
  936. om_apply_fns2_inner:
  937. OM_SYM_fns2_apply_to_list om_unary_func om_object
  938. { push3($1,$2,$3);
  939. $$ = list3($1,$2,$3);
  940. pop3($3,$2,$1);
  941. }
  942. | OM_SYM_fns2_kernel om_unary_func
  943. {$$ = list3($1, make_string("kernel"), make_string("fns2")); }
  944. | OM_SYM_fns2_right_compose om_unary_func om_unary_func
  945. {/* (ADEF (bv1) (NIL NIL) (NIL NIL) (func2 (func1 bv1))) */
  946. Lisp_Object types, bv1, bv2, func1, func2;
  947. types = list2(C_nil, C_nil);
  948. func1 = qcar($2);
  949. bv1 = qcar(qcdr($2));
  950. func2 = qcar($3);
  951. bv2 = qcar(qcdr($3));
  952. push3(func1, func2, bv2);
  953. func1 = Ceval(
  954. cons(
  955. StrToLspM("SUBST"),
  956. list3(
  957. list2(StrToLspM("QUOTE"), func1),
  958. list2(StrToLspM("QUOTE"), bv2),
  959. list2(StrToLspM("QUOTE"), func2)
  960. )
  961. ),
  962. C_nil
  963. );
  964. pop3(bv2, func2, func1);
  965. push4($1, bv2, types, func2);
  966. $$ = cons($1, cons(cons(bv1, C_nil), list3(types, types, func2)));
  967. pop4(func2, types, bv2, $1);
  968. }
  969. ;
  970. om_apply_integer1_inner:
  971. OM_SYM_integer1_factorial om_object
  972. { push2($1, $2);
  973. $$ = list2($1, $2);
  974. pop2($2, $1);
  975. }
  976. | OM_SYM_integer1_factorof om_object om_object
  977. { push3($1, $2, $3);
  978. $$ = list3($1, make_string("factorof"), make_string("integer1"));
  979. pop3($3, $2, $1);
  980. }
  981. | OM_SYM_integer1_quotient om_object om_object
  982. { push3($1, $2, $3);
  983. $$ = list3($1, $2, $3);
  984. pop3($3, $2, $1);
  985. }
  986. | OM_SYM_integer1_remainder om_object om_object
  987. { push3($1, $2, $3);
  988. $$ = list3($1, $2, $3);
  989. pop3($3, $2, $1);
  990. }
  991. ;
  992. om_apply_interval1_inner:
  993. OM_SYM_interval1_integer_interval om_object om_object
  994. { push3($1, $2, $3);
  995. $$ = list3($1, $2, $3);
  996. pop3($3, $2, $1);
  997. }
  998. | OM_SYM_interval1_interval om_object om_object
  999. { Lisp_Object interpObj = StrToLspM("@");
  1000. Lisp_Object typeObj = list2(
  1001. StrToLspM("Interval"),
  1002. StrToLspM("DoubleFloat")
  1003. );
  1004. push5($1, $2, $3, interpObj, typeObj);
  1005. $$ = list3(interpObj, list3($1, $2, $3), typeObj);
  1006. pop5(typeObj, interpObj, $3, $2, $1);
  1007. }
  1008. | OM_SYM_interval1_interval_cc om_object om_object
  1009. { Lisp_Object interpObj = StrToLspM("@");
  1010. Lisp_Object typeObj = list2(
  1011. StrToLspM("Interval"),
  1012. StrToLspM("DoubleFloat")
  1013. );
  1014. push5($1, $2, $3, interpObj, typeObj);
  1015. $$ = list3(interpObj, list3($1, $2, $3), typeObj);
  1016. pop5(typeObj, interpObj, $3, $2, $1);
  1017. }
  1018. | OM_SYM_interval1_interval_co om_object om_object
  1019. { Lisp_Object interpObj = StrToLspM("@");
  1020. Lisp_Object typeObj = list2(
  1021. StrToLspM("Interval"),
  1022. StrToLspM("DoubleFloat")
  1023. );
  1024. double dLo = float_of_number($2);
  1025. double dHi = float_of_number($3);
  1026. if (dLo > dHi) {
  1027. double dt = dLo;
  1028. dLo = dHi;
  1029. dHi = dt;
  1030. }
  1031. dHi -= DBL_EPSILON;
  1032. push3($1, interpObj, typeObj);
  1033. $$ = list3(interpObj, list3($1,
  1034. make_boxfloat(dLo, TYPE_DOUBLE_FLOAT),
  1035. make_boxfloat(dHi, TYPE_DOUBLE_FLOAT)
  1036. ), typeObj);
  1037. pop3(typeObj, interpObj, $1);
  1038. }
  1039. | OM_SYM_interval1_interval_oc om_object om_object
  1040. { Lisp_Object interpObj = StrToLspM("@");
  1041. Lisp_Object typeObj = list2(
  1042. StrToLspM("Interval"),
  1043. StrToLspM("DoubleFloat")
  1044. );
  1045. double dLo = float_of_number($2);
  1046. double dHi = float_of_number($3);
  1047. if (dLo > dHi) {
  1048. double dt = dLo;
  1049. dLo = dHi;
  1050. dHi = dt;
  1051. }
  1052. dLo += DBL_EPSILON;
  1053. push3($1, interpObj, typeObj);
  1054. $$ = list3(interpObj, list3($1,
  1055. make_boxfloat(dLo, TYPE_DOUBLE_FLOAT),
  1056. make_boxfloat(dHi, TYPE_DOUBLE_FLOAT)
  1057. ), typeObj);
  1058. pop3(typeObj, interpObj, $1);
  1059. }
  1060. | OM_SYM_interval1_interval_oo om_object om_object
  1061. { Lisp_Object interpObj = StrToLspM("@");
  1062. Lisp_Object typeObj = list2(
  1063. StrToLspM("Interval"),
  1064. StrToLspM("DoubleFloat")
  1065. );
  1066. double dLo = float_of_number($2);
  1067. double dHi = float_of_number($3);
  1068. if (dLo > dHi) {
  1069. double dt = dLo;
  1070. dLo = dHi;
  1071. dHi = dt;
  1072. }
  1073. dLo += DBL_EPSILON;
  1074. dHi -= DBL_EPSILON;
  1075. push3($1, interpObj, typeObj);
  1076. $$ = list3(interpObj, list3($1,
  1077. make_boxfloat(dLo, TYPE_DOUBLE_FLOAT),
  1078. make_boxfloat(dHi, TYPE_DOUBLE_FLOAT)
  1079. ), typeObj);
  1080. pop3(typeObj, interpObj, $1);
  1081. }
  1082. ;
  1083. om_apply_limit1_inner:
  1084. OM_SYM_limit1_limit om_object OM_SYM_limit1_above om_unary_func
  1085. {/* (|limit| func (|=| var limiting_val) "right") */
  1086. Lisp_Object limitVal;
  1087. push2($4, $2);
  1088. limitVal = list3(
  1089. StrToLspM("="),
  1090. qcar(qcdr($4)),
  1091. list3(
  1092. StrToLspM("::"),
  1093. $2,
  1094. list2(
  1095. StrToLspM("Fraction"),
  1096. StrToLspM("Integer")
  1097. )
  1098. )
  1099. );
  1100. pop2($2, $4);
  1101. push2($1, $4);
  1102. $$ = cons($1, list3(qcar($4), limitVal, make_string("right")));
  1103. pop2($4, $1);
  1104. }
  1105. | OM_SYM_limit1_limit om_object OM_SYM_limit1_below om_unary_func
  1106. {/* (|limit| func (|=| var limiting_val) "left") */
  1107. Lisp_Object limitVal;
  1108. push2($4, $2);
  1109. limitVal = list3(
  1110. StrToLspM("="),
  1111. qcar(qcdr($4)),
  1112. list3(
  1113. StrToLspM("::"),
  1114. $2,
  1115. list2(
  1116. StrToLspM("Fraction"),
  1117. StrToLspM("Integer")
  1118. )
  1119. )
  1120. );
  1121. pop2($2, $4);
  1122. push2($1, $4);
  1123. $$ = cons($1, list3(qcar($4), limitVal, make_string("left")));
  1124. pop2($4, $1);
  1125. }
  1126. | OM_SYM_limit1_limit om_object OM_SYM_limit1_both_sides om_unary_func
  1127. {/* (|limit| func (|=| var limiting_val)) */
  1128. Lisp_Object limitVal;
  1129. push2($4, $2);
  1130. limitVal = list3(
  1131. StrToLspM("="),
  1132. qcar(qcdr($4)),
  1133. list3(
  1134. StrToLspM("::"),
  1135. $2,
  1136. list2(
  1137. StrToLspM("Fraction"),
  1138. StrToLspM("Integer")
  1139. )
  1140. )
  1141. );
  1142. pop2($2, $4);
  1143. push2($1, $4);
  1144. $$ = list3($1, qcar($4), limitVal);
  1145. pop2($4, $1);
  1146. }
  1147. | OM_SYM_limit1_limit om_object OM_SYM_limit1_null om_unary_func
  1148. {/* (|limit| func (|=| var limiting_val)) */
  1149. Lisp_Object limitVal;
  1150. push2($4, $2);
  1151. limitVal = list3(
  1152. StrToLspM("="),
  1153. qcar(qcdr($4)),
  1154. list3(
  1155. StrToLspM("::"),
  1156. $2,
  1157. list2(
  1158. StrToLspM("Fraction"),
  1159. StrToLspM("Integer")
  1160. )
  1161. )
  1162. );
  1163. pop2($2, $4);
  1164. push2($1, $4);
  1165. $$ = list3($1, qcar($4), limitVal);
  1166. pop2($4, $1);
  1167. }
  1168. ;
  1169. om_apply_linalg2_inner:
  1170. OM_SYM_linalg2_matrix om_linalg2_matrix_args
  1171. { Lisp_Object obj = StrToLspM("construct");
  1172. push2($1, $2);
  1173. $$ = list2($1, cons(obj, $2));
  1174. pop2($2, $1);
  1175. }
  1176. | OM_SYM_linalg2_matrixrow om_nary_args
  1177. { $$ = cons($1, $2); }
  1178. | OM_SYM_linalg2_vector om_nary_args
  1179. { $$ = cons($1, $2); }
  1180. ;
  1181. om_linalg2_matrix_args:
  1182. /* empty */
  1183. { $$ = C_nil; }
  1184. | OM_APP OM_SYM_linalg2_matrixrow om_nary_args OM_ENDAPP om_linalg2_matrix_args
  1185. { $$ = cons(cons($2, $3), $5); }
  1186. ;
  1187. om_apply_linalg3_inner:
  1188. OM_SYM_linalg3_matrix om_linalg3_matrix_args
  1189. { Lisp_Object cns = StrToLspM("construct");
  1190. Lisp_Object trn = StrToLspM("transpose");
  1191. push4(trn, $1, cns, $2);
  1192. $$ = list2(trn, list2($1, cons(cns, $2)));
  1193. pop4($2, cns, $1, trn);
  1194. }
  1195. | OM_SYM_linalg3_matrixcolumn om_nary_args
  1196. { $$ = cons($1, $2); }
  1197. | OM_SYM_linalg3_vector om_nary_args
  1198. { $$ = cons($1, $2); }
  1199. ;
  1200. om_linalg3_matrix_args:
  1201. /* empty */
  1202. { $$ = C_nil; }
  1203. | OM_APP OM_SYM_linalg3_matrixcolumn om_nary_args OM_ENDAPP om_linalg3_matrix_args
  1204. { $$ = cons( cons($2, $3), $5 ); }
  1205. ;
  1206. om_apply_linalg1_inner:
  1207. OM_SYM_linalg1_determinant om_object
  1208. { push2($1, $2);
  1209. $$ = list2($1, $2);
  1210. pop2($2, $1);
  1211. }
  1212. | OM_SYM_linalg1_matrix_selector om_object om_object om_object
  1213. { $$ = cons($1, list3($3, $4, $2)); }
  1214. | OM_SYM_linalg1_vector_selector om_object om_object
  1215. { push3($1, $2, $3);
  1216. $$ = list3($1, $3, $2);
  1217. pop3($3, $2, $1);
  1218. }
  1219. | OM_SYM_linalg1_transpose om_object
  1220. { push2($1, $2);
  1221. $$ = list2($1, $2);
  1222. pop2($2, $1);
  1223. }
  1224. | OM_SYM_linalg1_outerproduct om_object om_object
  1225. { push3($1, $2, $3);
  1226. $$ = list3($1, $2, $3);
  1227. pop3($3, $2, $1);
  1228. }
  1229. | OM_SYM_linalg1_scalarproduct om_object om_object
  1230. { push3($1, $2, $3);
  1231. $$ = list3($1, $2, $3);
  1232. pop3($3, $2, $1);
  1233. }
  1234. | OM_SYM_linalg1_vectorproduct om_object om_object
  1235. { push3($1, $2, $3);
  1236. $$ = list3($1, $2, $3);
  1237. pop3($3, $2, $1);
  1238. }
  1239. ;
  1240. om_apply_list1_inner:
  1241. OM_SYM_list1_list om_nary_args
  1242. { $$ = cons($1, $2); }
  1243. | OM_SYM_list1_map om_object om_object
  1244. { push3($1, $2, $3);
  1245. $$ = list3($1, $2, $3);
  1246. pop3($3, $2, $1);
  1247. }
  1248. | OM_SYM_list1_suchthat om_object om_object
  1249. { /* Deliberately swap arguments for AXIOM */
  1250. push3($1, $2, $3);
  1251. $$ = list3($1, $3, $2);
  1252. pop3($3, $2, $1);
  1253. }
  1254. ;
  1255. /* This rule will always return the list (x expr), where x is the name of
  1256. * the bound variable in the expression and expr is some expression involving
  1257. * x. */
  1258. om_list1_funcarg:
  1259. om_variable
  1260. /* Note: the variable must contain a unary function
  1261. * for it to be valid here. */
  1262. { Lisp_Object var = MkUndefSymM("x");
  1263. push2($1, var);
  1264. $$ = list2(var, list2($1, var));
  1265. pop2(var, $1);
  1266. }
  1267. | om_symbol
  1268. /* Note: the symbol must represent a unary function
  1269. * for it to be valid here. */
  1270. { Lisp_Object var = MkUndefSymM("x");
  1271. push2($1, var);
  1272. $$ = list2(var, list2($1, var));
  1273. pop2(var, $1);
  1274. }
  1275. | om_apply
  1276. /* Note: the _result_ of the om_apply must be a unary
  1277. * function for it to be valid here. */
  1278. { Lisp_Object var = MkUndefSymM("x");
  1279. push2($1, var);
  1280. $$ = list2(var, list2($1, var));
  1281. pop2(var, $1);
  1282. }
  1283. | om_list1_anonymous_funcarg
  1284. { $$ = $1; }
  1285. | OM_ATTR OM_ATP om_attributes OM_ENDATP om_list1_anonymous_funcarg OM_ENDATTR
  1286. { $$ = $5; }
  1287. ;
  1288. om_list1_anonymous_funcarg:
  1289. OM_BIND OM_SYM_fns1_lambda OM_BVAR om_variable OM_ENDBVAR om_object OM_ENDBIND
  1290. /* This is the only kind of OMBIND that we allow here. */
  1291. { push2($4, $6);
  1292. $$ = list2($4, $6);
  1293. pop2($6, $4);
  1294. }
  1295. ;
  1296. om_apply_list2_inner:
  1297. OM_SYM_list2_cons om_object om_object
  1298. { push3($1, $2, $3);
  1299. $$ = list3($1, $2, $3);
  1300. pop3($3, $2, $1);
  1301. }
  1302. | OM_SYM_list2_first om_object
  1303. { push2($1, $2);
  1304. $$ = list2($1, $2);
  1305. pop2($2, $1);
  1306. }
  1307. | OM_SYM_list2_rest om_object
  1308. { push2($1, $2);
  1309. $$ = list2($1, $2);
  1310. pop2($2, $1);
  1311. }
  1312. ;
  1313. om_apply_logic1_inner:
  1314. OM_SYM_logic1_and
  1315. { $$ = $1; }
  1316. | OM_SYM_logic1_and om_logic1_and_args
  1317. { $$ = $2; }
  1318. | OM_SYM_logic1_false
  1319. { $$ = $1; }
  1320. | OM_SYM_logic1_implies om_object om_object
  1321. { push3($1, $2, $3);
  1322. $$ = list3($1, $2, $3);
  1323. pop3($3, $2, $1);
  1324. }
  1325. | OM_SYM_logic1_not om_object
  1326. { push2($1, $2);
  1327. $$ = list2($1, $2);
  1328. pop2($2, $1);
  1329. }
  1330. | OM_SYM_logic1_or
  1331. { $$ = $1; }
  1332. | OM_SYM_logic1_or om_logic1_or_args
  1333. { $$ = $2; }
  1334. | OM_SYM_logic1_true
  1335. { $$ = $1; }
  1336. | OM_SYM_logic1_xor
  1337. { $$ = $1; }
  1338. | OM_SYM_logic1_xor om_logic1_xor_args
  1339. { $$ = $2; }
  1340. | OM_SYM_logic1_equivalent om_object om_object
  1341. {$$ = list3($1, make_string("equivalent"), make_string("logic1")); }
  1342. ;
  1343. om_logic1_and_args:
  1344. om_object
  1345. { $$ = $1; }
  1346. | om_object om_logic1_and_args
  1347. { Lisp_Object obj = StrToLspM("and");
  1348. push3(obj, $1, $2);
  1349. $$ = list3(obj, $1, $2);
  1350. pop3($2, $1, obj);
  1351. }
  1352. ;
  1353. om_logic1_or_args:
  1354. om_object
  1355. { $$ = $1; }
  1356. | om_object om_logic1_or_args
  1357. { Lisp_Object obj = StrToLspM("or");
  1358. push3(obj, $1, $2);
  1359. $$ = list3(obj, $1, $2);
  1360. pop3($2, $1, obj);
  1361. }
  1362. ;
  1363. om_logic1_xor_args:
  1364. om_object
  1365. { $$ = $1; }
  1366. | om_object om_logic1_xor_args
  1367. { Lisp_Object obj = StrToLspM("xor");
  1368. push3(obj, $1, $2);
  1369. $$ = list3(obj, $1, $2);
  1370. pop3($2, $1, obj);
  1371. }
  1372. ;
  1373. om_apply_minmax1_inner:
  1374. OM_SYM_minmax1_max
  1375. { $$ = $1; }
  1376. | OM_SYM_minmax1_max om_minmax1_max_args
  1377. { $$ = $2; }
  1378. | OM_SYM_minmax1_min
  1379. { $$ = $1; }
  1380. | OM_SYM_minmax1_min om_minmax1_min_args
  1381. { $$ = $2; }
  1382. ;
  1383. om_minmax1_max_args:
  1384. om_object
  1385. { $$ = $1; }
  1386. | om_object om_minmax1_max_args
  1387. { Lisp_Object obj = StrToLspM("max");
  1388. push3(obj, $1, $2);
  1389. $$ = list3(obj, $1, $2);
  1390. pop3($2, $1, obj);
  1391. }
  1392. ;
  1393. om_minmax1_min_args:
  1394. om_object
  1395. { $$ = $1; }
  1396. | om_object om_minmax1_min_args
  1397. { Lisp_Object obj = StrToLspM("min");
  1398. push3(obj, $1, $2);
  1399. $$ = list3(obj, $1, $2);
  1400. pop3($2, $1, obj);
  1401. }
  1402. ;
  1403. /* Note that some of the symbols from the nums1 CD are not present here as they
  1404. * are constants and hence cannot be applied. */
  1405. om_apply_nums1_inner:
  1406. OM_SYM_nums1_based_integer om_object om_object
  1407. {$$ = list3($1, make_string("based_integer"), make_string("nums1")); }
  1408. | OM_SYM_nums1_rational om_object om_object
  1409. {/* (|@| (/ numer denom) (|Fraction| |Integer|)) */
  1410. push3($1, $2, $3);
  1411. $$ = list3(
  1412. StrToLspM("@"),
  1413. list3($1, $2, $3),
  1414. list2(
  1415. StrToLspM("Fraction"),
  1416. StrToLspM("Integer")
  1417. )
  1418. );
  1419. pop3($3, $2, $1);
  1420. }
  1421. ;
  1422. om_apply_relation1_inner:
  1423. OM_SYM_relation1_eq om_object om_object
  1424. { Lisp_Object coerceObj = StrToLspM("::");
  1425. Lisp_Object nameObj = StrToLspM("SExpression");
  1426. push5($1, $2, $3, coerceObj, nameObj);
  1427. $$ = list3($1,
  1428. list3(coerceObj, $2, nameObj),
  1429. list3(coerceObj, $3, nameObj)
  1430. );
  1431. pop5(nameObj, coerceObj, $3, $2, $1);
  1432. }
  1433. | OM_SYM_relation1_geq om_object om_object
  1434. { push3($1, $2, $3);
  1435. $$ = list3($1, $2, $3);
  1436. pop3($3, $2, $1);
  1437. }
  1438. | OM_SYM_relation1_gt om_object om_object
  1439. { push3($1, $2, $3);
  1440. $$ = list3($1, $2, $3);
  1441. pop3($3, $2, $1);
  1442. }
  1443. | OM_SYM_relation1_leq om_object om_object
  1444. { push3($1, $2, $3);
  1445. $$ = list3($1, $2, $3);
  1446. pop3($3, $2, $1);
  1447. }
  1448. | OM_SYM_relation1_lt om_object om_object
  1449. { push3($1, $2, $3);
  1450. $$ = list3($1, $2, $3);
  1451. pop3($3, $2, $1);
  1452. }
  1453. | OM_SYM_relation1_neq om_object om_object
  1454. { push3($1, $2, $3);
  1455. $$ = list3($1, $2, $3);
  1456. pop3($3, $2, $1);
  1457. }
  1458. | OM_SYM_relation1_approx om_object om_object
  1459. { push3($1, $2, $3);
  1460. $$ = list3($1, make_string("approx"), make_string("relation1"));
  1461. pop3($3, $2, $1);
  1462. }
  1463. ;
  1464. om_apply_rounding1_inner:
  1465. OM_SYM_rounding1_ceiling om_object
  1466. { push2($1, $2);
  1467. $$ = list2($1, $2);
  1468. pop2($2, $1);
  1469. }
  1470. | OM_SYM_rounding1_floor om_object
  1471. { push2($1, $2);
  1472. $$ = list2($1, $2);
  1473. pop2($2, $1);
  1474. }
  1475. | OM_SYM_rounding1_trunc om_object
  1476. { push2($1, $2);
  1477. $$ = list2($1, $2);
  1478. pop2($2, $1);
  1479. }
  1480. | OM_SYM_rounding1_round om_object
  1481. { push2($1, $2);
  1482. $$ = list2($1, $2);
  1483. pop2($2, $1);
  1484. }
  1485. ;
  1486. om_apply_set1_inner:
  1487. OM_SYM_set1_in om_object om_object
  1488. { push3($1, $2, $3);
  1489. $$ = list3($1, $2, $3);
  1490. pop3($3, $2, $1);
  1491. }
  1492. | OM_SYM_set1_intersect om_object om_object
  1493. { push3($1, $2, $3);
  1494. $$ = list3($1, $2, $3);
  1495. pop3($3, $2, $1);
  1496. }
  1497. | OM_SYM_set1_notin om_object om_object
  1498. { Lisp_Object notObj = StrToLspM("not");
  1499. push4(notObj, $1, $2, $3);
  1500. $$ = list2(notObj, list3($1, $2, $3));
  1501. pop4($3, $2, $1, notObj);
  1502. }
  1503. | OM_SYM_set1_notprsubset om_object om_object
  1504. { Lisp_Object notObj = StrToLspM("not");
  1505. push4(notObj, $1, $2, $3);
  1506. $$ = list2(notObj, list3($1, $2, $3));
  1507. pop4($3, $2, $1, notObj);
  1508. }
  1509. | OM_SYM_set1_notsubset om_object om_object
  1510. { Lisp_Object notObj = StrToLspM("not");
  1511. push4(notObj, $1, $2, $3);
  1512. $$ = list2(notObj, list3($1, $2, $3));
  1513. pop4($3, $2, $1, notObj);
  1514. }
  1515. | OM_SYM_set1_prsubset om_object om_object
  1516. { push3($1, $2, $3);
  1517. $$ = list3($1, $2, $3);
  1518. pop3($3, $2, $1);
  1519. }
  1520. | OM_SYM_set1_set om_nary_args
  1521. {
  1522. $$ = cons($1, $2);
  1523. }
  1524. | OM_SYM_set1_setdiff om_object om_object
  1525. { push3($1, $2, $3);
  1526. $$ = list3($1, $2, $3);
  1527. pop3($3, $2, $1);
  1528. }
  1529. | OM_SYM_set1_subset om_object om_object
  1530. { push3($1, $2, $3);
  1531. $$ = list3($1, $2, $3);
  1532. pop3($3, $2, $1);
  1533. }
  1534. | OM_SYM_set1_union om_object om_object
  1535. { push3($1, $2, $3);
  1536. $$ = list3($1, $2, $3);
  1537. pop3($3, $2, $1);
  1538. }
  1539. | OM_SYM_set1_size om_object
  1540. { push2($1, $2);
  1541. $$ = list2($1, $2);
  1542. pop2($2, $1);
  1543. }
  1544. | OM_SYM_set1_cartesian_product om_nary_args
  1545. { push2($1, $2);
  1546. $$ = list3($1, make_string("cartesian_product"), make_string("set1"));
  1547. pop2($2, $1);
  1548. }
  1549. | OM_SYM_set1_emptyset
  1550. { push($1);
  1551. $$ = Llist(C_nil, $1);
  1552. pop($1);
  1553. }
  1554. | OM_SYM_set1_map om_object om_object
  1555. { push3($1, $2, $3);
  1556. $$ = list3($1, $2, $3);
  1557. pop3($3, $2, $1);
  1558. }
  1559. | OM_SYM_set1_suchthat om_object om_object
  1560. { /* Deliberately swap arguments for AXIOM */
  1561. push3($1, $2, $3);
  1562. $$ = list3($1, $3, $2);
  1563. pop3($3, $2, $1);
  1564. }
  1565. ;
  1566. om_apply_transc1_inner:
  1567. OM_SYM_transc1_arccos om_object
  1568. { push2($1, $2);
  1569. $$ = list2($1, $2);
  1570. pop2($2, $1);
  1571. }
  1572. | OM_SYM_transc1_arcsin om_object
  1573. { push2($1, $2);
  1574. $$ = list2($1, $2);
  1575. pop2($2, $1);
  1576. }
  1577. | OM_SYM_transc1_arctan om_object
  1578. { push2($1, $2);
  1579. $$ = list2($1, $2);
  1580. pop2($2, $1);
  1581. }
  1582. | OM_SYM_transc1_cos om_object
  1583. { push2($1, $2);
  1584. $$ = list2($1, $2);
  1585. pop2($2, $1);
  1586. }
  1587. | OM_SYM_transc1_cosh om_object
  1588. { push2($1, $2);
  1589. $$ = list2($1, $2);
  1590. pop2($2, $1);
  1591. }
  1592. | OM_SYM_transc1_cot om_object
  1593. { push2($1, $2);
  1594. $$ = list2($1, $2);
  1595. pop2($2, $1);
  1596. }
  1597. | OM_SYM_transc1_coth om_object
  1598. { push2($1, $2);
  1599. $$ = list2($1, $2);
  1600. pop2($2, $1);
  1601. }
  1602. | OM_SYM_transc1_csc om_object
  1603. { push2($1, $2);
  1604. $$ = list2($1, $2);
  1605. pop2($2, $1);
  1606. }
  1607. | OM_SYM_transc1_csch om_object
  1608. { push2($1, $2);
  1609. $$ = list2($1, $2);
  1610. pop2($2, $1);
  1611. }
  1612. | OM_SYM_transc1_exp om_object
  1613. { push2($1, $2);
  1614. $$ = list2($1, $2);
  1615. pop2($2, $1);
  1616. }
  1617. | OM_SYM_transc1_ln om_object
  1618. { push2($1, $2);
  1619. $$ = list2($1, $2);
  1620. pop2($2, $1);
  1621. }
  1622. | OM_SYM_transc1_log om_object om_object
  1623. { Lisp_Object obj = StrToLspM("/");
  1624. push4(obj, $1, $2, $3);
  1625. $$ = list3(obj, list2($1, $3), list2($1, $2));
  1626. pop4($3, $2, $1, obj);
  1627. }
  1628. | OM_SYM_transc1_sec om_object
  1629. { push2($1, $2);
  1630. $$ = list2($1, $2);
  1631. pop2($2, $1);
  1632. }
  1633. | OM_SYM_transc1_sech om_object
  1634. { push2($1, $2);
  1635. $$ = list2($1, $2);
  1636. pop2($2, $1);
  1637. }
  1638. | OM_SYM_transc1_sin om_object
  1639. { push2($1, $2);
  1640. $$ = list2($1, $2);
  1641. pop2($2, $1);
  1642. }
  1643. | OM_SYM_transc1_sinh om_object
  1644. { push2($1, $2);
  1645. $$ = list2($1, $2);
  1646. pop2($2, $1);
  1647. }
  1648. | OM_SYM_transc1_tan om_object
  1649. { push2($1, $2);
  1650. $$ = list2($1, $2);
  1651. pop2($2, $1);
  1652. }
  1653. | OM_SYM_transc1_tanh om_object
  1654. { push2($1, $2);
  1655. $$ = list2($1, $2);
  1656. pop2($2, $1);
  1657. }
  1658. | OM_SYM_transc1_arccosh om_object
  1659. { push2($1, $2);
  1660. $$ = list2($1, $2);
  1661. pop2($2, $1);
  1662. }
  1663. | OM_SYM_transc1_arccot om_object
  1664. { push2($1, $2);
  1665. $$ = list2($1, $2);
  1666. pop2($2, $1);
  1667. }
  1668. | OM_SYM_transc1_arccoth om_object
  1669. { push2($1, $2);
  1670. $$ = list2($1, $2);
  1671. pop2($2, $1);
  1672. }
  1673. | OM_SYM_transc1_arccsc om_object
  1674. { push2($1, $2);
  1675. $$ = list2($1, $2);
  1676. pop2($2, $1);
  1677. }
  1678. | OM_SYM_transc1_arccsch om_object
  1679. { push2($1, $2);
  1680. $$ = list2($1, $2);
  1681. pop2($2, $1);
  1682. }
  1683. | OM_SYM_transc1_arcsec om_object
  1684. { push2($1, $2);
  1685. $$ = list2($1, $2);
  1686. pop2($2, $1);
  1687. }
  1688. | OM_SYM_transc1_arcsech om_object
  1689. { push2($1, $2);
  1690. $$ = list2($1, $2);
  1691. pop2($2, $1);
  1692. }
  1693. | OM_SYM_transc1_arcsinh om_object
  1694. { push2($1, $2);
  1695. $$ = list2($1, $2);
  1696. pop2($2, $1);
  1697. }
  1698. | OM_SYM_transc1_arctanh om_object
  1699. { push2($1, $2);
  1700. $$ = list2($1, $2);
  1701. pop2($2, $1);
  1702. }
  1703. ;
  1704. om_apply_boundexpr_inner:
  1705. om_bind om_nary_args
  1706. { $$ = cons($1, $2); }
  1707. ;
  1708. om_bind:
  1709. OM_BIND om_bind_inner OM_ENDBIND
  1710. { $$ = $2; }
  1711. | OM_ATTR OM_ATP om_attributes OM_ENDATP OM_BIND om_bind_inner OM_ENDBIND OM_ENDATTR
  1712. { $$ = $6; }
  1713. ;
  1714. om_bind_inner:
  1715. om_bind_fns1_inner
  1716. ;
  1717. om_bind_fns1_inner:
  1718. OM_SYM_fns1_lambda OM_BVAR om_variables OM_ENDBVAR om_object
  1719. { Lisp_Object types = C_nil;
  1720. Lisp_Object llen = Llength(C_nil, $3);
  1721. int len = int_of_fixnum(llen);
  1722. int i;
  1723. for (i = 0; i < len; i++)
  1724. types = cons(C_nil, types);
  1725. types = cons(C_nil, types);
  1726. push4($1, $3, $5, types);
  1727. $$ = cons($1, cons($3, list3(types, types, $5)));
  1728. pop4(types, $5, $3, $1);
  1729. }
  1730. ;
  1731. %%
  1732. /* C code. */
  1733. typedef struct {
  1734. char *cd;
  1735. char *name;
  1736. char *axname;
  1737. YYSTYPE token;
  1738. } symTableItem;
  1739. /* All symbols from the same CD must be in a contiguous group. */
  1740. static symTableItem symTable[] = {
  1741. {"alg1", "one", "1", OM_SYM_alg1_one},
  1742. {"alg1", "zero", "0", OM_SYM_alg1_zero},
  1743. {"arith1", "abs", "abs", OM_SYM_arith1_abs},
  1744. {"arith1", "divide", "/", OM_SYM_arith1_divide},
  1745. {"arith1", "gcd", "gcd", OM_SYM_arith1_gcd},
  1746. {"arith1", "lcm", "lcm", OM_SYM_arith1_lcm},
  1747. {"arith1", "minus", "-", OM_SYM_arith1_minus},
  1748. {"arith1", "plus", "+", OM_SYM_arith1_plus},
  1749. {"arith1", "power", "**", OM_SYM_arith1_power},
  1750. {"arith1", "product", "product", OM_SYM_arith1_product},
  1751. {"arith1", "root", "nthRoot", OM_SYM_arith1_root},
  1752. {"arith1", "sum", "summation", OM_SYM_arith1_sum},
  1753. {"arith1", "times", "*", OM_SYM_arith1_times},
  1754. {"arith1", "unary_minus", "-", OM_SYM_arith1_unary_minus},
  1755. {"arith2", "arg", "argument", OM_SYM_arith2_arg},
  1756. {"arith2", "inverse", "inv", OM_SYM_arith2_inverse},
  1757. {"arith2", "times", "*", OM_SYM_arith2_times},
  1758. {"bigfloat1", "bigfloat", "float", OM_SYM_bigfloat1_bigfloat},
  1759. {"calculus1", "defint", "integrate", OM_SYM_calculus1_defint},
  1760. {"calculus1", "diff", "differentiate", OM_SYM_calculus1_diff},
  1761. /*MCDT*/
  1762. {"calculus1", "int", "integrate", OM_SYM_calculus1_int},
  1763. {"calculus1", "partialdiff", "differentiate", OM_SYM_calculus1_partialdiff},
  1764. {"complex1", "argument", "argument", OM_SYM_complex1_argument},
  1765. {"complex1", "complex_cartesian", "complex", OM_SYM_complex1_complex_cartesian},
  1766. {"complex1", "complex_polar", "OMunhandledSymbol", OM_SYM_complex1_complex_polar},
  1767. {"complex1", "conjugate", "conjugate", OM_SYM_complex1_conjugate},
  1768. {"complex1", "real", "real", OM_SYM_complex1_real},
  1769. {"complex1", "imaginary", "imaginary", OM_SYM_complex1_imaginary},
  1770. /* dummy name: no equivalent Axiom function. */
  1771. {"fns1", "identity", "OMunhandledSymbol", OM_SYM_fns1_identity},
  1772. {"fns1", "range", "OMunhandledSymbol", OM_SYM_fns1_range},
  1773. {"fns1", "image", "OMunhandledSymbol", OM_SYM_fns1_image},
  1774. {"fns1", "domain", "OMunhandledSymbol", OM_SYM_fns1_domain},
  1775. {"fns1", "inverse", "OMunhandledSymbol", OM_SYM_fns1_inverse},
  1776. {"fns1", "lambda", "ADEF", OM_SYM_fns1_lambda},
  1777. {"fns1", "left_compose", "ADEF", OM_SYM_fns1_left_compose},
  1778. {"fns2", "apply_to_list", "reduce", OM_SYM_fns2_apply_to_list},
  1779. {"fns2", "kernel", "OMunhandledSymbol", OM_SYM_fns2_kernel},
  1780. /* FIXME: find out the axiom name for this. */
  1781. /* {"fns2", "right_compose","????", OM_SYM_fns2_right_compose},*/
  1782. {"integer1", "factorial", "factorial", OM_SYM_integer1_factorial},
  1783. {"integer1", "factorof", "OMunhandledSymbol", OM_SYM_integer1_factorof},
  1784. {"integer1", "quotient", "quo", OM_SYM_integer1_quotient},
  1785. {"integer1", "rem", "rem", OM_SYM_integer1_remainder},
  1786. {"interval1", "integer_interval", "segment", OM_SYM_interval1_integer_interval},
  1787. {"interval1", "interval", "interval", OM_SYM_interval1_interval},
  1788. {"interval1", "interval_cc", "interval", OM_SYM_interval1_interval_cc},
  1789. {"interval1", "interval_co", "interval", OM_SYM_interval1_interval_co},
  1790. {"interval1", "interval_oc", "interval", OM_SYM_interval1_interval_oc},
  1791. {"interval1", "interval_oo", "interval", OM_SYM_interval1_interval_oo},
  1792. {"limit1", "above", "right", OM_SYM_limit1_above},
  1793. {"limit1", "below", "left", OM_SYM_limit1_below},
  1794. {"limit1", "both_sides", "neither", OM_SYM_limit1_both_sides}, /* dummy name */
  1795. {"limit1", "limit", "limit", OM_SYM_limit1_limit},
  1796. {"limit1", "null", "neither", OM_SYM_limit1_null}, /* dummy name */
  1797. {"linalg1", "determinant", "determinant", OM_SYM_linalg1_determinant},
  1798. {"linalg1", "matrix_selector", "elt", OM_SYM_linalg1_matrix_selector},
  1799. {"linalg1", "vector_selector", "elt", OM_SYM_linalg1_vector_selector},
  1800. {"linalg1", "transpose", "transpose", OM_SYM_linalg1_transpose},
  1801. {"linalg1", "outerproduct", "outerproduct", OM_SYM_linalg1_outerproduct},
  1802. {"linalg1", "scalarproduct", "dot", OM_SYM_linalg1_scalarproduct},
  1803. {"linalg1", "vectorproduct", "cross", OM_SYM_linalg1_vectorproduct},
  1804. {"linalg2", "matrix", "matrix", OM_SYM_linalg2_matrix},
  1805. {"linalg2", "matrixrow", "construct", OM_SYM_linalg2_matrixrow},
  1806. {"linalg2", "vector", "vector", OM_SYM_linalg2_vector},
  1807. {"linalg3", "matrix", "matrix", OM_SYM_linalg3_matrix},
  1808. {"linalg3", "matrixcolumn", "construct", OM_SYM_linalg3_matrixcolumn},
  1809. {"linalg3", "vector", "vector", OM_SYM_linalg3_vector},
  1810. {"list1", "list", "construct", OM_SYM_list1_list},
  1811. {"list1", "map", "map", OM_SYM_list1_map},
  1812. {"list1", "suchthat", "select", OM_SYM_list1_suchthat},
  1813. {"list2", "cons", "cons", OM_SYM_list2_cons},
  1814. {"list2", "first", "first", OM_SYM_list2_first},
  1815. {"list2", "rest", "rest", OM_SYM_list2_rest},
  1816. {"logic1", "and", "and", OM_SYM_logic1_and},
  1817. {"logic1", "false", "false", OM_SYM_logic1_false},
  1818. {"logic1", "implies", "implies", OM_SYM_logic1_implies},
  1819. {"logic1", "not", "not", OM_SYM_logic1_not},
  1820. {"logic1", "or", "or", OM_SYM_logic1_or},
  1821. {"logic1", "true", "true", OM_SYM_logic1_true},
  1822. {"logic1", "xor", "xor", OM_SYM_logic1_xor},
  1823. {"logic1", "equivalent", "OMunhandledSymbol", OM_SYM_logic1_equivalent},
  1824. {"minmax1", "max", "max", OM_SYM_minmax1_max},
  1825. {"minmax1", "min", "min", OM_SYM_minmax1_min},
  1826. {"nums1", "based_integer", "OMunhandledSymbol", OM_SYM_nums1_based_integer},
  1827. {"nums1", "e", "%e", OM_SYM_nums1_e},
  1828. /* {"nums1", "gamma", "????", OM_SYM_nums1_gamma},*/
  1829. {"nums1", "i", "%i", OM_SYM_nums1_i},
  1830. {"nums1", "infinity", "%infinity", OM_SYM_nums1_infinity},
  1831. {"nums1", "NaN", "OMunhandledSymbol", OM_SYM_nums1_NaN},
  1832. {"nums1", "pi", "%pi", OM_SYM_nums1_pi},
  1833. {"nums1", "rational", "/", OM_SYM_nums1_rational},
  1834. {"relation1", "eq", "eq", OM_SYM_relation1_eq},
  1835. {"relation1", "geq", ">=", OM_SYM_relation1_geq},
  1836. {"relation1", "gt", ">", OM_SYM_relation1_gt},
  1837. {"relation1", "leq", "<=", OM_SYM_relation1_leq},
  1838. {"relation1", "lt", "<", OM_SYM_relation1_lt},
  1839. {"relation1", "neq", "~=", OM_SYM_relation1_neq},
  1840. {"relation1", "approx", "OMunhandledSymbol", OM_SYM_relation1_approx},
  1841. {"rounding1", "ceiling", "ceiling", OM_SYM_rounding1_ceiling},
  1842. {"rounding1", "floor", "floor", OM_SYM_rounding1_floor},
  1843. {"rounding1", "trunc", "truncate", OM_SYM_rounding1_trunc},
  1844. {"rounding1", "round", "round", OM_SYM_rounding1_round},
  1845. /* FIXME: how to represent these in Axiom? */
  1846. /* {"setname1", "C", "????", OM_SYM_setname1_C},*/
  1847. /* {"setname1", "N", "????", OM_SYM_setname1_N},*/
  1848. /* {"setname1", "P", "????", OM_SYM_setname1_P},*/
  1849. /* {"setname1", "Q", "????", OM_SYM_setname1_Q},*/
  1850. /* {"setname1", "R", "????", OM_SYM_setname1_R},*/
  1851. /* {"setname1", "Z", "????", OM_SYM_setname1_Z},*/
  1852. {"set1", "in", "member?", OM_SYM_set1_in},
  1853. {"set1", "intersect", "intersect", OM_SYM_set1_intersect},
  1854. /* This is the same as for "in" but will be combined with the "not" symbol. */
  1855. {"set1", "notin", "member?", OM_SYM_set1_notin},
  1856. /* This is the same as for "prsubset" but will be combined with the "not" symbol. */
  1857. {"set1", "notprsubset", "<", OM_SYM_set1_notprsubset},
  1858. /* This is the same as for "subset" but will be combined with the "not" symbol. */
  1859. {"set1", "notsubset", "subset?", OM_SYM_set1_notsubset},
  1860. {"set1", "prsubset", "<", OM_SYM_set1_prsubset},
  1861. {"set1", "set", "set", OM_SYM_set1_set},
  1862. {"set1", "setdiff", "difference", OM_SYM_set1_setdiff},
  1863. {"set1", "subset", "subset?", OM_SYM_set1_subset},
  1864. {"set1", "union", "union", OM_SYM_set1_union},
  1865. {"set1", "size", "cardinality", OM_SYM_set1_size},
  1866. {"set1", "cartesian_product", "OMunhandledSymbol", OM_SYM_set1_cartesian_product},
  1867. {"set1", "emptyset", "empty", OM_SYM_set1_emptyset},
  1868. {"set1", "map", "map", OM_SYM_set1_map},
  1869. {"set1", "suchthat", "select", OM_SYM_set1_suchthat},
  1870. {"transc1", "arccos", "acos", OM_SYM_transc1_arccos},
  1871. {"transc1", "arcsin", "asin", OM_SYM_transc1_arcsin},
  1872. {"transc1", "arctan", "atan", OM_SYM_transc1_arctan},
  1873. {"transc1", "cos", "cos", OM_SYM_transc1_cos},
  1874. {"transc1", "cosh", "cosh", OM_SYM_transc1_cosh},
  1875. {"transc1", "cot", "cot", OM_SYM_transc1_cot},
  1876. {"transc1", "coth", "coth", OM_SYM_transc1_coth},
  1877. {"transc1", "csc", "csc", OM_SYM_transc1_csc},
  1878. {"transc1", "csch", "csch", OM_SYM_transc1_csch},
  1879. {"transc1", "exp", "exp", OM_SYM_transc1_exp},
  1880. {"transc1", "ln", "log", OM_SYM_transc1_ln},
  1881. {"transc1", "log", "log", OM_SYM_transc1_log},
  1882. {"transc1", "sec", "sec", OM_SYM_transc1_sec},
  1883. {"transc1", "sech", "sech", OM_SYM_transc1_sech},
  1884. /*MCDT*/
  1885. {"transc1", "sin", "sin", OM_SYM_transc1_sin},
  1886. {"transc1", "sinh", "sinh", OM_SYM_transc1_sinh},
  1887. {"transc1", "tan", "tan", OM_SYM_transc1_tan},
  1888. {"transc1", "tanh", "tanh", OM_SYM_transc1_tanh},
  1889. {"transc1", "arccosh", "acosh", OM_SYM_transc1_arccosh},
  1890. {"transc1", "arccot", "acot", OM_SYM_transc1_arccot},
  1891. {"transc1", "arccoth", "acoth", OM_SYM_transc1_arccoth},
  1892. {"transc1", "arccsc", "acsc", OM_SYM_transc1_arccsc},
  1893. {"transc1", "arccsch", "acsch", OM_SYM_transc1_arccsch},
  1894. {"transc1", "arcsec", "asec", OM_SYM_transc1_arcsec},
  1895. {"transc1", "arcsech", "asech", OM_SYM_transc1_arcsech},
  1896. {"transc1", "arcsinh", "asinh", OM_SYM_transc1_arcsinh},
  1897. {"transc1", "arctanh", "atanh", OM_SYM_transc1_arctanh},
  1898. {NULL, NULL, NULL, OM_YYERROR}
  1899. };
  1900. int findOMSymbol(char *cd, char *name)
  1901. {
  1902. int i, j;
  1903. /* First find the group of symbols from the correct CD. */
  1904. i = 0;
  1905. while (symTable[i].cd != NULL && strcmp(symTable[i].cd, cd) != 0)
  1906. i++;
  1907. if (symTable[i].cd == NULL)
  1908. return -1;
  1909. /* Now find the matching symbol from that group (if present). */
  1910. j = i;
  1911. while (symTable[j].cd != NULL) {
  1912. if (strcmp(symTable[j].cd, symTable[i].cd) != 0)
  1913. return -1;
  1914. else if (strcmp(symTable[j].name, name) == 0)
  1915. return j;
  1916. else
  1917. j++;
  1918. }
  1919. return -1;
  1920. }
  1921. YYSTYPE classifySymbol(Lisp_Object lsym)
  1922. {
  1923. Lisp_Object tmpObj;
  1924. char *cd = NULL;
  1925. char *name = NULL;
  1926. int len;
  1927. int i = 0;
  1928. /*DEBUG*/
  1929. /*Lprint(C_nil, lsym);*/
  1930. /*END DEBUG*/
  1931. /* Note: there is a strange serial dependency in the following code. If
  1932. * the block which gets the CD of the symbol occurs before the block which
  1933. * gets the name of the symbol, the symbol name will be corrupted in some
  1934. * cases. Very odd. (VH) --- This may not be valid any more... */
  1935. /* Get the name of the symbol. */
  1936. /*tmpObj = om_getLispProperty(lsym, MkUndefSymM("name"));*/
  1937. tmpObj = qcar(qcdr(lsym));
  1938. /*DEBUG*/
  1939. /*Lprint(C_nil, tmpObj);*/
  1940. /*END DEBUG*/
  1941. if (!stringp(tmpObj))
  1942. return OM_YYERROR;
  1943. name = get_string_data(tmpObj, "classifySymbol", &len);
  1944. assert(name != NULL);
  1945. name[len] = '\0';
  1946. /* Get the CD of the symbol. */
  1947. /*tmpObj = om_getLispProperty(lsym, MkUndefSymM("cd"));*/
  1948. tmpObj = qcar(lsym);
  1949. /*DEBUG*/
  1950. #if defined(YYDEBUG) && YYDEBUG == 1
  1951. Lprint(C_nil, tmpObj);
  1952. #endif
  1953. /*END DEBUG*/
  1954. if (!stringp(tmpObj))
  1955. return OM_YYERROR;
  1956. cd = get_string_data(tmpObj, "classifySymbol", &len);
  1957. assert(cd != NULL);
  1958. cd[len] = '\0';
  1959. /* Find the symbol in the symbol table, if it is present. */
  1960. i = findOMSymbol(cd, name);
  1961. /* If the symbol was recognised, return it. */
  1962. if (i != -1) {
  1963. yylval = StrToLspM(symTable[i].axname);
  1964. return symTable[i].token;
  1965. }
  1966. else return OM_YYERROR;
  1967. }
  1968. int yyerror(char *msg)
  1969. {
  1970. fprintf(stderr, "ERROR: %s\n", msg);
  1971. return 0;
  1972. }
  1973. YYSTYPE yylex()
  1974. {
  1975. OMtokenType ttype;
  1976. OMstatus status;
  1977. OMdev dev;
  1978. dev = om_toDev(ldev);
  1979. status = OMgetType(dev, &ttype);
  1980. /* The following code breaks file handling. MCD */
  1981. /* If we are listening to a socket (as opposed to reading from a file), we
  1982. * should block until more tokens become available. */
  1983. /* XXX
  1984. if (OMisSocketDevice(dev)) {
  1985. while (status == OMnoMoreToken)
  1986. */
  1987. status = OMgetType(dev, &ttype);
  1988. /* XXX
  1989. }
  1990. */
  1991. if (ttype == OMtokenUnknown || status != OMsuccess)
  1992. return 0;
  1993. else {
  1994. switch (ttype) {
  1995. case OMtokenApp:
  1996. yylval = om_getApp(C_nil, ldev);
  1997. return OM_APP;
  1998. case OMtokenEndApp:
  1999. yylval = om_getEndApp(C_nil, ldev);
  2000. return OM_ENDAPP;
  2001. case OMtokenAtp:
  2002. yylval = om_getAtp(C_nil, ldev);
  2003. return OM_ATP;
  2004. case OMtokenEndAtp:
  2005. yylval = om_getEndAtp(C_nil, ldev);
  2006. return OM_ENDATP;
  2007. case OMtokenAttr:
  2008. yylval = om_getAttr(C_nil, ldev);
  2009. return OM_ATTR;
  2010. case OMtokenEndAttr:
  2011. yylval = om_getEndAttr(C_nil, ldev);
  2012. return OM_ENDATTR;
  2013. case OMtokenBind:
  2014. yylval = om_getBind(C_nil, ldev);
  2015. return OM_BIND;
  2016. case OMtokenEndBind:
  2017. yylval = om_getEndBind(C_nil, ldev);
  2018. return OM_ENDBIND;
  2019. case OMtokenBVar:
  2020. yylval = om_getBVar(C_nil, ldev);
  2021. return OM_BVAR;
  2022. case OMtokenEndBVar:
  2023. yylval = om_getEndBVar(C_nil, ldev);
  2024. return OM_ENDBVAR;
  2025. case OMtokenError:
  2026. yylval = om_getError(C_nil, ldev);
  2027. return OM_ERROR;
  2028. case OMtokenEndError:
  2029. yylval = om_getEndError(C_nil, ldev);
  2030. return OM_ENDERROR;
  2031. case OMtokenObject:
  2032. yylval = om_getObject(C_nil, ldev);
  2033. return OM_OBJECT;
  2034. case OMtokenEndObject:
  2035. yylval = om_getEndObject(C_nil, ldev);
  2036. return OM_ENDOBJECT;
  2037. case OMtokenInt32:
  2038. case OMtokenBigInt:
  2039. yylval = om_getInt(C_nil, ldev);
  2040. return OM_INT;
  2041. case OMtokenFloat64:
  2042. yylval = om_getFloat(C_nil, ldev);
  2043. return OM_FLOAT;
  2044. case OMtokenByteArray:
  2045. yylval = om_getByteArray(C_nil, ldev);
  2046. return OM_BYTEARRAY;
  2047. case OMtokenVar:
  2048. yylval = om_getVar(C_nil, ldev);
  2049. return OM_VAR;
  2050. case OMtokenString:
  2051. yylval = om_getString(C_nil, ldev);
  2052. return OM_STRING;
  2053. case OMtokenSymbol:
  2054. yylval = om_getSymbol(C_nil, ldev);
  2055. return classifySymbol(yylval);
  2056. default:
  2057. return OM_YYERROR;
  2058. }
  2059. }
  2060. }
  2061. /**
  2062. * This function is exposed to the lisp interpreter, to allow it to parse
  2063. * OpenMath objects from a given string or device. The OpenMath object will be
  2064. * returned in a form suitable for use by the "interpret" function.
  2065. */
  2066. Lisp_Object om_read(Lisp_Object nil, Lisp_Object obj)
  2067. {
  2068. OMdev dev;
  2069. char *data = NULL;
  2070. int len, val;
  2071. CSL_IGNORE(nil);
  2072. push(obj);
  2073. inObj = nil;
  2074. if (stringp(obj)) {
  2075. data = get_string_data(obj, "om-read", &len);
  2076. errexitn(1);
  2077. if (data != NULL)
  2078. data[len] = '\0';
  2079. dev = OMmakeDevice(OMencodingXML, OMmakeIOString(&data));
  2080. ldev = om_fromDev(dev);
  2081. }
  2082. else if (is_bignum(obj) && ((bignum_length(obj) >> 2) - 1) == 1)
  2083. ldev = obj;
  2084. else
  2085. return aerror("om-read: argument must be a string or an OpenMath device.");
  2086. /* Turn parser tracing on. */
  2087. #if defined YYDEBUG && YYDEBUG == 1
  2088. yydebug = 1;/*DEBUG*/
  2089. #endif
  2090. val = yyparse();
  2091. yylval = C_nil;
  2092. if (stringp(obj))
  2093. OMcloseDevice(dev);
  2094. errexitn(1);
  2095. pop(obj);
  2096. #if defined YYDEBUG && YYDEBUG == 1
  2097. Lprint(C_nil, inObj);/*DEBUG*/
  2098. #endif
  2099. if (val == 0)
  2100. return onevalue(inObj);
  2101. else
  2102. return aerror("om-read: invalid OpenMath object.");
  2103. }
  2104. /**
  2105. * Will return the Lisp value true or false, depending on whether the named CD
  2106. * (the lcd parameter) is supported by this phrasebook.
  2107. */
  2108. Lisp_Object om_supportsCD(Lisp_Object nil, Lisp_Object lcd)
  2109. {
  2110. char *cd = NULL;
  2111. int len, i;
  2112. CSL_IGNORE(nil);
  2113. push(lcd);
  2114. if (!stringp(lcd))
  2115. return aerror("om-supportsCD: the argument must be a string");
  2116. errexitn(1);
  2117. cd = get_string_data(lcd, "om-supportsCD", &len);
  2118. errexitn(1);
  2119. if (cd == NULL)
  2120. return aerror("om-supportsCD: invalid CD name");
  2121. cd[len] = '\0';
  2122. for (i = 0; symTable[i].cd != NULL; i++) {
  2123. if (strcmp(symTable[i].cd, cd) == 0) {
  2124. pop(lcd);
  2125. return onevalue(StrToLspM("true"));
  2126. }
  2127. }
  2128. pop(lcd);
  2129. return onevalue(StrToLspM("false"));
  2130. }
  2131. /**
  2132. * Will return Lisp true or false, depending on whether the named symbol from
  2133. * the named CD is supported by this phrasebook.
  2134. */
  2135. Lisp_Object om_supportsSymbol(Lisp_Object nil, Lisp_Object lcd, Lisp_Object lsym)
  2136. {
  2137. char *cd = NULL;
  2138. char *sym = NULL;
  2139. int len, i;
  2140. CSL_IGNORE(nil);
  2141. push2(lcd, lsym);
  2142. if (!stringp(lcd))
  2143. return aerror("om-supportsSymbol: the content dictionary name must be a string");
  2144. else if (!stringp(lsym))
  2145. return aerror("om-supportsSymbol: the symbol name must be a string");
  2146. errexitn(2);
  2147. /* Note: there is a strange serial dependency in the following code. If
  2148. * the block which gets the CD of the symbol occurs before the block which
  2149. * gets the name of the symbol, the symbol name will be corrupted in some
  2150. * cases. Very odd. (VH) */
  2151. sym = get_string_data(lsym, "om-supportsSymbol received a corrupt symbol name", &len);
  2152. errexitn(2);
  2153. if (sym == NULL)
  2154. return aerror("om-supportsSymbol: invalid symbol name");
  2155. sym[len] = '\0';
  2156. cd = get_string_data(lcd, "om-supportsSymbol received a corrupt CD name", &len);
  2157. errexitn(2);
  2158. if (cd == NULL)
  2159. return aerror("om-supportsSymbol: invalid content dictionary name");
  2160. cd[len] = '\0';
  2161. pop2(lcd, lsym);
  2162. i = findOMSymbol(cd, sym);
  2163. if (i == -1)
  2164. return onevalue(StrToLspM("false"));
  2165. else
  2166. return onevalue(StrToLspM("true"));
  2167. }
  2168. /**
  2169. * Will return a list of the names of all CDs supported (partially or fully) by
  2170. * this phrasebook.
  2171. */
  2172. Lisp_Object MS_CDECL om_listCDs(Lisp_Object nil, int nargs, ...)
  2173. {
  2174. Lisp_Object lcds = nil;
  2175. Lisp_Object obj;
  2176. int i, j;
  2177. CSL_IGNORE(nil);
  2178. argcheck(nargs, 0, "om-listCDs: this function takes no arguments");
  2179. /* Find the end of the symbol table. */
  2180. for (i = 0; symTable[i].cd != NULL; i++) ;
  2181. /* Work backwards through the symbol table, consing new CD names into the
  2182. * list as they are encountered. */
  2183. j = i;
  2184. while (i > 0) {
  2185. i--;
  2186. if (symTable[j].cd == NULL && symTable[i].cd != NULL)
  2187. j = i;
  2188. else if (strcmp(symTable[i].cd, symTable[j].cd) != 0)
  2189. j = i;
  2190. if (j == i) {
  2191. lcds = cons(make_string(symTable[i].cd), lcds);
  2192. errexit();
  2193. }
  2194. }
  2195. obj = StrToLspM("construct");
  2196. errexit();
  2197. lcds = cons(obj, lcds);
  2198. errexit();
  2199. return onevalue(lcds);
  2200. }
  2201. /**
  2202. * Will return a list of all of the symbols from the named CD that are
  2203. * supported by this phrasebook.
  2204. */
  2205. Lisp_Object om_listSymbols(Lisp_Object nil, Lisp_Object lcd)
  2206. {
  2207. Lisp_Object lsyms = nil;
  2208. Lisp_Object obj;
  2209. char *cd = NULL;
  2210. int i, j, len;
  2211. CSL_IGNORE(nil);
  2212. push(lcd);
  2213. if (!stringp(lcd))
  2214. return aerror("om-listSymbols: the content dictionary name must be a string");
  2215. errexitn(1);
  2216. cd = get_string_data(lcd, "om-listSymbols", &len);
  2217. errexitn(1);
  2218. if (cd == NULL)
  2219. return aerror("om-listSymbols: invalid content dictionary name");
  2220. cd[len] = '\0';
  2221. for (i = 0; symTable[i].cd != NULL; i++) {
  2222. if (strcmp(symTable[i].cd, cd) == 0)
  2223. break;
  2224. }
  2225. if (symTable[i].cd == NULL) {
  2226. pop(lcd);
  2227. return nil;
  2228. }
  2229. for (j = i + 1; symTable[j].cd != NULL; j++) {
  2230. if (strcmp(symTable[j].cd, cd) != 0)
  2231. break;
  2232. }
  2233. for (j = j - 1; j >= i; j--) {
  2234. lsyms = cons(make_string(symTable[j].name), lsyms);
  2235. errexitn(1);
  2236. }
  2237. obj = StrToLspM("construct");
  2238. errexitn(1);
  2239. lsyms = cons(obj, lsyms);
  2240. errexitn(1);
  2241. pop(lcd);
  2242. return onevalue(lsyms);
  2243. }
  2244. /**
  2245. * This will return a list of the supported CDs that include the symbol with the
  2246. * given name.
  2247. */
  2248. Lisp_Object om_whichCDs(Lisp_Object nil, Lisp_Object lsym)
  2249. {
  2250. Lisp_Object lcds = nil;
  2251. Lisp_Object obj = nil;
  2252. char *sym = NULL;
  2253. int i, len;
  2254. CSL_IGNORE(nil);
  2255. push(lsym);
  2256. if (!stringp(lsym))
  2257. return aerror("om-whichCDs: symbol name must be a string");
  2258. errexitn(1);
  2259. sym = get_string_data(lsym, "om-whichCDs", &len);
  2260. errexitn(1);
  2261. if (sym == NULL)
  2262. return aerror("om-whichCDs: invalid symbol name");
  2263. sym[len] = '\0';
  2264. /* Find the end of the symbol table. */
  2265. for (i = 0; symTable[i].cd != NULL; i++) ;
  2266. while (i > 0) {
  2267. i--;
  2268. if (strcmp(symTable[i].name, sym) == 0) {
  2269. lcds = cons(make_string(symTable[i].cd), lcds);
  2270. errexitn(1);
  2271. }
  2272. }
  2273. obj = StrToLspM("construct");
  2274. errexitn(1);
  2275. lcds = cons(obj, lcds);
  2276. errexitn(1);
  2277. pop(lsym);
  2278. return onevalue(lcds);
  2279. }