1		% (c) 2009 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(fuzzfile, [load_fuzzfile/1, reset_fuzzfile/0, get_z_definitions/1]).
6
7		:- dynamic current_fuzzfile/2.
8
9		:- use_module(library(lists)).
10
11		:- use_module(probsrc(tools)).
12		:- use_module(probsrc(error_manager)).
13
14		:- use_module(probsrc(module_information)).
15		:- module_info(group,proz).
16		:- module_info(description,'This module includes a parser for files generated by the fuzz type checker for Z specifications.').
17
18		:- set_prolog_flag(double_quotes, codes).
19
20		reset_fuzzfile :- retractall(current_fuzzfile(_,_)).
21
22		get_z_definitions(Defs) :-
23		current_fuzzfile(_,Defs).
24
25		load_fuzzfile(File) :-
26		reset_fuzzfile,
27
28		(readfile(File,Content) -> true;
29		add_error(fuzzfile,'Error while reading file', File),fail),
30
31		(zparser(Defs,Content,[]) -> true;
32		add_error(fuzzfile,'Error while parsing fuzz file', File), fail),
33
34		assertz(current_fuzzfile(File,Defs)).
35
36
37		%*******************************************************************************
38		% read file content
39		readfile(Filename,Content) :-
40		open(Filename,read,Stream),
41		readbytes(Stream,Content),
42		close(Stream).
43		readbytes(Stream,Res) :-
44		get_code(Stream,C),
45		(C= -1 -> Res=[] ; Res=[C|Rest],readbytes(Stream,Rest)).
46
47
48		%*******************************************************************************
49		% Parser
50		zparser(Items) --> wss, zparser2(Items).
51		zparser2([I|Rest]) --> zitem(I), !, zparser(Rest).
52		zparser2([]) --> [].
53
54	?	wss --> whitespace, !, wss.
55		wss --> "".
56
57		zitem(Item) --> "(", !, zitem2(Item).
58		zitem(String) --> identifier(String).
59
60		zitem2([]) --> ")",!.
61	?	zitem2(Item) --> itemname(IName), wss, zitem3(IName,Item), wss, ")",!.
62
63		zitem3('LIST',List) --> !,zparser(List).
64		zitem3('NAME',name(Name,Deco)) --> !, identifier(Name), wss, string(Deco).
65		zitem3('REF',ref(Name,Params)) --> !,
66	?	parsenumber(_), wss, zitem(Name), wss, zitem(Params).
67		zitem3('SREF',sref(Name,Deco,Params,Renamings)) --> !,
68	?	parsenumber(_), wss, identifier(Name), wss, string(Deco),
69		wss, zitem(Params), wss, zitem(Renamings).
70		zitem3('NUMBER',number(N)) --> !,
71	?	parsenumber(_), wss, [34], parsenumber(N), [34].
72	?	zitem3(IName,Item) --> parsenumber(_), zparser(Items),
73		{to_lower(IName,LIName), Item =.. [LIName | Items]}.
74
75	?	parsenumber(Number) --> digit(D), parsenumber2(Rest), {number_codes(Number,[D|Rest])}.
76	?	parsenumber2([D|Rest]) --> digit(D),!,parsenumber2(Rest).
77		parsenumber2([]) --> [].
78
79	?	itemname(N) --> letter(L), itemname2(Rest), {atom_codes(N,[L|Rest])}.
80	?	itemname2([L|Rest]) --> alphanum(L), !, itemname2(Rest).
81		itemname2([]) --> [].
82
83		string(Atom) --> [34], stringcontent(String), [34], {atom_codes(Atom,String)}.
84
85		stringcontent([C|Rest]) --> [C], {C \= 34}, !, stringcontent(Rest).
86		stringcontent([]) --> [].
87
88		identifier(Id) --> [34], idcontent(String), {atom_codes(Id,String)}.
89
90		idcontent(String) --> [C], idcontent2(C, String).
91		idcontent2(34, []) --> !. % closing quotation mark
92		idcontent2(92, [D|String]) --> % backslash
93		[C],{deescape(C,D)},!,idcontent(String).
94		idcontent2(C, [C|String]) --> idcontent(String).
95
96		deescape(95,95). % underscore
97
98		:- dynamic letter/3, digit/3, alphanum/3, whitespace/2, to_lower_char/2.
99		precompiled_rule(Rule) :-
100	?	member(L,"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"),
101	?	member(Rule,[letter(L,[L|R],R),alphanum(L,[L|T],T)]).
102		precompiled_rule(Rule) :-
103	?	member(D,"0123456789"),
104	?	member(Rule,[digit(D,[D|R],R),alphanum(D,[D|T],T)]).
105		precompiled_rule(whitespace([W|T],T)) :-
106	?	member(W," \t\n\r").
107		precompiled_rule(to_lower_char(Upper,Lower)) :-
108	?	nth0(N,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",Upper),
109		nth0(N,"abcdefghijklmnopqrstuvwxyz",Lower).
110		store_rules :-
111	?	precompiled_rule(R),
112		assertz(R),
113		fail.
114		store_rules.
115		:- store_rules.
116
117		to_lower(Nr,R) :- number(Nr),!,R=Nr.
118		to_lower(UItem,LItem) :- atom_codes(UItem,Up),to_lower2(Up,Low),atom_codes(LItem,Low).
119		to_lower2([],[]).
120		to_lower2([Up|URest],[Low|LRest]) :-
121		(to_lower_char(Up,Low) -> true ; Up = Low),
122		to_lower2(URest,LRest).