1/* COPYRIGHT ************************************************************
    2
    3Conceptual Graph Tools (CGT) - a partial implementation of Sowa's CS Theory
    4Copyright (C) 1990 Miguel Alexandre Wermelinger
    5
    6    This program is free software; you can redistribute it and/or modify
    7    it under the terms of the GNU General Public License as published by
    8    the Free Software Foundation; either version 2 of the License, or
    9    (at your option) any later version.
   10
   11    This program is distributed in the hope that it will be useful,
   12    but WITHOUT ANY WARRANTY; without even the implied warranty of
   13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14    GNU General Public License for more details.
   15
   16    You should have received a copy of the GNU General Public License
   17    along with this program; if not, write to the Free Software
   18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   19
   20************************************************************************/
   21
   22/* AUTHOR(S) ************************************************************
   23
   24Michel Wermelinger
   25Dept. de Informatica, Univ. Nova de Lisboa, Quinta da Torre
   26P - 2825 Monte da Caparica, PORTUGAL
   27Phone: (+351) (1) 295 44 64 ext. 1360  Internet: mw@fct.unl.pt
   28
   29************************************************************************/
   30
   31/* GENERALITIES *********************************************************
   32 
   33File Name	: GRAMAUX.PL
   34Creation Date	: 90/06/26 	By: mw
   35Abbreviations	: mw - Michel Wermelinger 
   36Description	: Reads the linear notation
   37Notes		: the arity of the DCG predicates doesn't include the lists
   38 
   39************************************************************************/
   40
   41/* HISTORY **************************************************************
   42 
   431.0	90/07/08  mw	initial version
   441.1	90/10/23  mw	a word may now contain '-' and start/end with "
   451.2	90/12/08  mw	rewrote the tokeniser thereby eliminating some bugs
   461.3     91/01/04  mw    added accent/2
   47
   48************************************************************************/
   49
   50/* CONTENTS *************************************************************
   51
   52message/1		displays a message (works with CGE) 
   53get_token/1		reads user input and returns the list of tokens
   54tokenise/1              transforms a list of ASCII codes into a list of tokens
   55
   56************************************************************************/
   57
   58/* message/1 ************************************************************
   59
   60Usage		: message(+Message)
   61Argument(s)	: atom, list or Prolog goal
   62Description	: writes the Message
   63Notes		: if Message is a Prolog goal, executes it
   64	          if Message is a list, writes each element separately
   65
   66************************************************************************/
   67
   68% the following clause(s) is(are) to be used iff CGE is available
   69message(Msg) :- acknowledge(Msg).
   70
   71/* the following clause(s) is(are) to be used iff CGE isn't available
   72message([]) :- !.
   73message([H|T]) :- message(H), message(T), !.
   74message(Atom) :- atomic(Atom), write(Atom), !.
   75message(G) :- call(G), !.
   76message(_).
   77*/
   78
   79/* get_token/1 **********************************************************
   80
   81Usage		: get_token(-Tokens)
   82Argument(s)	: 	      list
   83Description	: reads user input from the keyboard returning a list of tokens
   84Notes		: 
   85
   86************************************************************************/
   87
   88get_token(T) :- read_in(L), tokenise(T, L, []).
   89
   90/* read_in/1 ************************************************************
   91
   92Usage		: read_in(-Characters)
   93Argument(s)	: 	      list
   94Description	: reads Characters from the keyboard, stopping with '.'
   95Notes		: just used with Arity-Prolog
   96
   97************************************************************************/
   98
   99read_in(L) :-
  100	get0(C),
  101	( C = 13, nl, read_in(T), join_bs(13, T, L)
  102	; C = 10, nl, read_in(T), join_bs(10, T, L)
  103	%; C = 9, read_in(T), join_bs(9, T, L)
  104	; C = 8, read_in(T), L = [8|T]
  105	; name('.', [C]), L = [C]
  106	; read_in(T), join_bs(C, T, L)
  107	).
  108
  109/* join_bs/3 ************************************************************
  110
  111Usage		: join_bs(+Character, +Rest, -List)
  112Argument(s)	: 	     atom      list   list
  113Description	: treats backspaces
  114Notes		: 
  115
  116************************************************************************/
  117
  118join_bs(10, [8|T], L) :- join_bs(10, T, L).
  119join_bs(13, [8|T], L) :- join_bs(13, T, L).
  120join_bs(_, [8|T], T).
  121join_bs(H, T, [H|T]).
  122
  123/* tokenise/1 ***********************************************************
  124
  125Usage		: tokenise(-Tokens)
  126Argument(s)	: 	     list
  127Description	: DCG predicate which returns a list of atoms (tokens)
  128Notes		: the input list contains the ASCII codes of the characters read
  129
  130************************************************************************/
  131
  132tokenise(['(', 'NEG', ')', '-', '>', '['|L]) --> 
  133	skip_blanks, char(_, '~'), skip_blanks, char(_, '['),
  134        tokenise(L).
  135tokenise([T|L]) --> skip_blanks, token(T), tokenise(L).
  136tokenise([]) --> [].
  137
  138/* skip_blanks/0 ********************************************************
  139
  140Usage		: skip_blanks
  141Argument(s)	:
  142Description	: DCG predicate which skips the following white space
  143Notes		: succeeds always
  144
  145************************************************************************/
  146
  147skip_blanks --> blank(_, _), skip_blanks.
  148skip_blanks --> [].
  149
  150/* token/1 **************************************************************
  151
  152Usage		: token(-Token)
  153Argument(s)	: 	 atom
  154Description	: DCG predicate which returns a token
  155Notes		: a token is an integer, a word or a single character
  156
  157************************************************************************/
  158
  159token(I) --> digit(_, D), integer(I, D).
  160token(W) --> letter(C, _), word(W, [C]).
  161token(W) --> char(C, '"'), word(P, []), char(C, '"'), 
  162             { name(P, L1), conc(['"'|L1], ['"'], L2), name(W, L2) }.
  163token(C) --> char(_, C).
  164
  165/* integer/2 ************************************************************
  166
  167Usage		: integer(-Integer, +Partial)
  168Argument(s)	: integers
  169Description	: DCG predicate which returns an Integer
  170Notes		: Partial is the integer parsed so far
  171
  172************************************************************************/
  173
  174integer(I, N) --> digit(_, D), { J is 10*N+D }, integer(I, J).
  175integer(I, I) --> [].
  176
  177/* word/2 ***************************************************************
  178
  179Usage		: word(-Word, +Partial)
  180Argument(s)	:       atom    list
  181Description	: DCG predicate which returns a Word
  182Notes		: Partial is the list of characters parsed so far
  183	          Word is given by the following regular expression:
  184			letter ( letter | digit | "-" | "_" )*
  185
  186************************************************************************/
  187
  188word(W, R) --> letter(C, _), word(W, [C|R]).
  189word(W, R) --> digit(C, _), word(W, [C|R]).
  190word(W, R) --> char(C, '-'), word(W, [C|R]).
  191word(W, R) --> char(C, '_'), word(W, [C|R]).
  192word(W, R) --> accent(C, _), word(W, [C|R]).
  193word(W, R) --> { reverse(R, L), name(W, L) }.
  194
  195/* char/2 ***************************************************************
  196
  197Usage		: char(-Ascii, -Character)
  198Argument(s)	:      integer    atom
  199Description	: DCG predicate returning the next Character and its Ascii code
  200Notes		:
  201
  202************************************************************************/
  203
  204char(A, C) --> [A], { name(C, [A]) }.
  205
  206/* letter/2 *************************************************************
  207
  208Usage		: letter(-Ascii, -Letter)
  209Argument(s)	:      integer     atom
  210Description	: DCG predicate returning the next Letter and its Ascii code
  211Notes		: fails iff the next character in the input list isn't a letter
  212
  213************************************************************************/
  214
  215letter(C, L) --> [C], { letter(C), name(L, [C]) }.
  216
  217/* accent/2 *************************************************************
  218
  219Usage		: accent(-Ascii, -Accent)
  220Argument(s)	:        integer   atom
  221Description	: DCG predicate returning the next accent and its Ascii code
  222Notes		: fails iff the next character in the input list isn't an accent
  223                  an accent is "'", "`", "^" or "~"
  224
  225************************************************************************/
  226
  227accent(C, A) --> 
  228        char(C, A), { A = '''' ; A = '`' ; A = '^' ; A = '~' }.
  229
  230/* digit/2 **************************************************************
  231
  232Usage		: digit(-Ascii, -Digit)
  233Argument(s)	: integers
  234Description	: DCG predicate returning the next Digit and its Ascii code
  235Notes		: fails iff the next character in the input list isn't a digit
  236
  237************************************************************************/
  238
  239digit(C, D) --> [C], { digit(C), D is C - 48 }.
  240
  241/* blank/2 **************************************************************
  242
  243Usage		: blank(-Ascii, -Blank)
  244Argument(s)	: 	integer  atom
  245Description	: DCG predicate returning the next Blank and its Ascii code
  246Notes		: fails iff the next character in the input list isn't a blank
  247		  Blank is 'space', 'tab', 'nl', 'cr' or 'ff'
  248		  the information in blank might be important to update the
  249			current line and column numbers
  250
  251************************************************************************/
  252
  253blank(9, tab) --> [9].
  254blank(32, space) --> [32].
  255blank(10, nl) --> [10].
  256blank(13, cr) --> [13].
  257blank(12, ff) --> [12].
  258
  259/* letter/1 *************************************************************
  260
  261Usage		: letter(+Ascii)
  262Argument(s)	: 	 integer
  263Description	: succeeds iff Ascii is the ASCII code of a letter
  264Notes		:
  265
  266************************************************************************/
  267
  268letter(L) :- upper(L), !.
  269letter(L) :- lower(L), !.
  270
  271/* upper/1 **************************************************************
  272
  273Usage		: upper(+Ascii)
  274Argument(s)	: 	integer
  275Description	: succeeds iff Ascii is the ASCII code of an uppercase letter
  276Notes		:
  277
  278************************************************************************/
  279
  280upper(C) :- C >= 65, C =<  90.
  281
  282/* lower/1 **************************************************************
  283
  284Usage		: lower(+Ascii)
  285Argument(s)	: 	integer
  286Description	: succeeds iff Ascii is the ASCII code of a lowercase letter
  287Notes		:
  288
  289************************************************************************/
  290
  291lower(C) :- C >= 97, C =< 122.
  292
  293/* digit/1 **************************************************************
  294
  295Usage		: digit(+Ascii)
  296Argument(s)	: 	integer
  297Description	: succeeds iff Ascii is the ASCII code of a digit
  298Notes		:
  299
  300************************************************************************/
  301
  302digit(D) :- D >= 48, D =< 57