/*************************************************************** * Socket I/O with Variable handling * * by TAKAGI Yusuke (mailto:takagi@ueda.info.waseda.ac.jp) * 1999/12/27 Variables can get 'puttq'ed. * 1999/12/29 Only Bounds can be 'puttq'ed, * but they may have unbound components. * * Predicate: * socket +Sock -Cio * * Messages on Sock: * gett -Term * getwt -normal(WrappedTerm) * puttq +Term * putwtq +WrappedTerm * nl * ungetc +C * (& messages on Cio) * * Socket streams usually eats only C-like I/O messages. * -> unix:unix([connect(inet(Host,Port), normal(Socket))]), * socket:socket(I_can_touch_terms, Socket), * I_can_touch_terms = [gett(T), puttq(T), nl]. * * Standard input stream does not usually eat ungetc. * -> unix:unix([stdin(normal(Stdin))]), * socket:socket(I_can_eat_ungetc, Stdin). * I_can_eat_ungetc = [getc(C), ungetc(C)]. * *--------------------------------------------------------------- * * A : atom * C : character * F : functor * H : head * L : list * LA: look ahead (character) * N : number * R : real number * S : string * T : tail * U : unknown * V : vector * W : wrapped * X : variable * Z : zahl (integer) * * gett -Term -LA -?Cio -?Vars * geta -A -LA -?Cio -?Vars * getz -Z -LA -?Cio -?Vars * getn -N -LA -?Cio -?Vars * getl -L -LA -?Cio -?Vars * getf -F -LA -?Cio -?Vars * getv -V -LA -?Cio -?Vars * gets -S -LA -?Cio -?Vars * * getwt -normal(W) -LA -?Cio -?Vars * getwx -WX -LA -?Cio -?Vars * getwa -WA -LA -?Cio -?Vars * getwi -WZ -LA -?Cio -?Vars * getwn -WN -LA -?Cio -?Vars * getwl -WL -LA -?Cio -?Vars * getwf -WF -LA -?Cio -?Vars * getwv -WV -LA -?Cio -?Vars * getws -WS -LA -?Cio -?Vars * * puttq +Term -?Cio -?Vars * putaq +A -?Cio -?Vars * putz +Z -?Cio -?Vars * putn +R -?Cio -?Vars * putlq +L -?Cio -?Vars * putfq +F -?Cio -?Vars * putvq +V -?Cio -?Vars * puts +S -?Cio -?Vars * * putwtq +W -?Cio -?Vars * putwx +WX -?Cio -?Vars * putwaq +WA -?Cio -?Vars * putwi +WZ -?Cio -?Vars * putwn +WR -?Cio -?Vars * putwlq +WL -?Cio -?Vars * putwfq +WF -?Cio -?Vars * putwvq +WV -?Cio -?Vars * putws +WS -?Cio -?Vars * putwuq +WU -?Cio -?Vars ***************************************************************/ :- module socket. :- with(( CSIZE = 8, % size of character EOF = -1, % end of file CTYPE = "ccccccccc_____cccccccccccccccccc_1\"ss%s'()ss,sss0000000000s1ssss\ sAAAAAAAAAAAAAAAAAAAAAAAAAA[s]sAsaaaaaaaaaaaaaaaaaaaaaaaaaa{1}sc" )). % 0'c control character % 0'_ space % 0'0 digit % 0'A UPPER CASE % 0'a lower case % 0's special character % 0'1 one-character atom ctype(C, Type) :- C = EOF | Type = EOF. ctype(C, Type) :- 0 =< C, C =< 127 | string_element(CTYPE, C, Type). /*************************************************************** * socket +Sock -Cio ***************************************************************/ socket(Sock, Cio) :- variable_table:variable_table(Vars), socket(Sock, Cio, Vars). socket([], Cio, Vars) :- Cio = [], Vars = []. socket([Mes | Sock], Cio, Vars) :- Mes = new_name(S) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = new(S,X) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = variable(S,Var) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = value(S,X) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = wrap(X,W) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = unwrap(W,X) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = variable_table(Tab) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = bound(Tab) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([Mes | Sock], Cio, Vars) :- Mes = bind(Tab) | Vars = [Mes | Vars1], socket(Sock, Cio, Vars1). socket([ungetc(C) | Sock], Cio, Vars) :- socket(Sock, C, Cio, Vars). socket([gett(Term) | Sock], Cio, Vars) :- gett(Term, LA, Cio, Cio1, Vars, Vars1), socket(Sock, LA, Cio1, Vars1). socket([getwt(Result) | Sock], Cio, Vars) :- getwt(Result, LA, Cio, Cio1, Vars, Vars1), socket(Sock, LA, Cio1, Vars1). socket([puttq(Term) | Sock], Cio, Vars) :- puttq(Term, Cio, Cio1, Vars, Vars1), socket(Sock, Cio1, Vars1). socket([putwtq(W) | Sock], Cio, Vars) :- putwtq(W, Cio, Cio1, Vars, Vars1), socket(Sock, Cio1, Vars1). socket([nl | Sock], Cio, Vars) :- Cio = [fwrite("\n") | Cio1], socket(Sock, Cio1, Vars). otherwise. socket([Mes | Sock], Cio, Vars) :- Cio = [Mes | Cio1], socket(Sock, Cio1, Vars). socket([], C, Cio, Vars) :- Cio = [], Vars = []. socket([Mes | Sock], C, Cio, Vars) :- Mes = new_name(S) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = new(S,X) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = variable(S,Var) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = value(S,X) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = wrap(X,W) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = unwrap(W,X) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = variable_table(Tab) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = bound(Tab) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([Mes | Sock], C, Cio, Vars) :- Mes = bind(Tab) | Vars = [Mes | Vars1], socket(Sock, C, Cio, Vars1). socket([getc(Char) | Sock], C, Cio, Vars) :- Char = C, socket(Sock, Cio, Vars). socket([gett(Term) | Sock], C, Cio, Vars) :- gett(Term, LA, C, Cio, Cio1, Vars, Vars1), socket(Sock, LA, Cio1, Vars1). socket([getwt(Result) | Sock], C, Cio, Vars) :- getwt(Result, LA, C, Cio, Cio1, Vars, Vars1), socket(Sock, LA, Cio1, Vars1). socket([puttq(Term) | Sock], C, Cio, Vars) :- puttq(Term, Cio, Cio1, Vars, Vars1), socket(Sock, C, Cio1, Vars1). socket([putwtq(W) | Sock], C, Cio, Vars) :- putwtq(W, Cio, Cio1, Vars, Vars1), socket(Sock, C, Cio1, Vars1). socket([nl | Sock], C, Cio, Vars) :- Cio = [fwrite("\n") | Cio1], socket(Sock, C, Cio1, Vars). otherwise. socket([Mes | Sock], C, Cio, Vars) :- Cio = [Mes | Cio1], socket(Sock, C, Cio1, Vars). /*************************************************************** * puttq +Term -H ?T -VH ?VT * putwtq +W -H ?T -VH ?VT ***************************************************************/ puttq(Term, H, T, VH, VT) :- puttq(0, Term, H, T, VH, VT) @lower_priority. puttq(_, Term, H, T, VH, VT) :- atom(Term) | putaq(Term, H, T, VH, VT). puttq(_, Term, H, T, VH, VT) :- integer(Term) | putz(Term, H, T, VH, VT). puttq(_, Term, H, T, VH, VT) :- float(Term) | putn(Term, H, T, VH, VT). puttq(_, Term, H, T, VH, VT) :- list(Term) | putlq(Term, H, T, VH, VT). puttq(_, Term, H, T, VH, VT) :- functor(Term,_,_) | putfq(Term, H, T, VH, VT). puttq(_, Term, H, T, VH, VT) :- vector(Term,_) | putvq(Term, H, T, VH, VT). puttq(_, Term, H, T, VH, VT) :- string(Term,_,CSIZE) | puts(Term, H, T, VH, VT). alternatively. puttq(1, Term, H, T, VH, VT) :- % unbound(Term, {_,_,Term}) | VH = [wrap(Term,W) | VH1], putwtq(W, H, T, VH1, VT). %--------------------------------------------------------------- putwtq(W, H, T, VH, VT) :- W = variable(S) | putwxq(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = atom(A) | putwaq(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = integer(Z) | putwz(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = floating_point(R) | putwn(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = list(L) | putwlq(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = functor(F) | putwfq(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = vector(V) | putwvq(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = string(S) | putws(W, H, T, VH, VT). putwtq(W, H, T, VH, VT) :- W = unknown(U) | puttq(U, H, T, VH, VT). %--------------------------------------------------------------- % putwxq +WV -H ?T -VH ?VT %--------------------------------------------------------------- putwxq(variable(S), H, T, VH, VT) :- VH = [value(S,X) | VH1], putwxq(S, X, H, T, VH1, VT). putwxq(S, X, H, T, VH, VT) :- atom(X) | putaq(X, H, T, VH, VT). putwxq(S, X, H, T, VH, VT) :- integer(X) | putz(X, H, T, VH, VT). putwxq(S, X, H, T, VH, VT) :- float(X) | putn(X, H, T, VH, VT). putwxq(S, X, H, T, VH, VT) :- list(X) | putlq(X, H, T, VH, VT). putwxq(S, X, H, T, VH, VT) :- functor(X,_,_) | putfq(X, H, T, VH, VT). putwxq(S, X, H, T, VH, VT) :- vector(X,_) | putvq(X, H, T, VH, VT). putwxq(S, X, H, T, VH, VT) :- string(X,_,CSIZE) | puts(X, H, T, VH, VT). alternatively. putwxq(S, X, H, T, VH, VT) :- % unbound(X, {_,_,X}) | H = [fwrite(S) | T], VH = VT. %--------------------------------------------------------------- % putaq +A -H ?T -VH ?VT % putwaq +WA -H ?T -VH ?VT %--------------------------------------------------------------- putaq(A, H, T, VH, VT) :- atom(A) | atom_table:get_atom_string(A, S), H = [fwrite(S) | T], VH = VT. putwaq(atom(A), H, T, VH, VT) :- putaq(A, H, T, VH, VT). %--------------------------------------------------------------- % putz +Z -H ?T -VH ?VT % putwz +WZ -H ?T -VH ?VT %--------------------------------------------------------------- putz(Z, H, T, VH, VT) :- type:int_chars(Z, H, T), VH = VT. %--------------------------------------------------------------- putwz(integer(Z), H, T, VH, VT) :- putz(Z, H, T, VH, VT). %--------------------------------------------------------------- % putn +R -H ?T -VH ?VT % putwn +WR -H ?T -VH ?VT %--------------------------------------------------------------- putn(R, H, T, VH, VT) :- float(R) | type:float_chars(R, H, T), VH = VT. putwn(floating_point(R), H, T, VH, VT) :- putn(R, H, T, VH, VT). %--------------------------------------------------------------- % putlq +L -H ?T -VH ?VT % putwlq +WL -H ?T -VH ?VT %--------------------------------------------------------------- putlq(L, H, T, VH, VT) :- L = [Car|Cdr] | H = [0'[ | H1], puttq(1, Car, H1, [0'| | H2], VH, VH1) @lower_priority, puttq(1, Cdr, H2, [0'] | T], VH1, VT) @lower_priority. putwlq(list(L), H, T, VH, VT) :- L = [Car|Cdr] | H = [0'[ | H1], putwtq(Car, H1, [0'| | H2], VH, VH1), putwtq(Cdr, H2, [0'] | T], VH1, VT). %--------------------------------------------------------------- % putfq +F -H ?T -VH ?VT % putwfq +WF -H ?T -VH ?VT %--------------------------------------------------------------- putfq(F, H, T, VH, VT) :- functor(F, Name, Arity) | puttq(Name, H, H1, VH, VH1), putfq_args(F, Arity, H1, T, VH1, VT). %--- putfq_args +F +Arity -H ?T -VH ?VT putfq_args(F, Arity, H, T, VH, VT) :- Arity=:=0 | H = T, VH = VT. putfq_args(F, Arity, H, T, VH, VT) :- Arity > 0 | H = [0'( | H1], putfq_args1(F, Arity, H1, [0') | T], VH, VT). putfq_args1(F, Pos, H, T, VH, VT) :- Pos=:=1 | arg(Pos, F, Arg), puttq(1, Arg, H, T, VH, VT) @lower_priority. putfq_args1(F, Pos, H, T, VH, VT) :- Pos > 1 | putfq_args1(F, ~(Pos-1), H, [0', | H1], VH, VH1), arg(Pos, F, Arg), puttq(1, Arg, H1, T, VH1, VT) @lower_priority. %--------------------------------------------------------------- putwfq(functor(F), H, T, VH, VT) :- functor(F, Name, Arity) | puttq(Name, H, H1, VH, VH1), putwfq_args(F, Arity, H1, T, VH1, VT). %--- putwfq_args +F +Arity -H ?T -VH ?VT putwfq_args(F, Arity, H, T, VH, VT) :- Arity=:=0 | H = T, VH = VT. putwfq_args(F, Arity, H, T, VH, VT) :- Arity > 0 | H = [0'( | H1], putwfq_args1(F, Arity, H1, [0') | T], VH, VT). putwfq_args1(F, Pos, H, T, VH, VT) :- Pos=:=1 | arg(Pos, F, Arg), putwtq(Arg, H, T, VH, VT). putwfq_args1(F, Pos, H, T, VH, VT) :- Pos > 1 | putwfq_args1(F, ~(Pos-1), H, [0', | H1], VH, VH1), arg(Pos, F, Arg), putwtq(Arg, H1, T, VH1, VT). %--------------------------------------------------------------- % putvq +V -H ?T -VH ?VT % putwvq +WV -H ?T -VH ?VT %--------------------------------------------------------------- putvq(V, H, T, VH, VT) :- vector(V, Size) | H = [0'{ | H1], putvq_elems(V, ~(Size-1), H1, [0'} | T], VH, VT). %--- putvq_elems +V +Index -H ?T -VH ?VT putvq_elems(V, Index, H, T, VH, VT) :- Index < 0 | H = T, VH = VT. putvq_elems(V, Index, H, T, VH, VT) :- Index=:=0 | vector_element(V, Index, Elem), puttq(1, Elem, H, T, VH, VT) @lower_priority. putvq_elems(V, Index, H, T, VH, VT) :- Index > 0 | putvq_elems(V, ~(Index-1), H, [0', | H1], VH, VH1), vector_element(V, Index, Elem), puttq(1, Elem, H1, T, VH1, VT) @lower_priority. %--------------------------------------------------------------- putwvq(vector(V), H, T, VH, VT) :- vector(V, Size) | H = [0'{ | H1], putwvq_elems(V, ~(Size-1), H1, [0'} | T], VH, VT). %--- putwvq_elems +V +Index -H ?T -VH ?VT putwvq_elems(V, Index, H, T, VH, VT) :- Index < 0 | H = T, VH = VT. putwvq_elems(V, Index, H, T, VH, VT) :- Index=:=0 | vector_element(V, Index, Elem), putwtq(Elem, H, T, VH, VT). putwvq_elems(V, Index, H, T, VH, VT) :- Index > 0 | putwvq_elems(V, ~(Index-1), H, [0', | H1], VH, VH1), vector_element(V, Index, Elem), putwtq(Elem, H1, T, VH1, VT). %--------------------------------------------------------------- % puts +S -H ?T -VH ?VT % putws +WS -H ?T -VH ?VT %--------------------------------------------------------------- puts(S, H, T, VH, VT) :- string(S, Size, CSIZE) | H = [0'", fwrite(S, Size), 0'" | T], VH = VT. putws(string(S), H, T, VH, VT) :- puts(S, H, T, VH, VT). /*************************************************************** * gett -Term -LA -H ?T -VH ?VT * getwt -Result -LA -H ?T -VH ?VT ***************************************************************/ gett(Term, LA, H, T, VH, VT) :- H = [getc(C) | H1], gett(Term, LA, C, H1, T, VH, VT). gett(Term, LA, C, H, T, VH, VT) :- getwt(normal(W), LA, C, H, T, VH, VH1), gett(W, Term, VH1, VT). gett(W, Term, VH, VT) :- W = end_of_file | Term = end_of_file, VH = VT. gett(W, Term, VH, VT) :- functor(W, _, 1) | VH = [unwrap(W, Term) | VT]. %--------------------------------------------------------------- getwt(Result, LA, H, T, VH, VT) :- H = [getc(C) | H1], getwt(Result, LA, C, H1, T, VH, VT). getwt(Result, LA, C, H, T, VH, VT) :- getwt1(W, C1, C, H, H1, VH, VT), get_end(LA, C1, H1, T), Result = normal(W). getwt1(W, LA, H, T, VH, VT) :- H = [getc(C) | H1], getwt1(W, LA, C, H1, T, VH, VT). getwt1(W, LA, C, H, T, VH, VT) :- get_skip(C1, C, H, H1), ctype(C1, Type), getwt1(W, LA, Type, C1, H1, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type = EOF | W = end_of_file, LA = EOF, H = T, VH = VT. getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'0 | getwn(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'A | getwx(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'a | getwf(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0's | getwf(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'1 | getwf(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'' | getwf(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'[ | getwl(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'{ | getwv(W, LA, C, H, T, VH, VT). getwt1(W, LA, Type, C, H, T, VH, VT) :- Type=:=0'" | getws(W, LA, C, H, T, VH, VT). %--------------------------------------------------------------- get_skip(LA, H, T) :- H = [getc(C) | H1], get_skip(LA, C, H1, T). get_skip(LA, C, H, T) :- ctype(C, Type), get_skip(LA, Type, C, H, T). get_skip(LA, Type, C, H, T) :- Type =:= 0'_ | get_skip(LA, H, T). get_skip(LA, Type, C, H, T) :- Type =\= 0'_ | LA = C, H = T. %--------------------------------------------------------------- get_end(LA, C, H, T) :- get_skip(C1, C, H, H1), get_end1(LA, C1, H1, T). get_end1(LA, C, H, T) :- C = EOF | LA = C, H = T. get_end1(LA, C, H, T) :- C=:=0'. | H = [getc(LA) | T]. %--------------------------------------------------------------- % getwx -WX -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- getwx(WX, LA, C, H, T, VH, VT) :- ctype(C, 0'A), get_symbol(L, LA, H, T), new_string(S, [C|L], CSIZE), WX = variable(S), VH = [value(S,_) | VT]. %--- get_symbol -L -LA -H ?T get_symbol(L, LA, H, T) :- H = [getc(C) | H1], ctype(C, Type), get_symbol(L, LA, Type, C, H1, T). get_symbol(L, LA, Type, C, H, T) :- Type =:= 0'0 | L = [C | L1], get_symbol(L1, LA, H, T). get_symbol(L, LA, Type, C, H, T) :- Type =:= 0'A | L = [C | L1], get_symbol(L1, LA, H, T). get_symbol(L, LA, Type, C, H, T) :- Type =:= 0'a | L = [C | L1], get_symbol(L1, LA, H, T). otherwise. get_symbol(L, LA, Type, C, H, T) :- L = [], LA = C, H = T. %--------------------------------------------------------------- % geta -A -LA +C -H ?T -VH ?VT % getwa -WA -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- geta(A, LA, C, H, T, VH, VT) :- ctype(C, Type), geta(L, LA, Type, C, H, T), new_string(S, L, CSIZE), atom_table:make_atom(S, A), VH = VT. geta(L, LA, Type, C, H, T) :- Type =:= 0'a | L = [C | L1], get_symbol(L1, LA, H, T). geta(L, LA, Type, C, H, T) :- Type =:= 0's | L = [C | L1], get_special(L1, LA, H, T). geta(L, LA, Type, C, H, T) :- Type =:= 0'' | L = [C | L1], get_quote(L1, LA, H, T). geta(L, LA, Type, C, H, T) :- Type =:= 0'1 | L = [C], H = [getc(LA) | T]. %--- get_special -L -LA -H ?T get_special(L, LA, H, T) :- H = [getc(C) | H1], ctype(C, Type), get_special(L, LA, Type, C, H1, T). get_special(L, LA, Type, C, H, T) :- Type =:= 0's | L = [C | L1], get_special(L1, LA, H, T). get_special(L, LA, Type, C, H, T) :- Type =\= 0's | L = [], LA = C, H = T. %--- get_quote -L -LA -H ?T get_quote(L, LA, H, T) :- H = [getc(C) | H1], get_quote(L, LA, C, H1, T). get_quote(L, LA, C, H, T) :- C =:= 0'\ | get_quote1(L, LA, C, H, T). get_quote(L, LA, C, H, T) :- C =:= 0'' | get_quote1(L, LA, C, H, T). get_quote(L, LA, C, H, T) :- C =\= 0'\, C =\= 0'' | L = [C | L1], get_quote(L1, LA, H, T). get_quote1(L, LA, C, H, T) :- H = [getc(C1) | H1], get_quote1(L, LA, C, C1, H1, T). get_quote1(L, LA, C, C1, H, T) :- C =:= 0'\, C1 =:= 0'' | L = [C1 | L1], get_quote(L1, LA, H, T). get_quote1(L, LA, C, C1, H, T) :- C =:= 0'', C1 =:= 0'' | L = [C1 | L1], get_quote(L1, LA, H, T). get_quote1(L, LA, C, C1, H, T) :- C =:= 0'\, C1 =\= 0'' | L = [C | L1], get_quote(L1, LA, C1, H, T). get_quote1(L, LA, C, C1, H, T) :- C =:= 0'', C1 =\= 0'' | L = [C], LA = C1, H = T. %--------------------------------------------------------------- getwa(WA, LA, C, H, T, VH, VT) :- geta(A, LA, C, H, T, VH, VT), WA = atom(A). %--------------------------------------------------------------- % getz -Z -LA +C -H ?T -VH ?VT % getwz -WZ -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- getz(Z, LA, C, H, T, VH, VT) :- ctype(C, 0'0), getz1(10, 0, Z, LA, C, H, T), VH = VT. getz1(Base, Acc, Z, LA, C, H, T) :- ctype(C, Type), getz1(Base, Acc, Z, LA, Type, C, H, T). getz1(Base, Acc, Z, LA, 0'0, C, H, T) :- D := C-0'0, D < Base | getz1(Base, ~(Acc*Base + D), Z, LA, H, T). getz1(Base, Acc, Z, LA, 0'A, C, H, T) :- D := 10+C-0'A, D < Base | getz1(Base, ~(Acc*Base + D), Z, LA, H, T). getz1(Base, Acc, Z, LA, 0'a, C, H, T) :- D := 10+C-0'a, D < Base | getz1(Base, ~(Acc*Base + D), Z, LA, H, T). otherwise. getz1(Base, Acc, Z, LA, Type, C, H, T) :- Z = Acc, LA = C, H = T. getz1(Base, Acc, Z, LA, H, T) :- H = [getc(C) | H1], getz1(Base, Acc, Z, LA, C, H1, T). %--------------------------------------------------------------- getwz(WZ, LA, C, H, T, VH, VT) :- getz(Z, LA, C, H, T, VH, VT), WZ = integer(Z). %--------------------------------------------------------------- % getn -N -LA +C -H ?T -VH ?VT % getwn -WN -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- getn(N, LA, C, H, T, VH, VT) :- getz(N, LA, C, H, T, VH, VT). getwn(WN, LA, C, H, T, VH, VT) :- getwz(WN, LA, C, H, T, VH, VT). %--------------------------------------------------------------- % getl -L -LA +C -H ?T -VH ?VT % getwl -WL -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- % getl(L, LA, 0'[, H, T, VH, VT) :- %--------------------------------------------------------------- getwl(WL, LA, 0'[, H, T, VH, VT) :- H = [getc(C) | H1], getwl1(L, LA, C, H1, T, VH, VT), getwl(L, WL). getwl(L, WL) :- L = [] | WL = atom(L). getwl(L, WL) :- list(L) | WL = list(L). getwl1(L, LA, C, H, T, VH, VT) :- C =:= 0'] | L = [], H = [getc(LA) | T], VH = VT. getwl1(L, LA, C, H, T, VH, VT) :- C =\= 0'] | getwt1(Car, 0'|, C, H, H1, VH, VH1), getwt1(Cdr, 0'], H1, H2, VH1, VT), L = [Car | Cdr], H2 = [getc(LA) | T]. %--------------------------------------------------------------- % getf -F -LA +C -H ?T -VH ?VT % getwf -WF -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- % getf(F, LA, C, H, T, VH, VT) :- % geta(Name, C1, C, H, H1, VH, VH1), % getf_args(Args, LA, C1, H1, T, VH1, VT), % functor_table:(F =.. [Name|Args]). %--------------------------------------------------------------- getwf(WF, LA, C, H, T, VH, VT) :- geta(Name, C1, C, H, H1, VH, VH1), getwf_args(Args, LA, C1, H1, T, VH1, VT), functor_table:(F =.. [Name|Args]), getwf(F, WF). getwf(F, WF) :- atom(F) | WF = atom(F). getwf(F, WF) :- functor(F, _, Arity), Arity > 0 | WF = functor(F). getwf_args(Args, LA, C, H, T, VH, VT) :- C =:= 0'( | getwf_args1(Args, LA, H, T, VH, VT). getwf_args(Args, LA, C, H, T, VH, VT) :- C =\= 0'( | Args = [], LA = C, H = T, VH = VT. getwf_args1(Args, LA, H, T, VH, VT) :- getwt1(Arg, C1, H, H1, VH, VH1), Args = [Arg | Args1], getwf_args1(Args1, LA, C1, H1, T, VH1, VT). getwf_args1(Args, LA, C, H, T, VH, VT) :- C =:= 0', | getwf_args1(Args, LA, H, T, VH, VT). getwf_args1(Args, LA, C, H, T, VH, VT) :- C =:= 0') | Args = [], H = [getc(LA) | T], VH = VT. %--------------------------------------------------------------- % getv -V -LA +C -H ?T -VH ?VT % getwv -WV -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- % getv(V, LA, 0'{, H, T, VH, VT) :- %--------------------------------------------------------------- getwv(WV, LA, 0'{, H, T, VH, VT) :- H = [getc(C) | H1], getwv_elems(Elems, LA, C, H1, T, VH, VT), new_vector(V, Elems), WV = vector(V). getwv_elems(Elems, LA, C, H, T, VH, VT) :- C =:= 0'} | Elems = [], H = [getc(LA) | T], VH = VT. getwv_elems(Elems, LA, C, H, T, VH, VT) :- C =\= 0'} | getwt1(E, C1, C, H, H1, VH, VH1), Elems = [E | Elems1], getwv_elems1(Elems1, LA, C1, H1, T, VH1, VT). getwv_elems1(Elems, LA, C, H, T, VH, VT) :- C =:= 0'} | Elems = [], H = [getc(LA) | T], VH = VT. getwv_elems1(Elems, LA, C, H, T, VH, VT) :- C =:= 0', | getwt1(E, C1, H, H1, VH, VH1), Elems = [E | Elems1], getwv_elems1(Elems1, LA, C1, H1, T, VH1, VT). %--------------------------------------------------------------- % gets -S -LA +C -H ?T -VH ?VT % getws -WS -LA +C -H ?T -VH ?VT %--------------------------------------------------------------- gets(S, LA, 0'", H, T, VH, VT) :- gets1(L, LA, H, T), new_string(S, L, CSIZE), VH = VT. gets1(L, LA, H, T) :- H = [getc(C) | H1], gets1(L, LA, C, H1, T). gets1(L, LA, C, H, T) :- C =:= 0'" | L = [], H = [getc(LA) | T]. gets1(L, LA, C, H, T) :- C =:= 0'\ | H = [getc(C1) | H1], gets_escape(L, LA, C1, H1, T). gets1(L, LA, C, H, T) :- C =\= 0'", C =\= 0'\ | L = [C | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 0'a | % Alert L = [7 | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 0'b | % Backspace L = [8 | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 0't | % Tab L = [9 | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 0'n | % Newline L = [10 | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 0'v | % Vertical Tab L = [11 | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 0'f | % Formfeed L = [12 | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 0'r | % Carriage Return L = [13 | L1], gets1(L1, LA, H, T). gets_escape(L, LA, C, H, T) :- C =:= 10 | %--- Escaped Newline is ignored. gets1(L, LA, H, T). otherwise. gets_escape(L, LA, C, H, T) :- L = [0'\, C | L1], gets1(L1, LA, H, T). %--------------------------------------------------------------- getws(WS, LA, C, H, T, VH, VT) :- gets(S, LA, C, H, T, VH, VT), WS = string(S). % end socket.