home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / LF / SMALLTWE.LF < prev    next >
Text File  |  1996-06-04  |  10KB  |  303 lines
  1. % Abridged version of program from Twente (Maurice Keulen) that gives a GC
  2. % related bug (which is most probably due to running out of memory, since
  3. % the bug doesn't occur or occurs much later if memory size is increased,
  4. % and doesn't occur in a small version of the program like this one).
  5.  
  6. % If the ...1 part is commented out, then p? works fine.  Otherwise, p? chokes
  7. % in an infinite deref_ptr due to the fact that a large chunk of memory contains
  8. % the same value.  Bizarre fact: doing a single RETURN between the load(...)
  9. % and the query p? results in everything running normally!
  10. % BTW, the above behavior does not seem to be reproducible.
  11.  
  12. % The first part is buggy, since makeunique's retract fails (the structure 1+1
  13. % does not unify with real), and makeunique's assert does not evaluate N+1.
  14.  
  15. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  16.  
  17. % This query needs two garbage collections in 4096K of Life data space.
  18.  
  19. % Top level query
  20. p :-
  21.     initunique,
  22.     tmspec(CL,DB),
  23.     nl,pretty_writeq(buildhugetree([DB|CL])),nl.
  24.  
  25. buildhugetree(X:list) -> map(buildhugetree,X).
  26. buildhugetree(X) ->
  27.     cond(count(features(X))>0,
  28.         map(buildpair,map(feature_subterm(2=>X),features(X))),
  29.         X).
  30.  
  31. buildpair((L,S)) -> (L,buildhugetree(S),uniquename(dummy)).
  32.  
  33. count([]) -> 0.
  34. count([X|T]) -> 1+count(T).
  35.  
  36. % uniquename(Pre) : returns a name consisting of Pre and a unique number.
  37. uniquename(Pre) ->
  38.     str2psi(strcon(psi2str(Pre),num2str(N)))|makeunique(Pre,N).
  39. firstuniquename(Pre) ->
  40.     str2psi(strcon(psi2str(Pre),num2str(N)))
  41.         |(initunique(Pre),makeunique(Pre,N)).
  42. makeunique(Pre,N+1) :-
  43.     retract(instanceunique(Pre,N)), !,
  44.     assert(instanceunique(Pre,N+1)).
  45. makeunique(Pre,1) :-
  46.     assert(instanceunique(Pre,1)).
  47.  
  48. % initunique : Remove all instanceunique, perhaps of one kind U.
  49. initunique(U) :- retract(instanceunique(U,@)), !, initunique(U).
  50. initunique.
  51.  
  52. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  53.  
  54. % This query needs four garbage collections in 4096K of Life data space.
  55.  
  56. % Top level query, with corrected makeunique definition
  57. p1 :-
  58.     initunique1,
  59.     tmspec(CL,DB),
  60.     nl,pretty_writeq(buildhugetree1([DB|CL])),nl.
  61.  
  62. buildhugetree1(X:list) -> map(buildhugetree1,X).
  63. buildhugetree1(X) ->
  64.     cond(count1(features(X))>0,
  65.         map(buildpair1,map(feature_subterm(2=>X),features(X))),
  66.         X).
  67.  
  68. buildpair1((L,S)) -> (L,buildhugetree1(S),uniquename1(dummy)).
  69.  
  70. count1([]) -> 0.
  71. count1([X|T]) -> 1+count1(T).
  72.  
  73. % uniquename1(Pre) : returns a name consisting of Pre and a unique number.
  74. uniquename1(Pre) ->
  75.     str2psi(strcon(psi2str(Pre),num2str(N)))|makeunique1(Pre,N).
  76. firstuniquename1(Pre) ->
  77.     str2psi(strcon(psi2str(Pre),num2str(N)))
  78.         |(initunique1(Pre),makeunique1(Pre,N)).
  79. % makeunique1(Pre,X:(N+1)) :-
  80. %     retract(instanceunique1(Pre,N)), !,
  81. %     assert(instanceunique1(Pre,X)).
  82. makeunique1(Pre,X) :-
  83.     retract(instanceunique1(Pre,N)), !,
  84.     X=N+1,
  85.     assert(instanceunique1(Pre,X)).
  86. makeunique1(Pre,1) :-
  87.     assert(instanceunique1(Pre,1)).
  88.  
  89. % initunique1 : Remove all instanceunique, perhaps of one kind U.
  90. initunique1(U) :- retract(instanceunique1(U,@)), !, initunique1(U).
  91. initunique1.
  92.  
  93. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  94.  
  95. % Utilities needed to run this from a single file:
  96.  
  97. num2str(0) -> "0".
  98. num2str(1) -> "1".
  99. num2str(2) -> "2".
  100. num2str(3) -> "3".
  101. num2str(4) -> "4".
  102. num2str(5) -> "5".
  103. num2str(6) -> "6".
  104. num2str(7) -> "7".
  105. num2str(8) -> "8".
  106. num2str(9) -> "9".
  107. num2str(_A:int) -> cond(_A < 0,
  108.                         strcon("-",num2str(- _A)),
  109.                         strcon(num2str(_B:floor(_A / 10)),
  110.                                num2str(_A - _B * 10))).
  111.  
  112. feature_subterm(_A,_B) -> _A, _B._A.
  113.  
  114. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  115.  
  116. %
  117. % Generated parsetree as LIFE-psi-term for /home/misc_cis/keulen/tm/brock.tm
  118. %
  119. tmspec([
  120. auxclass("Tijd",[],rectype([attr('uren',basictype("int")),attr('minuten',basictype("int")),attr('seconden',basictype("int"))]),
  121. [constraint('uren',tmand(tmgeql(tmvar('uren',basictype("int")),constant("int",0)),tmleql(tmvar('uren',basictype("int")),constant("int",24)))),
  122. constraint('minuutjes',tmand(tmleql(tmvar('minuten',basictype("int")),constant("int",0)),tmleql(tmvar('minuten',basictype("int")),constant("int",60)))),
  123. constraint('sec',tmand(tmleql(tmvar('seconden',basictype("int")),constant("int",0)),tmleql(tmvar('seconden',basictype("int")),constant("int",60))))],
  124. [],
  125. [],
  126. [retmethod('Later',[colon('T',auxclasstype("Tijd"))],basictype("bool"),predcons(true))],
  127. [],
  128. []),
  129.  
  130. auxclass("Nat",["int"],notype,
  131. [],
  132. [],
  133. [],
  134. [],
  135. [],
  136. []),
  137.  
  138. auxclass("Pos_real",["real"],notype,
  139. [],
  140. [],
  141. [],
  142. [],
  143. [],
  144. []),
  145.  
  146. class("Instituut",[],'INSTITUTEN',[attr('adres',auxclasstype("Adres")),attr('naam',auxclasstype("String")),attr('telefoonnr',auxclasstype("Telefoonnummer"))],
  147. [],
  148. [['adres','naam']],
  149. [],
  150. [],
  151. [],
  152. [],
  153. []),
  154.  
  155. auxclass("Ziekenhuis_datum",["Datum"],notype,
  156. [],
  157. [],
  158. [],
  159. [],
  160. [],
  161. []),
  162.  
  163. class("Huisarts",["Instituut"],'HUISARTSEN',[attr('registratienr',auxclasstype("String"))],
  164. [],
  165. [['registratienr']],
  166. [],
  167. [],
  168. [],
  169. [],
  170. []),
  171.  
  172. class("Tandarts",["Instituut"],'TANDARTSEN',notype,
  173. [],
  174. [],
  175. [],
  176. [],
  177. [],
  178. [],
  179. []),
  180.  
  181. class("Apotheek",["Instituut"],'APOTHEKEN',notype,
  182. [],
  183. [],
  184. [],
  185. [],
  186. [],
  187. [],
  188. []),
  189.  
  190. class("Specialist",["Medewerker"],'SPECIALISTEN',[attr('specialismen',settype(auxclasstype("String")))],
  191. [constraint('identiteitsnr',tmeql(methcall('Len',tmvar('identiteitsnr',auxclasstype("String")),[]),constant("int",3)))],
  192. [],
  193. [],
  194. [],
  195. [],
  196. [],
  197. []),
  198.  
  199. class("Vroegere_specialist",["Specialist"],'VROEGERE_SPECIALISTEN',[attr('uitdiensttreding',auxclasstype("Ziekenhuis_datum"))],
  200. [constraint('uitdiensttreding',methcall('Later',tmvar('uitdiensttreding',auxclasstype("Ziekenhuis_datum")),[tmvar('indiensttreding',auxclasstype("Ziekenhuis_datum"))]))],
  201. [],
  202. [],
  203. [],
  204. [],
  205. [],
  206. []),
  207.  
  208. class("Medisch_personeel",["Werknemer"],'MEDISCH_PERSONEEL',[attr('vooropleiding',auxclasstype("String"))],
  209. [],
  210. [],
  211. [],
  212. [],
  213. [],
  214. [],
  215. []),
  216.  
  217. class("Niet_medisch_personeel",["Werknemer"],'NIET_MEDISCH_PERSONEEL',[attr('functiecode',auxclasstype("String")),attr('maandvergoeding',auxclasstype("Pos_real")),attr('vrijedagen',auxclasstype("Nat"))],
  218. [constraint('R31',tmleql(tmvar('maandvergoeding',auxclasstype("Pos_real")),tmvar('maandsalaris',auxclasstype("Pos_real"))))],
  219. [],
  220. [],
  221. [],
  222. [],
  223. [],
  224. []),
  225.  
  226. class("Verplicht_verzekerde",["Werknemer"],'VERPLICHT_VERZEKERDEN',[attr('apotheek',classtype("Apotheek")),attr('huisarts',classtype("Regio_arts")),attr('tandarts',classtype("Tandarts")),attr('ziekenfondsnr',auxclasstype("String"))],
  227. [constraint('ziekenfondsnummer',tmleql(methcall('Len',tmvar('ziekenfondsnr',auxclasstype("String")),[]),constant("int",8)))],
  228. [['ziekenfondsnr']],
  229. [],
  230. [],
  231. [],
  232. [],
  233. []),
  234.  
  235. class("Particulier_verzekerde",["Werknemer"],'PARTICULIER_VERZEKERDEN',[attr('polisnr',auxclasstype("String")),attr('verzekeraar',classtype("Verzekeraar"))],
  236. [],
  237. [['polisnr']],
  238. [],
  239. [],
  240. [],
  241. [],
  242. []),
  243.  
  244. class("Verzekeraar",["Instituut"],'VERZEKERAARS',notype,
  245. [],
  246. [],
  247. [],
  248. [],
  249. [],
  250. [],
  251. []),
  252.  
  253. class("Plaats",[],'PLAATSEN',[attr('plaatsnaam',auxclasstype("String")),attr('contactpersoon',classtype("Niet_medisch_personeel")),attr('dienstdoende_arts',classtype("Regio_arts")),attr('dienstdoende_apotheek',classtype("Apotheek")),attr('inwonertal',auxclasstype("Nat"))],
  254. [],
  255. [['plaatsnaam']],
  256. [],
  257. [],
  258. [],
  259. [],
  260. []),
  261.  
  262. class("Lopende_opnamen",["Opname"],'LOPENDE_OPNAMEN',[attr('vertrekdatum',auxclasstype("Ziekenhuis_datum"))],
  263. [constraint('R59',methcall('Later',tmvar('vertrekdatum',auxclasstype("Ziekenhuis_datum")),[tmvar('opnamedatum',auxclasstype("Ziekenhuis_datum"))]))],
  264. [['patient']],
  265. [],
  266. [],
  267. [],
  268. [],
  269. []),
  270.  
  271. class("Overdracht",[],'OVERDRACHTEN',[attr('patient',classtype("Patient")),attr('datum',auxclasstype("Ziekenhuis_datum")),attr('specialist',classtype("Specialist")),attr('opnamereden',auxclasstype("String"))],
  272. [],
  273. [['datum','patient']],
  274. [],
  275. [],
  276. [],
  277. [],
  278. []),
  279.  
  280. class("Overplaatsing",[],'OVERPLAATSINGEN',[attr('patient',classtype("Patient")),attr('datum',auxclasstype("Ziekenhuis_datum")),attr('ruimte',classtype("Verpleegruimte")),attr('bevindingen',auxclasstype("String"))],
  281. [],
  282. [['datum','patient']],
  283. [],
  284. [],
  285. [],
  286. [],
  287. []),
  288.  
  289. class("Behandeling",[],'BEHANDELING',[attr('code',auxclasstype("String")),attr('naam',auxclasstype("String")),attr('soort',auxclasstype("String")),attr('tarief',auxclasstype("Pos_real")),attr('minimum_duur',auxclasstype("Tijd")),attr('maximum_duur',auxclasstype("Tijd")),attr('prognose_frequentie',auxclasstype("Nat"))],
  290. [constraint('duur',tmnot(methcall('Later',tmvar('minimum_duur',auxclasstype("Tijd")),[tmvar('maximum_duur',auxclasstype("Tijd"))])))],
  291. [['code'],['naam']],
  292. [],
  293. [],
  294. [],
  295. [],
  296. [])],
  297.  
  298. database([],
  299. [constraint('R08',tmforall(domin('x',tmvar('PATIENTEN',settype(classtype("Patient")))),tmexists(domin('p',tmvar('PLAATSEN',settype(classtype("Plaats")))),tmeql(recsel(recsel(tmvar('x',classtype("Patient")),'adres'),'woonplaats'),recsel(tmvar('p',classtype("Plaats")),'plaatsnaam'))))),
  300. constraint('R73',tmforall(domin('x',tmvar('OVERPLAATSINGEN',settype(classtype("Overplaatsing")))),tmor(tmexists(domin('y',tmvar('LOPENDE_OPNAMEN',settype(classtype("Lopende_opnamen")))),tmand(tmeql(recsel(tmvar('x',classtype("Overplaatsing")),'patient'),recsel(tmvar('y',classtype("Lopende_opnamen")),'patient')),methcall('Eerder',recsel(tmvar('y',classtype("Lopende_opnamen")),'opnamedatum'),[recsel(tmvar('x',classtype("Overplaatsing")),'datum')]))),tmexists(domin('y',tmvar('BEEINDIGDE_OPNAMEN',settype(classtype("Beeindigde_opname")))),tmand(tmand(tmeql(recsel(tmvar('x',classtype("Overplaatsing")),'patient'),recsel(tmvar('y',classtype("Beeindigde_opname")),'patient')),methcall('Eerder',recsel(tmvar('y',classtype("Beeindigde_opname")),'opnamedatum'),[recsel(tmvar('x',classtype("Overplaatsing")),'datum')])),methcall('Eerder',recsel(tmvar('x',classtype("Overplaatsing")),'datum'),[recsel(tmvar('y',classtype("Beeindigde_opname")),'ontslagdatum')]))))))],[],[])).
  301.  
  302. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  303.