Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- :- use_module(library(must_sanity)).
- :- set_prolog_flag(double_quotes,codes).
- % Mini DCG interpretor
- %
- % example
- %
- optionally(G) --> G ; !.
- zero_or_more(P)--> P, !, zero_or_more(P).
- zero_or_more(P)--> !.
- one_or_more(P)--> P -> zero_or_more(P); !.
- some(P) --> P, optionally(some(P)).
- any([H|T],[H|TT],O):- !, any(T,TT,O).
- any([],[],[]). % closes off infinites
- any(S,S,[]).
- end_of_file --> ([-1] ; [end_of_file] ; \+ [_]),!.
- end_of_file(S,E):- S==[],!, E=[].
- dcg_peek(Until,S,S) :- phrase(Until,S,_).
- is_until(Until) --> dcg_peek(Until) ; end_of_file.
- conj_until(Out, P, Until) --> call(P, A),
- ( is_until(Until) -> {A = Out} ; conj_until(B, P, Until), {Out = (A,B)}).
- seq_until([], _, Until) --> is_until(Until),!.
- seq_until([H|T], P, Until) --> call(P, H), !, seq_until(T, P, Until).
- until(Until,Stuff) --> until_0(Until,Stuff),Until.
- until_0(Until,[C|Before]) --> "\\",[C],!,until_0(Until,Before).
- until_0(DCG,[],[Found|Rest],[Found|Rest]):- phrase(DCG,[Found],[])-> true ; phrase(DCG,[Found|Rest],_).
- until_0(DCG,[Skipped|Before],[Skipped|More],[Found|Rest]):- until_0(DCG,Before,More,[Found|Rest]).
- % // =========
- % // Dot Gee
- % // =========
- gee_comment(Cmt) -->
- ("//" ; "#") -> (until(eol,Cmt) ; any(Cmt)) ;
- "/*", any(Cmt), "*/".
- white --> one_or_more(white_1).
- white_1 --> eol ; ([W], {char_type(W,white)}) ; gee_comment(_).
- eot --> sentence_op ; white.
- eol --> `\r\n` ; `\r` ; `\n` .
- sentence_op --> dcg_peek(`.`) ; dcg_peek(`|`) ; dcg_peek(`=>`).
- gee_token(Txt) --> \+ sentence_op,
- ({quotes(Q,EQ)}, (Q -> until(EQ, Txt) ; until_0(eot,Txt))).
- quotes(`<`,`>`).
- quotes(S,S):- quotes1(S).
- quotes1(`"`). quotes1(`'`).
- padded(DCG) --> optionally(some(white)), DCG, optionally(some(white)).
- gee_unit(DCG) --> ` `, !, gee_unit(DCG).
- gee_unit(DCG) --> gee_unit_1(DCG), (eot;!). % trim off end
- gee_unit_1(DCG,S,E) :-
- var(DCG) -> gee_token(Txt,S,E), name(DCG,Txt) ; % forward
- atomic(DCG) -> name(DCG,Txt), gee_token(Txt,S,E) ; % reverse
- phrase(DCG,S,E). % mixed
- gee_dcg( end_of_file ) --> end_of_file, !.
- gee_dcg( Out ) --> gee_dcg1( A ), (end_of_file -> {Out=A} ; gee_dcg( B ) , {Out = (A,B)}).
- gee_dcg1(DCG) --> (eol ; white), !, gee_dcg1(DCG).
- gee_dcg1( comment(Comment) ) --> gee_comment(Codes), {name(Comment,Codes)}.
- gee_dcg1( Out) --> gee_unit(L), ( "=>" -> gee_body(R), { Out = (L --> R)} ; gee_body(R), {Out = (:- do_gee(L,R))}), ".".
- gee_dcg1( done) --> [], !.
- gee_body([]) --> `null`.
- gee_body(A;B) --> gee_body1(A), "|", gee_body(B).
- gee_body(Body) --> gee_body1(Body).
- gee_body1(Body) --> conj_until( Body, gee_unit, sentence_op).
- write_clause(X):- writeq(X), nl.
- test_g:- phrase_from_file(({trace},conj_until(DCG, gee_dcg, end_of_file)), 'tml.g'),
- maplist(write_clause, DCG).
- % call(+SyntaxName, +Content, +SyntaxArgs, +VariableNames, -Result)
- qq_string(Data,_Args,_VarsIn, Result):- phrase_from_quasi_quotation(any(Result),Data).
- :- quasi_quotation_syntax(qq_string).
- gee(Data,_Args,_VarsIn,Result):- !,
- phrase_from_quasi_quotation((
- seq_until(Result, gee_dcg, end_of_file)),Data).
- :- quasi_quotation_syntax(qq_string).
- :- quasi_quotation_syntax(gee).
- gee(Data,_Args,_VarsIn,Result):- !,
- phrase_from_quasi_quotation(({trace},
- seq_until(Result, gee_dcg, end_of_file)),Data).
- quotes(`<`,`>`).
- quotes(S,S):- quotes1(S).
- quotes1(`"`). quotes1("'").
- write_clauses((A,B)):- !, write_clauses(A),write_clauses(B).
- write_clauses(X):- writeq(X), nl.
- % Prints out the DCG from
- :- write_clauses({|qq_string||
- directive => ws "@string" space ws strdir ws '.' ws |
- ws "@stdout" space ws term ws '.' ws |
- ws "@trace" space ws relname ws '.' ws |
- ws "@bwd" ws '.' ws.
- strdir => relname ws fname | relname ws string | relname ws cmdline | relname ws term.
- |).
- % loads the DCG forms
- {|qq_string||
- #{
- @string str <tml.g>.
- identifier => sym | var.
- args => identifier ws args | null.
- var => '?' chars.
- sym => chars.
- relname => sym.
- chars => alpha chars1 | '_' chars1.
- chars1=> alnum chars1 | '_' chars1 | null.
- ws => space ws | ws '#' printable_chars eol ws | null.
- terminal => quoted_char | string.
- quoted_char => '\'' printable '\'' | "'\\r'" | "'\\n'"
- | "'\\t'" | "'\\''" | "''".
- eol => '\r' | '\n' | ''.
- nonterminal => relname.
- fname => '<' printable_chars '>' ws.
- string => '"' printable_chars '"' ws.
- printable_chars => printable printable_chars | null.
- cmdline => '$' digits ws.
- query => '!' ws term | "!!" ws term.
- term => relname args.
- pred => term | '~' ws term ws.
- args => ws '(' ws args1 ws ')' ws | null.
- args1 => identifier ws args1 ws | args | null.
- directive => ws "@string" space ws strdir ws '.' ws |
- ws "@stdout" space ws term ws '.' ws |
- ws "@trace" space ws relname ws '.' ws |
- ws "@bwd" ws '.' ws.
- strdir => relname ws fname | relname ws string | relname ws cmdline | relname ws term.
- production => relname ws "=>" ws alt ws alts ws '.' ws.
- alt => terminal ws alt ws | nonterminal ws alt ws | null.
- alts => null | '|' ws alt ws alts ws.
- fact => pred '.' ws.
- preds => ws pred preds_rest.
- preds_rest => ws ',' ws pred ws preds_rest | null.
- rule => ws preds ws ":-" ws preds ws '.' ws.
- fof => term ws ':' '=' ws form ws '.' ws.
- form => term |
- ws prefix ws var ws '(' ws form ws ')' ws |
- ws '(' ws form ws ')' ws "and" ws '(' ws form ws ')' ws |
- ws '(' ws form ws ')' ws "or" ws '(' ws form ws ')' ws |
- ws "not" '(' ws form ws ')' ws |
- ws term ws "and" ws '(' ws form ws ')' ws |
- ws term ws "or" ws '(' ws form ws ')' ws |
- ws "not" '(' ws form ws ')' ws |
- ws term ws "and" ws term ws |
- ws term ws "or" ws term ws |
- ws "not" term ws |
- ws '(' ws form ws ')' ws "and" ws term ws |
- ws '(' ws form ws ')' ws "or" ws term ws.
- prefix => "forall" | "exists" | "unique".
- prog => directive S | rule S | production S | fof S | query S | null.
- S => ws '{' ws prog ws '}' ws S ws | ws prog ws | null.
- #}
- #{
- # ~S(?x?x):-S(?x?x).
- # ~prog(?x?x):-prog(?x?x).
- # ~alt(?x?x):-alt(?x?x).
- # ~alts(?x?x):-alts(?x?x).
- #}
- |}).
- :- phrase(seq_until(X,gee_unit,`.`), `@string a.` , O), O == `.`, X == ['@string', a].
- :- (phrase(seq_until(O,gee_unit,`.`), `@string str <tml.g> .` , O)).
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement