home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / prolog / library / diverses / calc.pro < prev    next >
Text File  |  1990-01-22  |  7KB  |  230 lines
  1. % Simple calculator ver 1.2 to illustrate parsing using difference lists.
  2.  
  3. % Tokenizer is based on Turbo Prolog 2.0 User's Guide Chapter 13 Example 3.
  4.  
  5. % Parser based on Sterling and Shapiro, The Art of Prolog: "The most
  6. % popular approach to parsing in Prolog is definite clause grammars
  7. % or DCGs.  DCGs are a generalization of context- free grammars that
  8. % are executable, because they are a notational variant of a class of
  9. % Prolog programs."
  10.  
  11. % A difference list represents a series of elements as the difference
  12. % between two lists.  Sterling and Shapiro use the notation S\S0 where
  13. % S and S0 are lists.  Since \ is not an operator, but merely a functor,
  14. % this program uses the functor dl(S,S0) to mean the same thing.  The
  15. % advantage of using difference lists is that you avoid the overhead
  16. % of appending lists during parsing.
  17.  
  18. % This calculator understands real numbers, +-*/ operators, most real
  19. % functions such as sin, cos, etc, unary -, parentheses ().  You can
  20. % assign variables with =, and the variables pi and e are predefined.
  21.  
  22. % Run time errors are trapped so that things like 1/0, sqrt(-1), etc., won't
  23. % crash the program.
  24.  
  25. % In the previous version of this program, the grammar clauses were non-
  26. % deterministic, and some of the calculator's calculations would be done
  27. % more than once during backtracking.  In this version, everything except
  28. % the repeat clause and the internal database are deterministic.  Cuts have
  29. % been placed at the earliest points possible, where subsequent failure
  30. % would indicate a syntax error, and backtracking would be pointless. 
  31.  
  32. % John W. Spalding 1/22/90
  33.  
  34. diagnostics
  35. check_determ
  36.  
  37. database
  38.    symtab(real, symbol)        % used to store calculator variables
  39.    
  40. domains
  41.    tok  = numb(real); name(symbol); char(char)
  42.    toklist = tok*
  43.    dl = dl(toklist,toklist)    % difference list
  44.  
  45. predicates
  46.    stmt(real, dl)        % statement or null line to quit
  47.    stmt1(real, dl)        % [ var = [var = ... ]] expr
  48.  
  49.    expr(real, dl)        % expr: term expr1 
  50.    expr1(real, real, dl)    % expr1: <nothing> | +- expr1
  51.    term(real, dl)        % term: factor term1
  52.    term1(real, real, dl)    % term1: <nothing> | */ term1
  53.    factor(real, dl)        % factor: number|(expr)|-factor|fn(arg)|var
  54.  
  55.    addop(char, dl)        % tests for +- operator
  56.    mulop(char, dl)        % tests for */ operator
  57.    unop(char, dl)        % tests for unary operators
  58.    delim(char, dl)        % tests for other delimiters
  59.  
  60.    applyop(real, char, real)        % perform unary operations
  61.    applyop(real, real, char, real)    % perform binary operations
  62.    applyfn(real, symbol, real)        % invoke a function
  63.  
  64.    scanner(string, toklist)    % tokenize a line of input
  65.    maketok(string, tok)        % determine type and builds token
  66.  
  67.    run                % process one line of input
  68.    nondeterm repeat        % repeat forever
  69.    trapfn(integer)        % recover from runtime errors
  70.  
  71. clauses
  72. %
  73. % statement is [ var = [ var = ... ]] expr
  74. %
  75.    stmt(0, dl([],[])) :-    % quit on null expression.
  76.        !,
  77.        exit.
  78.    stmt(Value, S) :-
  79.        stmt1(Value, S).
  80.         
  81.    stmt1(Value, dl([name(Var), char('=') | S], S0)) :-
  82.        !,
  83.        stmt1(Value, dl(S, S0)),
  84.     retractall(symtab(_, Var)),
  85.        assert(symtab(Value, Var)).
  86.    stmt1(Value, S) :-
  87.        expr(Value, S),
  88.        !.
  89. %
  90. % expression is a term followed by expr1
  91. %       
  92.    expr(Value, dl(S,S0)) :-
  93.        term(Temp, dl(S, S1)),
  94.        expr1(Value, Temp, dl(S1, S0)).
  95. %
  96. % expr1 is zero or more of instances of +- term
  97. %
  98.    expr1(Value, A, dl(S, S0)) :-       
  99.        addop(C, dl(S, S1)),
  100.     !,
  101.        term(B, dl(S1, S2)),
  102.        applyop(Temp, A, C, B),
  103.        expr1(Value, Temp, dl(S2, S0)).
  104.    expr1(Value, Value, dl(S, S)).
  105. %
  106. % term is factor followed by term1
  107. %
  108.    term(Value, dl(S,S0)) :-
  109.        factor(Temp, dl(S, S1)),
  110.        term1(Value, Temp, dl(S1, S0)).
  111. %
  112. % term1 is zero or more instances of */ factor
  113. %
  114.    term1(Value, A, dl(S, S0)) :-       
  115.        mulop(C, dl(S, S1)),
  116.     !,
  117.        factor(B, dl(S1, S2)),
  118.        applyop(Temp, A, C, B),
  119.        term1(Value, Temp, dl(S2, S0)).
  120.    term1(Value, Value, dl(S, S)).
  121. %
  122. % factor is number | (expression) | unary-operator factor | fn(arg) | variable
  123. %
  124.    factor(Value, dl([numb(Value) | S],S)) :-
  125.        !.
  126.    factor(Value, dl([char('(') | S], S0)) :-
  127.        !,
  128.        expr(Value, dl(S, S1)),
  129.        delim(')', dl(S1, S0)).
  130.    factor(Value, dl(S, S0)) :-
  131.     unop(C, dl(S, S1)),
  132.     !,
  133.     factor(Temp, dl(S1, S0)),
  134.        applyop(Value, C, Temp).
  135.    factor(Value, dl([name(Fn), char('(') | S], S0)) :-
  136.        expr(Argument, dl(S, S1)),
  137.        delim(')', dl(S1, S0)),
  138.        !,
  139.        applyfn(Value,Fn, Argument).
  140.    factor(Value, dl([name(Var) | S], S)) :-
  141.        symtab(Value, Var),
  142.        !.
  143. %
  144. % Determine type of operator.
  145. % 
  146.    unop(C, dl([char(C)|S], S)) :-    % unary operators
  147.        C = '-'.
  148.    addop(C, dl([char(C)|S], S)) :-    % +- operators
  149.        C = '+', !;
  150.        C = '-'.
  151.    mulop(C, dl([char(C)|S], S)) :-    % */ operators
  152.        C = '*', !;
  153.        C = '/'.
  154.    delim(C, dl([char(C)|S], S)).    % test for specific character.
  155. %
  156. % Perform a specified operation.
  157. %
  158.    applyop(R,    '-', A) :- R =   - A.
  159.    applyop(R, A, '+', B) :- R = A + B.
  160.    applyop(R, A, '-', B) :- R = A - B.
  161.    applyop(R, A, '*', B) :- R = A * B.
  162.    applyop(R, A, '/', B) :- R = A / B.
  163. %
  164. % Invoke a specified function.
  165. %
  166.    applyfn(R, sin,    A) :- R = sin(A).
  167.    applyfn(R, cos,    A) :- R = cos(A).
  168.    applyfn(R, tan,    A) :- R = tan(A).
  169.    applyfn(R, sqrt,   A) :- R = sqrt(A).
  170.    applyfn(R, log,    A) :- R = log(A).
  171.    applyfn(R, ln,     A) :- R = ln(A).
  172.    applyfn(R, exp,    A) :- R = exp(A).
  173.    applyfn(R, arctan, A) :- R = arctan(A).
  174. %
  175. % Convert a string to a list of tokens.
  176. %
  177.    scanner("", []) :- !.
  178.    scanner(Str, [Tok|Rest]) :-
  179.       fronttoken(Str, Sym, Str1), maketok(Sym, Tok), scanner(Str1, Rest).
  180. %
  181. % Determine the functor for a token.
  182. %
  183.    maketok(S, numb(N)) :- str_real(S, N), !.
  184.    maketok(S, name(S)) :- isname(S), !.
  185.    maketok(S, char(C)) :- str_char(S, C).
  186. %
  187. % Repeat forever.
  188. %
  189.    repeat.
  190.    repeat :- repeat.
  191. %
  192. % Read and process one line of input.
  193. %
  194.    run :-
  195.        write("? "),
  196.        readln(Text),
  197.        scanner(Text,T_List),
  198.        stmt(Answer, dl(T_list,[])),
  199.        !,
  200.        writef("= %\n", Answer).
  201.    run :-
  202.        write("* Syntax error."), nl.
  203. %
  204. % Recover from run-time errors.
  205. %
  206.    trapfn(0) :-
  207.        !,
  208.        removewindow,
  209.        exit.
  210.    trapfn(X) :-
  211.        writef("* Runtime error %d\n", X).
  212. %
  213. % Assert built-in constants e and pi, then
  214. % process lines of input.
  215. %
  216. goal
  217.    PI = arctan(1.0) * 4,
  218.    assert(symtab(PI, pi)),
  219.    E = exp(1.0),
  220.    assert(symtab(E, e)),
  221.  
  222.    makewindow(1, 7, 7, "Turbo Prolog Calculator 1.2", 0, 40, 25, 40),
  223.    writef("Enter expressions,\ncarriage return quits.\n\n"),
  224.  
  225.    repeat,
  226.    trap(run, Errno, trapfn(Errno)),
  227.    fail.
  228. %
  229. % End.
  230. %