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		reset_fuzzfile :- retractall(current_fuzzfile(_,_)).
19
20		get_z_definitions(Defs) :-
21		current_fuzzfile(_,Defs).
22
23		load_fuzzfile(File) :-
24		reset_fuzzfile,
25
26		(readfile(File,Content) -> true;
27		add_error(fuzzfile,'Error while reading file', File),fail),
28
29		(zparser(Defs,Content,[]) -> true;
30		add_error(fuzzfile,'Error while parsing fuzz file', File), fail),
31
32		assert(current_fuzzfile(File,Defs)).
33
34
35		%*******************************************************************************
36		% read file content
37		readfile(Filename,Content) :-
38		open(Filename,read,Stream),
39		readbytes(Stream,Content),
40		close(Stream).
41		readbytes(Stream,Res) :-
42		get_code(Stream,C),
43		(C= -1 -> Res=[] ; Res=[C|Rest],readbytes(Stream,Rest)).
44
45
46		%*******************************************************************************
47		% Parser
48		zparser(Items) --> wss, zparser2(Items).
49		zparser2([I|Rest]) --> zitem(I), !, zparser(Rest).
50		zparser2([]) --> [].
51
52		wss --> whitespace, !, wss.
53		wss --> "".
54
55		zitem(Item) --> "(", !, zitem2(Item).
56		zitem(String) --> identifier(String).
57
58		zitem2([]) --> ")",!.
59		zitem2(Item) --> itemname(IName), wss, zitem3(IName,Item), wss, ")",!.
60
61		zitem3('LIST',List) --> !,zparser(List).
62		zitem3('NAME',name(Name,Deco)) --> !, identifier(Name), wss, string(Deco).
63		zitem3('REF',ref(Name,Params)) --> !,
64		parsenumber(_), wss, zitem(Name), wss, zitem(Params).
65		zitem3('SREF',sref(Name,Deco,Params,Renamings)) --> !,
66		parsenumber(_), wss, identifier(Name), wss, string(Deco),
67		wss, zitem(Params), wss, zitem(Renamings).
68		zitem3('NUMBER',number(N)) --> !,
69		parsenumber(_), wss, [34], parsenumber(N), [34].
70		zitem3(IName,Item) --> parsenumber(_), zparser(Items),
71		{to_lower(IName,LIName), Item =.. [LIName | Items]}.
72
73		parsenumber(Number) --> digit(D), parsenumber2(Rest), {number_codes(Number,[D|Rest])}.
74		parsenumber2([D|Rest]) --> digit(D),!,parsenumber2(Rest).
75		parsenumber2([]) --> [].
76
77		itemname(N) --> letter(L), itemname2(Rest), {atom_codes(N,[L|Rest])}.
78		itemname2([L|Rest]) --> alphanum(L), !, itemname2(Rest).
79		itemname2([]) --> [].
80
81		string(Atom) --> [34], stringcontent(String), [34], {atom_codes(Atom,String)}.
82
83		stringcontent([C|Rest]) --> [C], {C \= 34}, !, stringcontent(Rest).
84		stringcontent([]) --> [].
85
86		identifier(Id) --> [34], idcontent(String), {atom_codes(Id,String)}.
87
88		idcontent(String) --> [C], idcontent2(C, String).
89		idcontent2(34, []) --> !. % closing quotation mark
90		idcontent2(92, [D|String]) --> % backslash
91		[C],{deescape(C,D)},!,idcontent(String).
92		idcontent2(C, [C|String]) --> idcontent(String).
93
94		deescape(95,95). % underscore
95
96		:- dynamic letter/3, digit/3, alphanum/3, whitespace/2, to_lower_char/2.
97		precompiled_rule(Rule) :-
98	?	member(L,"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"),
99	?	member(Rule,[letter(L,[L|R],R),alphanum(L,[L|T],T)]).
100		precompiled_rule(Rule) :-
101	?	member(D,"0123456789"),
102	?	member(Rule,[digit(D,[D|R],R),alphanum(D,[D|T],T)]).
103		precompiled_rule(whitespace([W|T],T)) :-
104	?	member(W," \t\n\r").
105		precompiled_rule(to_lower_char(Upper,Lower)) :-
106	?	nth0(N,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",Upper),
107		nth0(N,"abcdefghijklmnopqrstuvwxyz",Lower).
108		store_rules :-
109	?	precompiled_rule(R),
110		assert(R),
111		fail.
112		store_rules.
113		:- store_rules.
114
115		to_lower(Nr,R) :- number(Nr),!,R=Nr.
116		to_lower(UItem,LItem) :- atom_codes(UItem,Up),to_lower2(Up,Low),atom_codes(LItem,Low).
117		to_lower2([],[]).
118		to_lower2([Up|URest],[Low|LRest]) :-
119		( to_lower_char(Up,Low) -> true
120		; otherwise -> Up = Low),
121		to_lower2(URest,LRest).