home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 3 / FREEWARE.BIN / towns_os / quasar / classic.qsr next >
Text File  |  1980-01-02  |  6KB  |  355 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%-*-PROLOG-*-%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %                                %
  3. %                classic.qsr                %
  4. %                                %
  5. %               --- QuasarProlog ---            %
  6. %           Portable Extended Prolog Interpreter        %
  7. %                                %
  8. %          Copyright (C)  1987, 1988, 1989, 1990        %
  9. %                 硴崎 賢一                %
  10. %               All rights reserved.            %
  11. %                                %
  12. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  13.  
  14. % '$system_library'('$Header: classic.qsr,v 0.36 90/09/21 02:33:22 ken Locked $').
  15.  
  16. /***************************************************************/
  17.  
  18.  
  19. :- provide(classic).
  20.  
  21. %%%
  22. %%%    DEC-10 PROLOG およびそれに準拠した処理系用に記述されたプログラムを
  23. %%%    Quasar Prolog で実行するための互換パッケージ。
  24. %%%    新しくプログラムを記述する場合には、この互換パッケージを
  25. %%%    使用しないことを推奨する。
  26. %%%
  27.  
  28. %% 変数名の記録を中断し、不必要なメモリの消費を抑制する。
  29. :- reader(variable, off).
  30.  
  31.  
  32. %%%
  33. %%%    オペレータの優先順位の定義
  34. %%%
  35.  
  36. :- operator(=.., xfx, 700).
  37.  
  38. :- operator(is, xfx, 700).
  39.  
  40.  
  41. op(Precedence, Type, Op) :-
  42.     operator(Op, Type, Precedence).
  43.  
  44. :- predicate(op, 3, system).
  45.  
  46.  
  47. current_op(Precedence, Type, Op) :-
  48.     current_operator(Op, Type, Precedence).
  49.  
  50. :- predicate(current_op, 3, system).
  51.  
  52.  
  53. %%%
  54. %%%    算術演算述語
  55. %%%
  56.  
  57. %%    ?Value is +Exp
  58.  
  59. Result is [Char] :-
  60.     !,
  61.     '$is_char'(Result, Char).
  62. Result is Exp :-
  63.     Result := Exp.
  64.  
  65. :- predicate(is, 2, system).
  66.  
  67.  
  68. '$is_char'(Char, Char) :-
  69.     integerp(Char),
  70.     !.
  71. '$is_char'(Result, Char) :-
  72.     characterp(Char),
  73.     !,
  74.     char_int(Char, Result).
  75.  
  76. :- predicate('$is_char', 2, system).
  77.  
  78.  
  79. %%%
  80. %%%    データ型判定述語
  81. %%%
  82.  
  83. %%    integer(+?Term)
  84. integer(Int) :- integerp(Int).
  85.  
  86. :- predicate(integer, 1, system).
  87.  
  88.  
  89. %%    var(+?Term)
  90. var(Var) :- unboundp(Var).
  91.  
  92. :- predicate(var, 1, system).
  93.  
  94.  
  95. %%    nonvar(+?Term)
  96. nonvar(Var) :- boundp(Var).
  97.  
  98. :- predicate(nonvar, 1, system).
  99.  
  100.  
  101. %%%
  102. %%%    入力述語
  103. %%%
  104.  
  105.  
  106. %%    get0(-Char)
  107. get0(C) :-
  108.     read_char(Char),
  109.     char_int(Char, C).
  110.  
  111. :- predicate(get0, 1, system).
  112.  
  113.  
  114. %%    ttyget0(-Char)
  115. ttyget0(C) :-
  116.     read_char(Char, user_input),
  117.     char_int(Char, C).
  118.  
  119. :- predicate(ttyget0, 1, system).
  120.  
  121.  
  122. %%    get(-Char)
  123. get(C) :-
  124.     read_char(Char),
  125.     char_int(Char, CC),
  126.     current_input(Stream),
  127.     '$get'(CC, C, Stream).
  128.  
  129. :- predicate(get, 1, system).
  130.  
  131.  
  132. %%    ttyget(-Char)
  133. ttyget(C) :-
  134.     read_char(Char, user_input),
  135.     char_int(Char, CC),
  136.     '$get'(CC, C, user_input).
  137.  
  138. :- predicate(ttyget, 1, system).
  139.  
  140.  
  141. '$get'(CC, C, Stream) :-
  142.     '$white_char'(CC),
  143.     read_char(NewChar, Stream),
  144.     char_int(NewChar, NewCC),
  145.     !,
  146.     '$get'(NewCC, C, Stream).
  147. '$get'(C, C, _).
  148.  
  149. :- predicate('$get', 3, system).
  150.  
  151.  
  152. '$white_char'(Code) :-
  153.     Code =< 32.
  154.  
  155. :- predicate('$white_char', 1, system).
  156.  
  157.  
  158. %%    skip(+Char)
  159. skip(C) :-
  160.     CC is C,        % 算術式を受け付けるため
  161.     read_char(Char),
  162.     char_int(Char, CC),
  163.     !.
  164. skip(C) :-
  165.     skip(C).
  166.  
  167. :- predicate(skip, 1, system).
  168.  
  169.  
  170. %%    ttyskip(+Char)
  171. ttyskip(C) :-
  172.     CC is C,        % 算術式を受け付けるため
  173.     read_char(Char, user_input),
  174.     char_int(Char, CC),
  175.     !.
  176. ttyskip(C) :-
  177.     ttyskip(C).
  178.  
  179. :- predicate(ttyskip, 1, system).
  180.  
  181.  
  182. %%%
  183. %%%    出力述語
  184. %%%
  185.  
  186. %%    tab(+Num)
  187. tab(N) :-
  188.     NN is N,        % 算術式を受け付けるため
  189.     '$spaces'(NN).
  190.  
  191. :- predicate(tab, 1, system).
  192.  
  193.  
  194. %%    ttytab(+Num)
  195. ttytab(N) :-
  196.     NN is N,        % 算術式を受け付けるため
  197.     '$spaces'(NN, user_output).
  198.  
  199. :- predicate(ttytab, 1, system).
  200.  
  201.  
  202. %%    put(+Char)
  203. put(C) :-
  204.     CC is C,        % 算術式を受け付けるため
  205.     char_int(Char, CC),
  206.     write_char(Char).
  207.  
  208. :- predicate(put, 1, system).
  209.  
  210.  
  211. %%    ttyput(+Char)
  212. ttyput(C) :-
  213.     CC is C,        % 算術式を受け付けるため
  214.     char_int(Char, CC),
  215.     write_char(Char, user_output).
  216.  
  217. :- predicate(ttyput, 1, system).
  218.  
  219.  
  220. %%    nl
  221. nl :-
  222.     write_char(#\NewLine).
  223.  
  224. :- predicate(nl, 0, system).
  225.  
  226.  
  227. %%    ttynl
  228. ttynl :-
  229.     write_char(#\NewLine, user_output).
  230.  
  231. :- predicate(ttynl, 0, system).
  232.  
  233.  
  234. %%    ttyflush
  235. ttyflush :-
  236.     force_output(user_output).
  237.  
  238. :- predicate(ttyflush, 0, system).
  239.  
  240.  
  241. %%%
  242. %%%    ファイル操作述語
  243. %%%
  244.  
  245. %%    exists(+File)
  246. exists(File) :-
  247.     porobe_file(File).
  248.  
  249. :- predicate(exists, 1, system).
  250.  
  251.  
  252. %%    rename(+Old, +New)
  253. rename(_, New) :-
  254.     unboundp(New),
  255.     !,
  256.     fail.
  257. rename(Old, []) :-
  258.     !,
  259.     delete_file(Old).
  260. rename(Old, New) :-
  261.     rename_file(Old, New).
  262.  
  263. :- predicate(rename, 2, system).
  264.  
  265.  
  266. %%%
  267. %%%    データ型変換
  268. %%%
  269.  
  270. %%    name(?Atom, ?List)
  271. name(Obj, List) :-
  272.     unboundp(Obj),
  273.     number_chars(Obj, List),
  274.     !.
  275. name(Obj, List) :-
  276.     numberp(Obj),
  277.     !,
  278.     number_chars(Obj, List).
  279. name(Obj, List) :-
  280.     symbol_chars(Obj, List).
  281.  
  282. :- predicate(name, 2, system).
  283.  
  284.  
  285. %%    ?Structure =.. ?List
  286. Structure =.. List :-
  287.     structure_list(Structure, List).
  288.  
  289. :- predicate(=.., 2, system).
  290.  
  291.  
  292. %%%
  293. %%%
  294. %%%
  295.  
  296. current_atom(Atom) :-
  297.     current_symbol(Atom).
  298.  
  299. :- predicate(current_atom, 1, system).
  300.  
  301.  
  302. current_functor(Atom, Functor) :-
  303.     current_structure(Atom, Functor).
  304.  
  305. :- predicate(current_functor, 2, system).
  306.  
  307.  
  308. %%%
  309. %%%
  310. %%%
  311.  
  312. %%    statistics
  313. statistics :-
  314.     room,
  315.     '$times'.
  316.  
  317. :- predicate(statistics, 0, system).
  318.  
  319.  
  320. %%    statistics(+Area, -Info)
  321. statistics(X, Y) :-
  322.     room(X, Y).
  323.  
  324. :- predicate(statistics, 2, system).
  325.  
  326.  
  327. %%%
  328. %%% ファイル読み込み時の述語名変換
  329. %%%
  330.  
  331. macro_body(pl, Goal, CGoal) :-
  332.     !,
  333.     classic_macro(Goal, CGoal).
  334.  
  335. classic_macro(atom(X), symbolp(X)).
  336. classic_macro(atomic(X), atom(X)).
  337. classic_macro(integer(X), integerp(X)).
  338. classic_macro(var(X), unboundp(X)).
  339. classic_macro(nonvar(X), boundp(X)).
  340. classic_macro(=..(X, Y), structure_list(X, Y)).
  341. classic_macro(current_atom(X), current_symbol(X)).
  342. classic_macro(current_functor(X, Y), current_structure(X, Y)).
  343. classic_macro(op(Prec, Type, Op), operator(Op, Type, Prec)).
  344. classic_macro(current_op(Prec, Type, Op), current_operator(Op, Type, Prec)).
  345. classic_macro(nl, terpri).
  346. classic_macro(exists(File), porobe_file(File)).
  347. classic_macro(delete(File), delete_file(File)).
  348.  
  349.  
  350. :- reader(variable, on).
  351.  
  352.  
  353. /* End of classic.qsr */
  354.  
  355.