home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / DJD1 < prev    next >
Text File  |  1996-06-16  |  41KB  |  1,629 lines
  1. Wild_Life Interpreter Version +VERSION+ +DATE+
  2. Copyright (C) 1991-93 DEC Paris Research Laboratory
  3. Extensions, Copyright (C) 1994-1995 Intelligent Software Group, SFU
  4. X interface not installed.
  5. name in = ~SETUP
  6. *** Using file name: 'e:\src\plan\life\life-1.02\lf\SETUP'
  7. file = e:\src\plan\life\life-1.02\lf\SETUP
  8. name in = stdin
  9. *** Using file name: 'stdin'
  10. file = stdin
  11. name in = stdin
  12. *** Using file name: 'stdin'
  13. file = stdin
  14.  
  15. non_strict(public) ? %name in = stdin
  16. *** Using file name: 'stdin'
  17. file = stdin
  18. % BD June 10 1993
  19.  
  20. public(public)?
  21. name in = stdin
  22. *** Using file name: 'stdin'
  23. file = stdin
  24. public(str2psi)?
  25. name in = stdin
  26. *** Using file name: 'stdin'
  27. file = stdin
  28. public(c_op)?
  29. name in = stdin
  30. *** Using file name: 'stdin'
  31. file = stdin
  32. public(xfy)?
  33. name in = stdin
  34. *** Using file name: 'stdin'
  35. file = stdin
  36. public(xfx)?
  37. name in = stdin
  38. *** Using file name: 'stdin'
  39. file = stdin
  40.  
  41. public(yfx)?  %name in = stdin
  42. *** Using file name: 'stdin'
  43. file = stdin
  44. % BD June 10 1993
  45. public(fx)?
  46. name in = stdin
  47. *** Using file name: 'stdin'
  48. file = stdin
  49. public(fy)?
  50. name in = stdin
  51. *** Using file name: 'stdin'
  52. file = stdin
  53. public(xf)?
  54. name in = stdin
  55. *** Using file name: 'stdin'
  56. file = stdin
  57. public(yf)?
  58. name in = stdin
  59. *** Using file name: 'stdin'
  60. file = stdin
  61.  
  62. public(set_module)?
  63. name in = stdin
  64. *** Using file name: 'stdin'
  65. file = stdin
  66. public(open_module)?
  67. name in = stdin
  68. *** Using file name: 'stdin'
  69. file = stdin
  70.  
  71.  
  72. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  73. % S Y N T A X
  74.  
  75. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  76.  
  77. set_module("syntax")?
  78. name in = stdin
  79. *** Using file name: 'stdin'
  80. file = stdin
  81. built_ins#open_module("built_ins")?
  82. name in = stdin
  83. *** Using file name: 'stdin'
  84. file = stdin
  85.  
  86. % The problem guys:
  87. c_op(1000,xfy,',')?
  88. name in = stdin
  89. *** Using file name: 'stdin'
  90. file = stdin
  91. c_op(700,xfx,=)?
  92. name in = stdin
  93. *** Using file name: 'stdin'
  94. file = stdin
  95.  
  96.  
  97. A=str2psi("{"),public(A)?
  98. name in = stdin
  99. *** Using file name: 'stdin'
  100. file = stdin
  101. A=str2psi("}"),public(A)?
  102. name in = stdin
  103. *** Using file name: 'stdin'
  104. file = stdin
  105. A=str2psi("["),public(A)?
  106. name in = stdin
  107. *** Using file name: 'stdin'
  108. file = stdin
  109. A=str2psi("]"),public(A)?
  110. name in = stdin
  111. *** Using file name: 'stdin'
  112. file = stdin
  113.  
  114. % A=str2psi("("),public(A)?
  115. % A=str2psi(")"),public(A)?
  116. % A=str2psi("?"),public(A)?
  117.  
  118. A=str2psi("."),public(A)?
  119. name in = stdin
  120. *** Using file name: 'stdin'
  121. file = stdin
  122. A=str2psi(","),public(A)?
  123. name in = stdin
  124. *** Using file name: 'stdin'
  125. file = stdin
  126. A=str2psi("{}"),public(A)?
  127. name in = stdin
  128. *** Using file name: 'stdin'
  129. file = stdin
  130.  
  131.  
  132. public(
  133.  
  134. '!', '#', '$<', '$>', '$>=', '$\==', '&', '*', '+', ',', '-', '->', '/',
  135. '//', '/\', ':', ':-', '::', ':<', ':=', ':=<', ':==', ':>', ':><', ':>=',
  136. ':\<', ':\=<', ':\==', ':\>', ':\><', ':\>=', ';', '<', '<-', '<<', '<<-',
  137. '<|', '=', '=:=', '=<', '===', '\===', '=>', '=\=', '>', '>=', '>>', '@',
  138. '\/', '^', '`', 'and', 'end_of_file', 'or', 'not', 'xor', 'mod', '|', '\'
  139.  
  140. % , '<<<-'   Obsolete % RM: Feb 24 1993 
  141.  
  142. )?
  143. name in = stdin
  144. *** Using file name: 'stdin'
  145. file = stdin
  146.  
  147. public('\+','$==','$=<') ?    %name in = stdin
  148. *** Using file name: 'stdin'
  149. file = stdin
  150. % BD June 10 1993
  151.  
  152.  
  153. % Operator declarations.
  154. % Insofar as possible, these correspond with ISO standard Prolog.
  155.  
  156. % Declarations of sorts, functions, and predicates.
  157. c_op(1200,xfx,:-)?
  158. name in = stdin
  159. *** Using file name: 'stdin'
  160. file = stdin
  161. c_op(1200,xfx,->)?
  162. name in = stdin
  163. *** Using file name: 'stdin'
  164. file = stdin
  165. c_op(1200,xfx,<|)?
  166. name in = stdin
  167. *** Using file name: 'stdin'
  168. file = stdin
  169. c_op(1200,fx,::)?
  170. name in = stdin
  171. *** Using file name: 'stdin'
  172. file = stdin
  173. c_op(1200,xfx,:=)?
  174. name in = stdin
  175. *** Using file name: 'stdin'
  176. file = stdin
  177.  
  178. % Control flow inside of predicates.
  179. c_op(1150,xfx,|)?
  180. name in = stdin
  181. *** Using file name: 'stdin'
  182. file = stdin
  183. c_op(1100,xfy,;)? 
  184. name in = stdin
  185. *** Using file name: 'stdin'
  186. file = stdin
  187. c_op(900,fy,'\+')?
  188. name in = stdin
  189. *** Using file name: 'stdin'
  190. file = stdin
  191.  
  192. % Unification predicate and lookalikes.
  193. c_op(700,xfx,<-)?
  194. name in = stdin
  195. *** Using file name: 'stdin'
  196. file = stdin
  197. c_op(700,xfx,<<-)?
  198. name in = stdin
  199. *** Using file name: 'stdin'
  200. file = stdin
  201.  
  202. % Functions.
  203. % All expressions have precedence < 700.
  204. % PVR 24.2.94: changed according to Bruno's suggestion
  205. c_op(675,yfx,or)?
  206. name in = stdin
  207. *** Using file name: 'stdin'
  208. file = stdin
  209. c_op(675,yfx,xor)? %name in = stdin
  210. *** Using file name: 'stdin'
  211. file = stdin
  212.  PVR 10.2.94
  213. c_op(650,yfx,and)? 
  214. name in = stdin
  215. *** Using file name: 'stdin'
  216. file = stdin
  217. c_op(625,fy,not)? %name in = stdin
  218. *** Using file name: 'stdin'
  219. file = stdin
  220.  PVR 10.2.94
  221.  
  222. c_op(600,xfx,===)?
  223. name in = stdin
  224. *** Using file name: 'stdin'
  225. file = stdin
  226. c_op(600,xfx,\===)?
  227. name in = stdin
  228. *** Using file name: 'stdin'
  229. file = stdin
  230.  
  231. % Arithmetic comparisons 
  232. c_op(600,xfx,<)?
  233. name in = stdin
  234. *** Using file name: 'stdin'
  235. file = stdin
  236. c_op(600,xfx,>)?
  237. name in = stdin
  238. *** Using file name: 'stdin'
  239. file = stdin
  240. c_op(600,xfx,=<)?
  241. name in = stdin
  242. *** Using file name: 'stdin'
  243. file = stdin
  244. c_op(600,xfx,>=)?
  245. name in = stdin
  246. *** Using file name: 'stdin'
  247. file = stdin
  248. c_op(600,xfx,=:=)?
  249. name in = stdin
  250. *** Using file name: 'stdin'
  251. file = stdin
  252. c_op(600,xfx,=\=)?
  253. name in = stdin
  254. *** Using file name: 'stdin'
  255. file = stdin
  256.  
  257. % String comparisons
  258. c_op(600,xfx,$<)?
  259. name in = stdin
  260. *** Using file name: 'stdin'
  261. file = stdin
  262. c_op(600,xfx,$>)?
  263. name in = stdin
  264. *** Using file name: 'stdin'
  265. file = stdin
  266. c_op(600,xfx,$=<)?
  267. name in = stdin
  268. *** Using file name: 'stdin'
  269. file = stdin
  270. c_op(600,xfx,$>=)?
  271. name in = stdin
  272. *** Using file name: 'stdin'
  273. file = stdin
  274. c_op(600,xfx,$==)?
  275. name in = stdin
  276. *** Using file name: 'stdin'
  277. file = stdin
  278. c_op(600,xfx,$\==)?
  279. name in = stdin
  280. *** Using file name: 'stdin'
  281. file = stdin
  282.  
  283. % Sort comparisons
  284. c_op(600,xfx,:<)?
  285. name in = stdin
  286. *** Using file name: 'stdin'
  287. file = stdin
  288. c_op(600,xfx,:>)?
  289. name in = stdin
  290. *** Using file name: 'stdin'
  291. file = stdin
  292. c_op(600,xfx,:=<)?
  293. name in = stdin
  294. *** Using file name: 'stdin'
  295. file = stdin
  296. c_op(600,xfx,:>=)?
  297. name in = stdin
  298. *** Using file name: 'stdin'
  299. file = stdin
  300. c_op(600,xfx,:==)?
  301. name in = stdin
  302. *** Using file name: 'stdin'
  303. file = stdin
  304. c_op(600,xfx,:><)?
  305. name in = stdin
  306. *** Using file name: 'stdin'
  307. file = stdin
  308. c_op(600,xfx,:\<)?
  309. name in = stdin
  310. *** Using file name: 'stdin'
  311. file = stdin
  312. c_op(600,xfx,:\>)?
  313. name in = stdin
  314. *** Using file name: 'stdin'
  315. file = stdin
  316. c_op(600,xfx,:\=<)?
  317. name in = stdin
  318. *** Using file name: 'stdin'
  319. file = stdin
  320. c_op(600,xfx,:\>=)?
  321. name in = stdin
  322. *** Using file name: 'stdin'
  323. file = stdin
  324. c_op(600,xfx,:\==)?
  325. name in = stdin
  326. *** Using file name: 'stdin'
  327. file = stdin
  328. c_op(600,xfx,:\><)?
  329. name in = stdin
  330. *** Using file name: 'stdin'
  331. file = stdin
  332.  
  333. % Arithmetic operations
  334. c_op(500,yfx,+)?
  335. name in = stdin
  336. *** Using file name: 'stdin'
  337. file = stdin
  338. c_op(500,yfx,-)?
  339. name in = stdin
  340. *** Using file name: 'stdin'
  341. file = stdin
  342. c_op(500,yfx,/\)?
  343. name in = stdin
  344. *** Using file name: 'stdin'
  345. file = stdin
  346. c_op(500,yfx,\/)?
  347. name in = stdin
  348. *** Using file name: 'stdin'
  349. file = stdin
  350.  
  351. c_op(400,yfx,*)?
  352. name in = stdin
  353. *** Using file name: 'stdin'
  354. file = stdin
  355. c_op(400,yfx,//)?
  356. name in = stdin
  357. *** Using file name: 'stdin'
  358. file = stdin
  359. c_op(400,yfx,/)?
  360. name in = stdin
  361. *** Using file name: 'stdin'
  362. file = stdin
  363. c_op(400,yfx,>>)?
  364. name in = stdin
  365. *** Using file name: 'stdin'
  366. file = stdin
  367. c_op(400,yfx,<<)?
  368. name in = stdin
  369. *** Using file name: 'stdin'
  370. file = stdin
  371. c_op(400,yfx,mod)? %name in = stdin
  372. *** Using file name: 'stdin'
  373. file = stdin
  374.  PVR 24.2.94
  375. c_op(200,fy,-)? %name in = stdin
  376. *** Using file name: 'stdin'
  377. file = stdin
  378.  PVR 24.2.94
  379. c_op(200,xfy,^)?
  380. name in = stdin
  381. *** Using file name: 'stdin'
  382. file = stdin
  383. c_op(200,fy,\)?
  384. name in = stdin
  385. *** Using file name: 'stdin'
  386. file = stdin
  387.  
  388. % Unify function and coreference tag
  389. c_op(150,yfx,.)? %name in = stdin
  390. *** Using file name: 'stdin'
  391. file = stdin
  392.  PVR 24.2.94
  393. c_op(100,xfy,&)?   %name in = stdin
  394. *** Using file name: 'stdin'
  395. file = stdin
  396.  RM: Feb  1 1993  % PVR 24.2.94
  397. c_op(75,fy,`)?  %name in = stdin
  398. *** Using file name: 'stdin'
  399. file = stdin
  400.  RM: Feb  1 1993 % PVR 24.2.94
  401. c_op(50,xfy,:)? %name in = stdin
  402. *** Using file name: 'stdin'
  403. file = stdin
  404.  PVR 24.2.94
  405.  
  406. %%% Old stuff:
  407.  
  408. % c_op(700,xfx,<<<-) ?  % RM: Feb  8 1993    Obsolete % RM: Feb 24 1993 
  409. % c_op(695,fx,`)?  % Quote is loosest of the functions
  410. % c_op(500,xfy,\)?
  411. % c_op(500,fx,+)? PVR 24.2.94
  412. % c_op(500,fx,-)? PVR 24.2.94
  413.  
  414. % Project operator
  415. % c_op(400,yfx,##)?   % RM: Jan  7 1993
  416.  
  417. %% c_op(300,yfx,mod)? BD June 10 1993
  418.  
  419. % Module operator
  420. % c_op(130,xfy,#)?   % RM: Jan  7 1993 
  421.  
  422.  
  423. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  424. % B U I L T _ I N 
  425.  
  426. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  427.  
  428. built_ins#set_module("built_ins")?
  429. name in = stdin
  430. *** Using file name: 'stdin'
  431. file = stdin
  432.  
  433. open_module("syntax")? %name in = stdin
  434. *** Using file name: 'stdin'
  435. file = stdin
  436.  This module contains symbols init. in built_ins.c
  437. % open_module("x")?
  438.  
  439. %% BD June 11 1993
  440. global(tools_dir<-"+SETUPDIR+/Tools/") ?
  441. name in = stdin
  442. *** Using file name: 'stdin'
  443. file = stdin
  444.  
  445. global(examples_dir<-"+SETUPDIR+/Examples/") ?
  446. name in = stdin
  447. *** Using file name: 'stdin'
  448. file = stdin
  449. global(superlint_dir<-"+SETUPDIR+/Examples/SuperLint/") ?
  450. name in = stdin
  451. *** Using file name: 'stdin'
  452. file = stdin
  453. global(demo_dir<-"+SETUPDIR+/Demo/") ? %name in = stdin
  454. *** Using file name: 'stdin'
  455. file = stdin
  456. % MJV January 16 1996
  457. global(lib_dir<-"+SETUPDIR+/Lib/") ?
  458. name in = stdin
  459. *** Using file name: 'stdin'
  460. file = stdin
  461.  
  462. simple_load("~built_in.lf") ?       %name in = stdin
  463. *** Using file name: 'stdin'
  464. file = stdin
  465. name in = ~built_in.lf
  466. *** Using file name: 'e:\src\plan\life\life-1.02\lf\built_in.lf'
  467. file = e:\src\plan\life\life-1.02\lf\built_in.lf
  468. % Copyright 1991 Digital Equipment Corporation.
  469. % All Rights Reserved.
  470. %
  471. % The BUILT_IN module
  472. %
  473. % This file should not be modified by the user.
  474. %
  475. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  476. %    $Id: built_ins.lf.in,v 1.2 1996/01/17 00:47:28 vorbeck Exp $    
  477.  
  478. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  479. %
  480. % Declarations
  481. %
  482. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  483.  
  484. %%% public built_ins
  485.  
  486. public(trace_input, query, declaration, error, abort, aborthook,abs, append,
  487.        apply, asc, assert, asserta, bagof, beep, begin_raw, bool,
  488.        bool_pred,bi_load_path, call_once,
  489.        call_handler, ceiling, children, chr, clause,
  490.        close, cond, cons, copy_pointer, copy_rules, copy_term, cos, cpu_time,
  491.        current_module, delay_check, disj, display_module_status,
  492.        display_modules, dynamic, end_raw, eval, evalin, exists_file,
  493.        exists_choice, exp, fail, false, features, floor, fx, fy, gc, genint,
  494.        get, get_choice, get_raw, glb, halt, has_feature, implies, in_raw,
  495.        inherited_modules, init, initrandom, input_file, int, int2str,
  496.        is_function, is_number, is_predicate, is_sort, is_value, least_sorts,
  497.        length,life_ext, list, listing, load, load_module,
  498.        load_path,load_suffixes, loaded_file, local_time, log, lub, map, maprel,
  499.        max, maxint, member, min, module, mresiduate, nil, nl, nl_err,
  500.        non_strict, nonvar, op, open, open_in, open_modules, open_out, ops,
  501.        % not, PVR 10.2.94
  502.        page_width, parents, parse, pause, pretty_write, pretty_writeq,
  503.        print_codes, print_depth, print_variables, private, project,
  504.        psi2str, public, put, put_err, put_raw, random, read, read_token, real,
  505.        real_time, reduce, repeat, reset_window_flag, residuate, retract, rlist,
  506.        root_sort, run, set_choice, set_input, set_output, setq, simple_load,
  507.        sin, sqrt, static, statistics, step, str, str2psi, strcon, string,
  508.        strip, strlen, strval, subsort, substr, succeed,system, tan,
  509.        time, tprove, trace, true, undo, var, verbose, window_flag,
  510.        write, write_canonical, write_err, writeq, writeq_err, import,
  511.        % xor, PVR 10.2.94
  512.        substitute,is_persistent, global, persistent, display_persistent, alias,
  513.        bestof, % RM: Apr 15 1993
  514.        private_feature, % RM: Mar 11 1993
  515.        split_double,     % RM: Jun 29 1993
  516.        string_address,    % RM: Jul 6 1993
  517.        deref_length,     % RM: Jul 15 1993
  518.        argv,             % RM: Sep 20 1993  PVR 11.2.94
  519.        public_symbols,    % RM: Jan 28 1994
  520.        chdir,         % RM: Feb 10 1994
  521.        getenv,         % RM: Feb 10 1994
  522.        module_name,    % RM: Feb 16 1994
  523.        combined_name,    % RM: Feb 16 1994
  524.        quiet,           % BD: Feb 17 1994
  525.        feature_values)?
  526. name in = stdin
  527. *** Using file name: 'stdin'
  528. file = stdin
  529.  
  530. %%% These are considered private:
  531. %%% '*** ERROR ***', '<NULL PSI TERM>',
  532. %%% bottom,comment,constant,variable,init
  533.  
  534. private(c_op)? %name in = stdin
  535. *** Using file name: 'stdin'
  536. file = stdin
  537.  RM: Feb 24 1993
  538.  
  539.  
  540. %%% Operators
  541.  
  542. % c_op(300,yfx,mod)? PVR 24.2.94
  543.  
  544.  
  545. %%% Built-in sorts.
  546.  
  547. cons <| list.
  548. nil <| list.
  549. list <| built_in.
  550.  
  551. string <| built_in.
  552.  
  553. real <| built_in.
  554. int <| real.
  555.  
  556. bool <| built_in.
  557. true <| bool.
  558. false <| bool.
  559.  
  560. %%% non strict declarations
  561.  
  562. non_strict(non_strict)?
  563. name in = stdin
  564. *** Using file name: 'stdin'
  565. file = stdin
  566. non_strict(dynamic)?
  567. name in = stdin
  568. *** Using file name: 'stdin'
  569. file = stdin
  570. non_strict(static)?
  571. name in = stdin
  572. *** Using file name: 'stdin'
  573. file = stdin
  574. non_strict(delay_check)?
  575. name in = stdin
  576. *** Using file name: 'stdin'
  577. file = stdin
  578. non_strict(listing)?
  579. name in = stdin
  580. *** Using file name: 'stdin'
  581. file = stdin
  582. non_strict(evalin)?
  583. name in = stdin
  584. *** Using file name: 'stdin'
  585. file = stdin
  586. non_strict(eval)?
  587. name in = stdin
  588. *** Using file name: 'stdin'
  589. file = stdin
  590. non_strict(global) ?           %name in = stdin
  591. *** Using file name: 'stdin'
  592. file = stdin
  593. % BD 3.3.94
  594. non_strict(persistent) ?       %name in = stdin
  595. *** Using file name: 'stdin'
  596. file = stdin
  597. % BD 3.3.94
  598.  
  599. %%% SYSTEM MODULE
  600.  
  601. built_ins#set_module("sys")?
  602. name in = stdin
  603. *** Using file name: 'stdin'
  604. file = stdin
  605. built_ins#open_module("syntax")?
  606. name in = stdin
  607. *** Using file name: 'stdin'
  608. file = stdin
  609.  
  610. built_ins#public
  611.     (bitvector,regexp,stream,file_stream,socket_stream,
  612.      make_bitvector,bitvector_and,bitvector_or,bitvector_xor,
  613.      bitvector_not,bitvector_count,bitvector_get,bitvector_set,
  614.      bitvector_clear,
  615.      regexp_compile,regexp_execute,
  616.      fopen,fclose,get_buffer,get_record,get_code,ftell,fseek,
  617.      socket,bind,connect,fwrite,fflush,listen,accept,
  618.      errno,errmsg,
  619.      import_symbol,
  620.      process_no_children,process_exited,process_signaled,
  621.      process_stopped,process_continued,
  622.      fork,wait,waitpid,kill,int2stream,stdin,stdout,stderr,
  623.      cuserid,gethostname,lazy_project,wait_on_feature,my_wait_on_feature,
  624.      apply1,getpid,ftruncate,stream2sys_stream,sys_stream2stream
  625. %     @DBM_LF@
  626. )?
  627. name in = stdin
  628. *** Using file name: 'stdin'
  629. file = stdin
  630.  
  631. % built_ins#non_strict(wait_on_feature)?
  632.  
  633. bytedata  <| built_ins#built_in. % DENYS: BYTEDATA
  634. bitvector <| bytedata.
  635. regexp    <| bytedata.
  636. stream    <| bytedata.
  637. file_stream   <| stream.
  638. socket_stream <| stream.
  639.  
  640. built_ins#global(stdin  <- int2stream(0,"r")&file_stream)?
  641. name in = stdin
  642. *** Using file name: 'stdin'
  643. file = stdin
  644. built_ins#global(stdout <- int2stream(1,"w")&file_stream)?
  645. name in = stdin
  646. *** Using file name: 'stdin'
  647. file = stdin
  648. built_ins#global(stderr <- int2stream(2,"w")&file_stream)?
  649. name in = stdin
  650. *** Using file name: 'stdin'
  651. file = stdin
  652.  
  653. built_ins#persistent(string_out)?
  654. name in = stdin
  655. *** Using file name: 'stdin'
  656. file = stdin
  657. string_out <<-
  658.     S:fopen(Path:built_ins#strcon("/tmp/.life",
  659.                       built_ins#psi2str(getpid)),"w+")
  660.     |
  661.     0=built_ins#system(built_ins#strcon("rm ",Path)),%unlink was non portable
  662.     S.stream = sys_stream2stream(S),
  663.     S.stdout = (O|built_ins#open_out("stdout",O))?
  664. name in = stdin
  665. *** Using file name: 'stdin'
  666. file = stdin
  667.  
  668. psi2string(X) -> S | psi2stringX(X,S).
  669.  
  670. psi2stringX(X,S) :-
  671.     fseek(O:string_out,0),
  672.     built_ins#set_output(O.stream),
  673.     built_ins#writeq(X),
  674.     fflush(O),
  675.     built_ins#set_output(O.stdout),
  676.     N=ftell(O),
  677.     fseek(O,0),
  678.     S=get_buffer(O,N).
  679.  
  680. built_ins#public(psi2string)?
  681. name in = stdin
  682. *** Using file name: 'stdin'
  683. file = stdin
  684.  
  685. built_ins#set_module("built_ins")?
  686. name in = stdin
  687. *** Using file name: 'stdin'
  688. file = stdin
  689.  
  690. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  691.  
  692. %%%  For correct operation of the interpreter, nothing before this line should
  693. %%%  be modified.  What comes after is used for definition of built-ins and can
  694. %%%  be edited (albeit very carefully).
  695.  
  696. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  697.  
  698.  
  699. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  700. %
  701. % System built-ins
  702. %
  703. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  704.  
  705. %%% call once must be a boolean function for use in cond
  706. %non_strict(call_once)?                              %% DENYS Jan 25 1995
  707. %call_once(G) -> T | (evalin(G),T=true;T=false),!. %% DENYS Jan 25 1995
  708.  
  709. %%% A more useful listing predicate from the c_listing built-in.
  710.  
  711. non_strict(listing)?
  712. name in = stdin
  713. *** Using file name: 'stdin'
  714. file = stdin
  715. X:listing :-
  716.     %%    trace(T,U),   % RM: Dec  9 1992 
  717.     listing_2(features(X), X).
  718.     %%    trace(T,U).
  719.  
  720. listing_2([],    _) :- !.
  721. listing_2([F],   X) :- !, nl, listing_3(F, X).
  722. listing_2([F|L], X) :- nl, listing_3(F, X), listing_2(L, X).
  723.  
  724. listing_3(F, X) :- P=X.F, c_listing(P), listing_4(P).
  725.  
  726. listing_4(P) :- var(P), !,
  727.         write("% '@' is the top sort."), nl.
  728. %% listing_4(P:int)    :- !, listing_4a(int).
  729. %% listing_4(P:real)   :- !, listing_4a(real).
  730. %% listing_4(P:string) :- !, listing_4a(string).
  731. listing_4(P) :- listing_4a(P).
  732.  
  733. listing_4a(P) :- is_sort(P), is_value(P)=false, !, 
  734.     listing_5(parents(P), P),
  735.         listing_6(children(P), P).
  736.     % write("% Parents: "),writeq(parents(P)), nl,
  737.     % write("% Children: "),writeq(children(P)), nl.
  738.  
  739.  
  740. listing_4a(_).
  741.  
  742. listing_5([], _) :- !.
  743. listing_5([X|Xs], Y) :-
  744.     writeq(Y), write(" <| "), writeq(X), write("."), nl,
  745.     listing_5(Xs, Y).
  746.  
  747. listing_6([], _) :- !.
  748. listing_6([X|Xs], Y) :-
  749.     writeq(X), write(" <| "), writeq(Y), write("."), nl,
  750.     listing_6(Xs, Y).
  751.  
  752.  
  753. %%% An op predicate that handles any pattern of arguments. 
  754.  
  755. non_strict(op)?
  756. name in = stdin
  757. *** Using file name: 'stdin'
  758. file = stdin
  759. op(P,K,F,precedence=>P,kind=>K,functor=>F) :-
  760.     trace(T,U),
  761.     ( op_2(P,K,F), trace(T,U)
  762.     ; trace(T,U), fail
  763.     ).
  764.  
  765. op_2(P,K,F) :- nonvar(P), nonvar(K), nonvar(F), F=list, !, op_3(F,P,K).
  766. op_2(P,K,F) :- nonvar(F), F=list, !,
  767.     write_err("*** Error: invalid operator declaration."),
  768.     nl_err.
  769. op_2(P,K,F) :- nonvar(P), nonvar(K), nonvar(F), !, c_op(P,K,F).
  770. op_2(P,K,F) :- member(op(P,K,F),ops).
  771.  
  772. % List of operators.
  773. op_3([]) :- !.
  774. op_3([H|T],P,K) :- op_2(P,K,H),op_3(T,P,K).
  775.  
  776.  
  777. %%% Default call handler.
  778. %%% This is called for predicates that have no definition.
  779. %%% More sophisticated call handlers can be written to do auto-loading
  780. %%% of undefined predicates.
  781.  
  782. call_handler(P) :- is_sort(P), !,
  783.     write_err("*** Error: the sort '"),writeq_err(P),
  784.         write_err("' occurs where a predicate or function is expected."),
  785.     nl_err, abort.
  786. call_handler(P) :- !,
  787.     write_err("*** Error: '"),writeq_err(P),
  788.         write_err("' is not a predicate or a function."), nl_err,
  789.     abort.
  790.  
  791.  
  792. %%% Pause for N seconds.
  793. pause(N) :-
  794.     S=real_time,
  795.     repeat,
  796.     real_time-S>N,
  797.     !.
  798.  
  799. %%% Time a goal (whether it succeeds or fails).
  800. run(G) :-
  801.     S=cpu_time,
  802.     (G;succeed),
  803.     !,
  804.     write("Time = ",cpu_time-S," sec"),
  805.     nl.
  806.  
  807.  
  808. %%% Personal customizing.
  809.  
  810. init :-
  811.     exists_file("./.wild_life"),
  812.     simple_load("./.wild_life"),
  813.     quiet_write("Loaded customizing file from current directory."),
  814.     !.
  815.  
  816. init :-
  817.     exists_file("~/.wild_life"),
  818.     simple_load("~/.wild_life"),
  819.     quiet_write("Loaded customizing file from home directory."),
  820.     !.
  821.  
  822. init :-
  823.     quiet_write("No customizing file loaded."),
  824.     !.
  825.  
  826. %% init :-                                        %% was in .set_up
  827. %%     exists_file("+SETUPDIR+/.wild_life"),
  828. %%     simple_load("+SETUPDIR+/.wild_life"),
  829. %%     write("Loaded default customizing file."), nl
  830. %%     !.
  831.  
  832. init :-
  833.     write_err("*** Warning: couldn't access any customizing file."),
  834.     nl_err.
  835.  
  836.  
  837. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  838. %
  839. % Input-Output
  840. %
  841. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  842.  
  843. %%% Newline
  844.  
  845. nl :- write("
  846. ").
  847.  
  848. nl_err :- write_err("
  849. ").
  850.  
  851.  
  852. %%% Beep
  853.  
  854. beep :- put(7).
  855.  
  856.  
  857. %%% Quiet writing for support of '-q' option
  858. %%% This built-in doesn't write anything if the '-q' option is enabled.
  859. %%% 21.1 & RM: Feb 17 1993 
  860.  
  861. quiet_write :- quiet, !.
  862. S:quiet_write :- quiet_write_loop(features(S),S), nl.
  863.  
  864. quiet_write_loop([]) :- !.
  865. quiet_write_loop([X|L], S) :-
  866.     write(S.X),
  867.     quiet_write_loop(L, S).
  868.  
  869.  
  870.  
  871. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  872. %
  873. % Loading Files
  874. %
  875. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  876.  
  877. %%% A very useful load that searches a path, does suffix completion,
  878. %%% and remembers if a file has already been loaded.
  879. %%% The default path may be extended by an optional user-defined function
  880. %%% load_path that gives a disjunction of directories to search in.
  881. %%% The set of default suffixes may be extended by an optional user-defined
  882. %%% function load_suffixes that gives a disjunction of suffixes.
  883. %%% This predicate accepts an arbitrary number of arguments.
  884.  
  885. persistent(load_option,top_load,loading) ?
  886. name in = stdin
  887. *** Using file name: 'stdin'
  888. file = stdin
  889. load_option <<- false ?
  890. name in = stdin
  891. *** Using file name: 'stdin'
  892. file = stdin
  893. loading <<- false ?
  894. name in = stdin
  895. *** Using file name: 'stdin'
  896. file = stdin
  897.  
  898. non_strict(load)?
  899. name in = stdin
  900. *** Using file name: 'stdin'
  901. file = stdin
  902. X:load :-
  903.     CM = current_module,
  904.     F = features(X),
  905.     (
  906.         loading,!,
  907.         load_2(F,X)
  908.     ;
  909.         loading <<- true,
  910.         top_load <<- get_choice,
  911.         load_2(F,X),!,loading <<- false
  912.     ;
  913.         open_out("stdout",_),
  914.         open_in("stdin",_),
  915.         set_module(CM),
  916.         loading <<- false,
  917.         fail
  918.     ).
  919.  
  920. load_2([F|L],X) :-
  921.     (
  922.         find_file(X.F,CF),!,
  923.         (
  924.         has_feature(CF,consulted,Bool),!,
  925.         quiet_write("*** File """,CF,""" is already loaded.")
  926.         ;
  927.         quiet_write("*** Loading File """,CF,""""),
  928.         first_load(CF)
  929.         ),
  930.         load_2(L,X)
  931.     ;
  932.         set_choice(top_load),fail
  933.     ).
  934. load_2([]).
  935.  
  936. first_load(CF) :-
  937.     (
  938.         load_option,!,
  939.         consulted.CF <<- true,
  940.         simple_exp_load(CF)
  941.     ;
  942.         consulted.CF <<- false,
  943.         simple_load(CF)
  944.     ).
  945.  
  946. find_file(F:string,CF) :-
  947.     !,
  948.         (
  949.         CF=strcon(bi_load_path,
  950.               strcon(F,
  951.                  life_ext)),
  952.         exists_file(CF), !
  953.     ;
  954.         write_err("*** File """,F,""" not found."),nl_err,
  955.         fail 
  956.     ).
  957. find_file(F) :-
  958.     write_err("*** Error: File name "),
  959.     writeq_err(F),
  960.     write_err(" should be a string."),
  961.     nl_err,
  962.     fail.
  963.  
  964. bi_load_path ->  {
  965.              ""
  966.                  ;
  967.              strcon((load_path | is_function(`load_path)),
  968.                 %% {"";"/"}
  969.                 "/"
  970.                )
  971.          ;
  972.              lib_dir
  973.          ;
  974.              tools_dir
  975.                  ; %% "+SETUPDIR+/Examples/"   % BD June 10 1993
  976.              examples_dir
  977.          ;
  978.              superlint_dir
  979.          ; %% For the Demo Directory   % MJV January 16 1996
  980.              demo_dir
  981.          }.
  982.  
  983. %%% The user may define a function load_suffixes that returns a
  984. %%% disjunction of other suffixes to be used.
  985. life_ext -> { ".lf"
  986.             ; ""
  987.         ; (load_suffixes | is_function(`load_suffixes))
  988.         ; ".life"
  989.         }.
  990.  
  991.  
  992. %%% reconsult facility
  993.  
  994. public(reconsult) ?
  995. name in = stdin
  996. *** Using file name: 'stdin'
  997. file = stdin
  998.  
  999. non_strict(reconsult)?
  1000. name in = stdin
  1001. *** Using file name: 'stdin'
  1002. file = stdin
  1003.  
  1004. X:reconsult :-
  1005.     CM = current_module,
  1006.     F = features(X),
  1007.     (
  1008.         loading,!,
  1009.         reconsult_2(F,X)
  1010.     ;
  1011.         loading <<- true,
  1012.         top_load <<- get_choice,
  1013.         reconsult_2(F,X),!,loading <<- false
  1014.     ;
  1015.         open_out("stdout",_),
  1016.         open_in("stdin",_),
  1017.         set_module(CM),
  1018.         loading <<- false,
  1019.         fail
  1020.     ).
  1021.  
  1022. reconsult_2([F|L],X) :-
  1023.     find_file(X.F,CF),!,
  1024.     (
  1025.         has_feature(CF,consulted,Bool),!,
  1026.         (
  1027.         Bool,!,
  1028.         reload(CF,Bool)
  1029.         ;
  1030.         write_err("*** File """,CF,""" cannot be reconsulted."),
  1031.         nl_err
  1032.         )
  1033.     ;
  1034.         quiet_write("*** Loading File """,CF,""""),
  1035.         first_load(CF)
  1036.     ),
  1037.     reconsult_2(L,X).
  1038. reconsult_2([]).
  1039.  
  1040.  
  1041. reload(CF,Bool) :-
  1042.     retract_file(Bool),
  1043.     quiet_write("*** Reconsulting File """,CF,""""),
  1044.     quiet_write(" "),
  1045.     quiet_write("*** Warning: sort,public,non_strict and operators ",
  1046.             "declarations are not undone."),
  1047.     quiet_write("***          Rules added using queries in the ",
  1048.             "file are not retracted."),
  1049.     quiet_write(" "),
  1050.     first_load(CF).
  1051.  
  1052.  
  1053. retract_file(B) :-
  1054.     X = current_module,
  1055.     retract_modules(features(B),B),
  1056.     set_module(X).
  1057.  
  1058. retract_modules([M1|Ms],B) :- !,
  1059.     M = psi2str(M1),
  1060.     %% set_module(M),
  1061.     retract_functions(features(B.M1.functions,M),B.M1.functions), 
  1062.     retract_predicates(features(B.M1.preds,M),B.M1.preds).
  1063. retract_modules([]).
  1064.  
  1065. retract_functions([F|Fs]) :- !,
  1066.     (
  1067.         retract_all_f(F)
  1068.     ;
  1069.         retract_functions(Fs)
  1070.     ).
  1071. retract_functions([]).
  1072. retract_predicates([F|Fs]) :- !,
  1073.     (
  1074.         retract_all_p(F)
  1075.     ;
  1076.         retract_predicates(Fs)
  1077.     ).
  1078. retract_predicates([]).
  1079.  
  1080.  
  1081. retract_all_f(F) :-
  1082.     retract((F -> @)),
  1083.     retract_all_f(F).
  1084. retract_all_p(F) :-
  1085.     retract((F :- @)),
  1086.     retract_all_p(F).
  1087.  
  1088.  
  1089.  
  1090. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1091. %
  1092. % Meta features
  1093. %
  1094. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1095.  
  1096. %%% Negation
  1097.  
  1098. \+ X :- X,!,fail.
  1099. (\+) .
  1100.  
  1101. %%% Quote
  1102.  
  1103. non_strict(`)?
  1104. name in = stdin
  1105. *** Using file name: 'stdin'
  1106. file = stdin
  1107. `X -> X.
  1108.  
  1109.  
  1110. %%% Definition of bagof using non-backtrackable destructive assignment.
  1111. %%% bagof(X,G) -> R:[]:cond(call_once((G,R<<-[X|R],fail)),R,R). % (19.8)
  1112. %%% This version does not allow non-residuating functions in G &
  1113. %%% "leaks" the evaluation of G into X on the outside:
  1114. %%% bagof(X,G) -> R:[] | (G,R<<-[X|R],fail ; true).
  1115.  
  1116. %%% This version seems to be completely clean:
  1117. %%% non_strict(bagof)?
  1118. %%% bagof(X,G) -> R:[] | (evalin(G),R<<-[evalin(X)|R],fail ; R<-copy_term(R)).
  1119.  
  1120. %%% New version using persistent terms:     RM: Feb 16 1993 
  1121. %%% The old version had a complexity of O(n2), now down to O(n).
  1122.  
  1123. non_strict(bagof)?
  1124. name in = stdin
  1125. *** Using file name: 'stdin'
  1126. file = stdin
  1127. bagof(X,G) -> N |
  1128.         L<<-[],
  1129.         ((evalin(G),                         % Prove G
  1130.           L<<-[evalin(X)|copy_pointer(L)],   % Record the binding of X
  1131.           fail)                              % Force back-tracking on G
  1132.         ;
  1133.          (N<-copy_term(L))).                 % Copy the resulting global term
  1134.                                              % back onto the stack.
  1135.  
  1136.  
  1137. %%% Best solution to a goal by some relation:
  1138.  
  1139. non_strict(bestof)?
  1140. name in = stdin
  1141. *** Using file name: 'stdin'
  1142. file = stdin
  1143. bestof(X,R,G) -> N |
  1144.        L<<-first_value,
  1145.        (evalin(G),                         % Prove G
  1146.     cond(L:==first_value,              % Record the binding of X
  1147.          L<<-evalin(X),
  1148.          cond(R(X,L),                  % Compare to last value
  1149.           L<<-evalin(X),
  1150.           succeed)),
  1151.     fail                               % Force back-tracking on G
  1152.     ;
  1153.         N<-copy_term(L)).                  % Copy the resulting global term
  1154.                                            % back onto the stack.
  1155.  
  1156.  
  1157. % Reducing a monoidal binary operator over a list:
  1158. reduce(F,E,[H|T]) -> F(H,reduce(F,E,T)).
  1159. reduce(F,E,[]) -> E.
  1160.  
  1161. % Mapping a function over a list:
  1162. map(F,[H|T])->[F(H)|map(F,T)].
  1163. map(F,[])->[].
  1164.  
  1165. % Mapping a unary relation over a list:
  1166. maprel(P,[H|T]) :- !,root_sort(P) & @(H),maprel(P,T).
  1167. maprel(P,[]).
  1168.  
  1169.  
  1170.  
  1171. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1172. %
  1173. % Basic Lists Manipulation
  1174. %
  1175. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1176.  
  1177. append([H|T],L:list)->[H|append(T,L)].
  1178. append([],L:list)->L.
  1179.  
  1180. length([H|T])->1+length(T).
  1181. length([])->0.
  1182.  
  1183. member(X,[X|_]).
  1184. member(X,[_|L]) :- member(X,L).
  1185.  
  1186. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1187. %
  1188. % Arithmetic
  1189. %
  1190. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1191.  
  1192. A^N:int -> cond(N<0,1/pwr(A,-N),pwr(A,N)).
  1193.  
  1194. pwr(A,0) -> 1.
  1195. pwr(A,1) -> A.
  1196. % PVR 24.2.94
  1197. pwr(A,N) -> cond((N /\ 1)=:=0, X*X, X*X*A) | X=pwr(A,N>>1).
  1198. % pwr(A,N) -> A*pwr(A,(N-1)).
  1199.  
  1200. abs(R) -> cond(R<0,-R,R).
  1201. max(A,B) -> cond(A>B,A,B).
  1202. min(A,B) -> cond(A>B,B,A).
  1203.  
  1204.  
  1205. % Generate a unique integer for each call to genint
  1206. persistent(genint_counter)?
  1207. name in = stdin
  1208. *** Using file name: 'stdin'
  1209. file = stdin
  1210. genint_counter<<-0?
  1211. name in = stdin
  1212. *** Using file name: 'stdin'
  1213. file = stdin
  1214. genint -> copy_term(genint_counter) | genint_counter<<-genint_counter+1.
  1215.  
  1216.  
  1217. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1218. %
  1219. % String Manipulation
  1220. %
  1221. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1222.  
  1223. "" $== "" -> true.
  1224. S1:string $== S2:string ->
  1225.     (asc(S1)=:=asc(S2)) and
  1226.     lenstreq(substr(S1,2,L1:strlen(S1)),substr(S2,2,L2:strlen(S2)),L1,L2).
  1227.  
  1228. lenstreq("","",_,_) -> true.
  1229. lenstreq(S1,S2,L1,L2) ->
  1230.     L1=:=L2 and L1>0 and (asc(S1)=:=asc(S2)) and
  1231.     lenstreq(substr(S1,2,LL1:(L1-1)),substr(S2,2,LL2:(L2-1)),LL1,LL2).
  1232.  
  1233. "" $=< string -> true.
  1234. string $=< "" -> false.
  1235. S1:string $=< S2:string ->
  1236.     (C1:asc(S1)<C2:asc(S2))
  1237.     or
  1238.     (C1=:=C2 and lenstrle(substr(S1,2,L1:strlen(S1)),
  1239.                               substr(S2,2,L2:strlen(S2)),
  1240.                               L1,L2)).
  1241.  
  1242. lenstrle("",string,_,_) -> true.
  1243. lenstrle(string,"",_,_) -> false.
  1244. lenstrle(S1,S2,L1,L2) ->
  1245.     (C1:asc(S1) < C2:asc(S2))
  1246.     or
  1247.     (C1=:=C2 and lenstrle(substr(S1,2,LL1:(L1-1)),
  1248.                               substr(S2,2,LL2:(L2-1)),
  1249.                               LL1,LL2)).
  1250.  
  1251. S1:string $< S2:string -> S1$=<S2 and not(S1$==S2).
  1252. S1:string $> S2:string -> not(S1$=<S2).
  1253. S1:string $>= S2:string -> not(S1$=<S2) or S1$==S2.
  1254. S1:string $\== S2:string -> not(S1$==S2).
  1255.  
  1256. %%% Convert "any" psi-term to a string.
  1257. %%% This converts strings to themselves, integers to a string giving their
  1258. %%% value, and other psi-terms to a string giving their print name.
  1259.  
  1260. str(X) -> cond(is_value(X),strval(X),psi2str(X)).
  1261.  
  1262. strval(S:string) -> S.
  1263. strval(N:int) -> int2str(N).
  1264.  
  1265.  
  1266. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1267. %
  1268. %  Declarations of support of modules      RM: Jan  6 1993
  1269. %
  1270. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1271.  
  1272. module(N) :-
  1273.     N:<string,
  1274.         !,
  1275.     set_module(N),
  1276.     setq(open_modules,[]),
  1277.     setq(inherited_modules,[]),
  1278.     open("syntax"),
  1279.     open("built_ins"),
  1280.     open("x").
  1281.                         
  1282. module(N) :-                                     % PVR 13.9.93
  1283.     write_err("*** Error: module name '"),writeq_err(N),
  1284.     write_err("' should be a string"),
  1285.     nl_err.
  1286.  
  1287. X:open :- open_list(features(X), X).
  1288.  
  1289. open_list([]) :- !.
  1290. open_list([F|FL], X) :- open_one(X.F), open_list(FL, X).
  1291.  
  1292. open_one(N:string) :- !,
  1293.     open_module(N),
  1294.     setq(open_modules,[N|open_modules]).
  1295.  
  1296. open_one(N) :-                                   % PVR 13.9.93
  1297.     write_err("*** Error: module argument '"),writeq_err(N),
  1298.     write_err("' of open should be a string"),
  1299.     nl_err.
  1300.  
  1301.  
  1302. display_module_status :-
  1303.     write("%%%%%%%%%%%%%%%%%%%%"),nl,
  1304.     write("%%% current module: ",current_module),nl,
  1305.     write("%%% open modules: ",open_modules),nl,
  1306.     write("%%% inherited modules: ",inherited_modules),nl,
  1307.     write("%%%%%%%%%%%%%%%%%%%%"),nl.
  1308.  
  1309.  
  1310. public(import_clauses)?
  1311. name in = stdin
  1312. *** Using file name: 'stdin'
  1313. file = stdin
  1314. non_strict(import_clauses)?
  1315. name in = stdin
  1316. *** Using file name: 'stdin'
  1317. file = stdin
  1318.  
  1319. import_clauses(for => Sort,
  1320.                replacing => RepList) :-
  1321.  
  1322.     (
  1323.         is_function(Sort),
  1324.         (Connect = ->) ;
  1325.         
  1326.         is_predicate(Sort),
  1327.         (Connect = :-) ;
  1328.         
  1329.         write_err("*** Import: ",Sort," is not a predicate or function"),
  1330.         nl_err,
  1331.         fail
  1332.         ),
  1333.     ! ,
  1334.     get_and_replace(Sort,Connect,RepList);
  1335.     succeed.
  1336.  
  1337.  
  1338. get_and_replace(Sort,Connect,RepList) :-
  1339.     Connect=@(Sort,Body),
  1340.     clause(Connect),
  1341.     %%    write("Importing clause:"),
  1342.     %%    nl,
  1343.     %%    writeq(Connect),
  1344.     %%    nl,
  1345.     replace(Connect,RepList),
  1346.     %%    write("as clause:"),
  1347.     %%    nl,
  1348.     %%    writeq(Connect),
  1349.     %%    nl,
  1350.     %%    nl,
  1351.     R=root_sort(Connect.1),
  1352.     dynamic(R),
  1353.     assert(Connect),
  1354.     fail.
  1355.  
  1356.  
  1357. replace(Connect,[]) :- ! .
  1358. replace(Connect,[(A,B)|T]) :-
  1359.     substitute(A,B,Connect),
  1360.     replace(Connect,T).
  1361.  
  1362.  
  1363. %%% PVR 13.9.93
  1364. non_strict(import)?
  1365. name in = stdin
  1366. *** Using file name: 'stdin'
  1367. file = stdin
  1368. X:import :-
  1369.     load&strip(X),
  1370.     import_list(features(X), X).
  1371.  
  1372. import_list([]) :- !.
  1373. import_list([F|FL], X) :- import_one(X.F), import_list(FL,X).
  1374.  
  1375. import_one(X) :-
  1376.     Module =remove_path(X),
  1377.     (open(Module),!;succeed).
  1378.  
  1379. remove_path(File) -> remove_path_loop(File,strlen(File)).
  1380.  
  1381. remove_path_loop(File,0) -> File.
  1382. remove_path_loop(File,L) -> cond(L<1,
  1383.                  File,
  1384.                  cond(substr(File,L,1) $== "/",
  1385.                       substr(File,L+1,strlen(File)-L),
  1386.                       remove_path_loop(File,L-1))).
  1387.  
  1388. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1389. %
  1390. %  Compatibility with older versions 
  1391. %
  1392. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1393.  
  1394. project(A,B) -> B.A.
  1395.  
  1396.  
  1397. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1398. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1399. %%
  1400. %% Obsolete
  1401. %%
  1402. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1403. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1404.  
  1405. %%%public('\+','$==','$=<', c_op,append_file, built_in, day, encode,
  1406. %%%       freeze,functor,genint_counter, hour, inf_loop, kind, lenstreq,
  1407. %%%       lenstrle,c_listing,  minute, month, precedence, second, stream,
  1408. %%%       warning, 
  1409. %%%       weekday, where, set_module, open_module,xf, xfx, xfy, yf, yfx,
  1410. %%%       new_block, block_struct, block_valueintset,block_valuerealset,
  1411. %%%       block_valueintget,block_valuerealget,block_subblockset,
  1412. %%%       block_subblockget,is_block,same_block, block_privateintget,
  1413. %%%       block_privateintset,block_privaterealget,block_privaterealset,
  1414. %%%       block_wake,
  1415. %%%       c_xareallzero, c_xareallpos, c_xareallneg,
  1416. %%%       c_xelm, c_xadd_basic, c_xclean_linear, c_xobjective,
  1417. %%%       syntax
  1418. %%%      ) ?
  1419.  
  1420. %%%c_op(1200,fx,block_struct)?    % RM 20 Jan 93
  1421.  
  1422.  
  1423. %%%% To force a type encoding.
  1424. %%%encode?
  1425.  
  1426. %%% non_strict(global)?  %% RM: Apr  8 1993 
  1427.  
  1428. %%%non_strict(assert)?  %% 17.9
  1429. %%%non_strict(asserta)?  %% 17.9
  1430. %%%non_strict(clause)?  %% 17.9
  1431. %%%non_strict(retract)?  %% 17.9
  1432. %%%non_strict(cond)? %% 24.8
  1433.  
  1434. %%%A ## B -> A.B.
  1435.  
  1436.  
  1437. %%%A poor man's global variable update:
  1438. %%%set(X,V) :- retract((X->@)), !, assert((X->V)).
  1439. %%%set(X,V) :- dynamic(X), assert((X->V)).
  1440.  
  1441. %%%This has become a C built-in:
  1442. %%%non_strict(setq)?
  1443. %%%setq(X,V) :- Value = eval(V), retract((X->@)), !, assert((X->Value)).
  1444. %%%setq(X,V) :- dynamic(X), Value = eval(V), assert((X->Value)).
  1445.  
  1446.  
  1447. %%%These are removed since their functionality is subsumed by that of
  1448. %%%unification.
  1449. %%%Lisp pseudo-compatibility.
  1450. %%%nil -> [].
  1451. %%%cons(H,T) -> [H|T].
  1452. %%%car([H|T]) -> H.
  1453. %%%cdr([H|T]) -> T.
  1454.  
  1455. %%%Repeat.
  1456. %%%repeat.
  1457. %%%repeat :- repeat.
  1458.  
  1459. %%%Handy for functional programming.
  1460. %%%where -> @.
  1461.  
  1462. %%%Logic functions (some are C built-ins).
  1463.  
  1464. %%%and(false,bool) -> false.
  1465. %%%and(bool,false) -> false.
  1466. %%%and(true,true) -> true.
  1467.  
  1468. %%%or(true,bool) -> true.
  1469. %%%or(bool,true) -> true.
  1470. %%%or(false,false) -> false.
  1471.  
  1472. % PVR 10.2.94
  1473. %%%not(true) -> false.
  1474. %%%not(false) -> true.
  1475. %%%xor(true,false) -> true.
  1476. %%%xor(false,true) -> true.
  1477. %%%xor(bool,bool) -> false.
  1478.  
  1479. %%%dynamic(genint_counter)?
  1480. %%%genint_counter -> 0.
  1481. %%%genint -> N:genint_counter | setq(genint_counter,N+1).
  1482.  
  1483. %%%This works but results in several genints in the same expression
  1484. %%%all getting the same resulting value:
  1485. %%%persistent(genint_counter)?
  1486. %%%genint_counter<<-0?
  1487. %%%genint -> N:genint_counter | genint_counter<<-N+1.
  1488.  
  1489. %%%This is now a C built-in:
  1490. %%%int2str(N:int) -> cond(N<0,
  1491. %%%                       strcon("-",num(-N)),
  1492. %%%                       num(N)).
  1493.  
  1494. %%%num(N) -> cond(N<10,
  1495. %%%                   psi2str(chr(N+48)),
  1496. %%%                   strcon(num(Q:floor(N/10)),num(N-Q*10))).
  1497.  
  1498. %%%This is the same speed:
  1499. %%%num2str(0) -> "0".
  1500. %%%num2str(1) -> "1".
  1501. %%%num2str(2) -> "2".
  1502. %%%num2str(3) -> "3".
  1503. %%%num2str(4) -> "4".
  1504. %%%num2str(5) -> "5".
  1505. %%%num2str(6) -> "6".
  1506. %%%num2str(7) -> "7".
  1507. %%%num2str(8) -> "8".
  1508. %%%num2str(9) -> "9".
  1509. %%%num2str(N:int) ->
  1510. %%%        cond(N<0,
  1511. %%%             strcon("-",num2str(-N)),
  1512. %%%             strcon(num2str(Q:floor(N/10)),num2str(N-Q*10))).
  1513.  
  1514. %%% nl :- put(10).
  1515. %%% nl_err :- put_err(10).
  1516. %%% Infinite loop.
  1517. %%% inf_loop -> inf_loop.
  1518.  
  1519. %%%copy_rules(Symbol,SourceModule,NewName) :-
  1520. %%%    load_module(SourceModule),
  1521. %%%    var(NewName),
  1522. %%%    copy_rules(Symbol,SourceModule,NewName).
  1523.  <EOF>
  1524. name in = stdin
  1525. *** Using file name: 'stdin'
  1526. file = stdin
  1527. % BD June 10 1993
  1528. simple_load("~term_expansion.lf") ?
  1529. name in = stdin
  1530. *** Using file name: 'stdin'
  1531. file = stdin
  1532. name in = ~term_expansion.lf
  1533. *** Using file name: 'e:\src\plan\life\life-1.02\lf\term_expansion.lf'
  1534. file = e:\src\plan\life\life-1.02\lf\term_expansion.lf
  1535. format = 94ebc file '%s' does not exist.
  1536.  
  1537. format2 = 94ebc file '%s' does not exist.
  1538.  
  1539. simple_load("~onlinedoc.lf")?
  1540. name in = stdin
  1541. *** Using file name: 'stdin'
  1542. file = stdin
  1543. name in = ~onlinedoc.lf
  1544. *** Using file name: 'e:\src\plan\life\life-1.02\lf\onlinedoc.lf'
  1545. file = e:\src\plan\life\life-1.02\lf\onlinedoc.lf
  1546. format = 94ebc file '%s' does not exist.
  1547.  
  1548. format2 = 94ebc file '%s' does not exist.
  1549.  
  1550.  
  1551. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1552. % X start up.
  1553.  
  1554. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1555.  
  1556. % PVR 13.10.93
  1557.  
  1558. % persistent(x_loaded), x_loaded<<-false?
  1559.  
  1560. % public(x_loaded)?
  1561. % persistent(x_loaded)?
  1562. % x_loaded<<-false?
  1563.  
  1564. % public(load_x)?
  1565. % dynamic(load_x)?
  1566. % 
  1567. % load_x :-
  1568. %     retract(load_x :- G),
  1569. %     assert((load_x :- write_err("*** X library already loaded."),nl)),
  1570. %     quiet_write("Loading X library..."),
  1571. %     simple_load("~xpublic.lf"),      % RM: Jan 13 1993 
  1572. %     simple_load("~xconstants.lf"),
  1573. %     simple_load("~xtables.lf"),
  1574. %     simple_load("~xgetset.lf"),
  1575. %     simple_load("~xpred.lf").
  1576. % 
  1577. %%  simple_load("~xfunctions.lf"),  % RM: Mar 11 1993 
  1578. % 
  1579.   
  1580. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1581.  
  1582. % Get ready for user input
  1583.  
  1584. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1585.  
  1586. % The 'user' module:
  1587.  
  1588. display_modules(false) ?
  1589. name in = stdin
  1590. *** Using file name: 'stdin'
  1591. file = stdin
  1592.  
  1593. module("user")?
  1594. name in = stdin
  1595. *** Using file name: 'stdin'
  1596. file = stdin
  1597. open_module("built_ins")?
  1598. name in = stdin
  1599. *** Using file name: 'stdin'
  1600. file = stdin
  1601. open_module("syntax")?
  1602. name in = stdin
  1603. *** Using file name: 'stdin'
  1604. file = stdin
  1605. % PVR 13.10.93 open_module("x")?
  1606. init,
  1607. initrandom(real_time)?
  1608. name in = stdin
  1609. *** Using file name: 'stdin'
  1610. file = stdin
  1611. name in = ./.wild_life
  1612. *** Using file name: './.wild_life'
  1613. name in = ~/.wild_life
  1614. *** Using file name: 'e:\src\plan\life\life-1.02\lf\/.wild_life'
  1615. No customizing file loaded.
  1616.  
  1617. % display_modules(false)?   % BD June 10 1993
  1618. % display_module_status?
  1619.  <EOF>
  1620. name in = stdin
  1621. *** Using file name: 'stdin'
  1622. file = stdin
  1623.  <EOF>
  1624. name in = stdin
  1625. *** Using file name: 'stdin'
  1626. file = stdin
  1627.  
  1628. *** Exiting Wild_Life  [0.455s cpu, 0.000s gc (0.0%)]
  1629.