%%%%%%%%%%%%%%%%%
%%% TOP LEVEL %%%
%%%%%%%%%%%%%%%%%
top_level :- lisp(user).

lisp(See) :-
	see(See),
	prompt(P,P),write('Welcom to Lisp World ver 1.1'),nl,
	repeat,
	   prompt(_,'lisp> '),errorset(lispRead(X),succ),
	   errorset(lispEval(X,V),succ),
	   lispPrint(V),
	   X == [bye],
	   !,
	write('Exit From Lisp'),nl,prompt(_,P).

%%%%%%%%%%%%%%
%%% Reader %%%
%%%%%%%%%%%%%%
whitespace(C) :- C<0'21.
terminating_macro(0'27).	/* ' */
terminating_macro(0'28).	/* ( */
terminating_macro(0'29).	/* ) */

lispRead(X) :- get0(C),chprompt,lispRead(X,C,CC),!,term_check(CC).
lispRead(_) :- lisp_err('syntax error').
%%%%
	term_check(26) :- !,seen,fail.
    term_check(31) :- !.
    term_check(C) :- whitespace(C),!,get0(CC),term_check(CC).
    term_check(_) :- skip(31),lisp_err('extra token after S-expression').
    tskip(31) :- !.
    tskip(_) :- skip(31).
    tmatch(T,T,_) :- !.
    tmatch(_,_,C) :- tskip(C),fail.
    chprompt :- prompt('lisp> ','>>>   '),!.
    chprompt.
%%%%
lispRead(_,26,26) :- !.
lispRead(X,C,CC) :- tokenRead(T,C,CCC),dispatch(X,T,CCC,CC).
  %%
tokenRead(T,C,CC) :- whitespace(C),!,get0(CCC),tokenRead(T,CCC,CC).
tokenRead([C],C,CC) :- terminating_macro(C),!,get0(CC).
tokenRead([C|T],C,CC) :- get0(CCC),tokenRead1(T,CCC,CC).
  %%
tokenRead1([],C,C) :- whitespace(C),!.
tokenRead1([],C,C) :- terminating_macro(C),!.
tokenRead1([C|T],C,CC) :- get0(CCC),tokenRead1(T,CCC,CC).
  %%
dispatch(X,"(",C,CC) :- !,tokenRead(T,C,CCC),dispatch1(X,T,CCC,CC).
dispatch(_,")",C,_) :- tskip(C),!,fail.
dispatch(_,".",C,_) :- tskip(C),!,fail.
dispatch([quote,X],"'",C,CC) :- !,lispRead(X,C,CC).
dispatch(S,T,C,C) :- name(SS,T),cnvnil(SS,S).
    cnvnil(nil,[]) :- !.
    cnvnil(S,S).
  %%
dispatch1([],")",C,C) :- !.
dispatch1(Cdr,".",C,CC) :- !,
	tokenRead(T,C,CCC),dispatch(Cdr,T,CCC,CCCC),
	tokenRead(TT,CCCC,CC),tmatch(")",TT,CC).
dispatch1([Car|Cdr],T,C,CC) :-
	dispatch(Car,T,C,CCC),tokenRead(TT,CCC,CCCC),dispatch1(Cdr,TT,CCCC,CC).

%%%%%%%%%%%%%%%%%
%%%  Printer  %%%
%%%%%%%%%%%%%%%%%

lispPrint(X) :- lispPrint1(X),nl.

%%%%%%
lispPrint1([]) :- !,write(nil).
lispPrint1([Car|Cdr]) :- !,write('('),lispPrint2([Car|Cdr]).
lispPrint1(X) :- write(X).

%%%%%%
lispPrint2([Car]):- !,lispPrint1(Car),write(')').
lispPrint2([Car,Cadr|Cddr]):-!,lispPrint1(Car),tab(1),lispPrint2([Cadr|Cddr]).
lispPrint2([Car|Cdr]):-lispPrint1(Car),write(' . '),lispPrint1(Cdr),write(')').

%%%%%%%%%%%%%%%%%
%%% Evaluater %%%
%%%%%%%%%%%%%%%%%

  %% EVAL from Top Level %%
lispEval(L,V) :- lispEval(L,V,[]).

  %% EVAL Body %%
lispEval(A,_,_) :- var(A),!,lisp_err('not a S-expr.'(A)).

lispEval(N,N,_) :- integer(N),!.		/* Integer -> Integer */

lispEval(A,V,E) :- atom(A),!,getvar(A,E,V).	/* Atom -> Binded Valuse */

lispEval([Sform|Args],V,E) :-			/* quote, progn, cond, de */
	specialForm_call(Sform,Args,V,E),!.

lispEval([Func|Args],Value,E) :- !,		/* Car, Cdr, Cons, Eq, Atom */
	evlis(Args,Args2,E),
	lispEval2(Func,Args2,Value,E).

lispEval(A,_,_) :- lisp_err('not a S-expr.'(A)).

lispEval2(Func,Args2,Value,E) :-
	subrFunction_call(Func,Args2,Value),!.

lispEval2(Func,Args2,Value,E) :-
	call(function(Func,closure(Env,Lambda,Body))),!,
	bind(Lambda,Args2,Env,NewEnv),
	prognBody(Body,Value,NewEnv).

lispEval2([lambda,Lambda|Body],Args2,Value,Env) :- !,	/* Lambda Notation */
	bind(Lambda,Args2,Env,NewEnv),
	prognBody(Body,Value,NewEnv).

lispEval2(Func,_,_,_) :- lisp_err('illegal function call'(Func)).

bind([],[],E,E) :- !.
bind([V|L1],[A|L2],E,[[V|A]|EE]) :- bind(L1,L2,E,EE).

  %%% Evaluate earch Argumnet %%%
evlis(A,AL,Env) :- evlis0(A,AL,Env),!.
evlis(A,_,_) :- lisp_err('dot list argument'(A)).

evlis0([],[],Env) :-!.
evlis0([P|L1],[V|L2],Env) :- lispEval(P,V,Env),!,evlis0(L1,L2,Env).

  %%% Get Value From Env  %%%
getvar(Var,[],Val) :- gval(Var,Val),!.
getvar(Var,[[Var|Val]|_],Val) :-!.
getvar(Var,[_|E],Val) :- getvar(Var,E,Val).

gval(t,t) :- !.
gval([],[]) :- !.
gval(Var,_) :- lisp_err('unbound variable'(Var)).

%%%%%%%%%%%%%%%%%%%%
%%% specialForm  %%%
%%%%%%%%%%%%%%%%%%%%

specialForm(quote).
specialForm(progn).
specialForm(cond).
specialForm(de).

  %% Quote %%
specialForm_call(quote,[Sexp],Sexp,_) :- !.
specialForm_call(quote,_,_,_) :- lisp_err('quote syntax error').
  %% Progn %%%
specialForm_call(progn,Body,V,E) :- !,prognBody(Body,V,E).
  %% Cond  %%
specialForm_call(cond,Body,V,E) :- !,condBody(Body,V,E).
  %%   De  %%
specialForm_call(de,[Name,Lambda|Body],Name,E) :- !,
    asserta(function(Name,closure(E,Lambda,Body))).
specialForm_call(de,_,_,_) :- lisp_err('de syntax error').

  %% Progn Body %%
prognBody([],[],_) :- !.
prognBody([F],V,E) :- !,lispEval(F,V,E).
prognBody([F|L],V,E) :- !,lispEval(F,_,E),prognBody(L,V,E).
prognBody(_,_,_) :- lisp_err('progn syntax error').

  %% Cond Body %%
condBody([],[],_) :- !.
condBody([Clause|_],V,E) :- commit(Clause,V,E),!.
condBody([_|Rest],V,E) :- !,condBody(Rest,V,E).
condBody(_,_,_) :- lisp_err('cond syntax error').

commit([U],V,E) :- lispEval(U,V,E),!,V/==[].
commit([H|B],V,E) :- lispEval(H,C,E),!,C/==[],prognBody(B,V,E).
commit(_,_,_) :- lisp_err('cond syntax error').

%%%%%%%%%%%%%%%%%%
%% subrFunction %%
%%%%%%%%%%%%%%%%%%

subrFunction(car).
subrFunction(cdr).
subrFunction(cons).
subrFunction(atom).
subrFunction(eq).


subrFunction(print).
subrFunction('+').
subrFunction('-').
subrFunction('>').
subrFunction('<').
subrFunction(read).
subrFunction(terpri).
subrFunction(help).
subrFunction(bye).
subrFunction(getdef).
subrFunction(load).
subrFunction(save).

%%% Car Cdr Cons Atom Eq %%%
subrFunction_call(car,[[Car|_]],Car):-!.
subrFunction_call(cdr,[[_|Cdr]],Cdr):-!.
subrFunction_call(cons,[Car,Cdr],[Car|Cdr]):-!.
subrFunction_call(atom,[[_|_]],[]):-!.
subrFunction_call(atom,[_],t):-!.
subrFunction_call(eq,[A,B],t):- A==B,!.
subrFunction_call(eq,[_,_],[]):-!.
subrFunction_call('<',[A,B],t):- A',[A,B],t):- A>B,!.
subrFunction_call('>',[_,_],[]):-!.

subrFunction_call(print,[Any],Any):-!,lispPrint1(Any).
subrFunction_call('+',[A,B],C) :-!, C is A + B.
subrFunction_call('-',[A,B],C) :-!, C is A - B.
subrFunction_call(read,[],L):-
		prompt(_,'|:'),errorset(lispRead(L),succ),!.
subrFunction_call(read,[],[]):-!.
subrFunction_call(help,[],t) :- subrFunction(A),write(A),tab(1),fail.
subrFunction_call(help,[],t) :- nl,specialForm(A),write(A),tab(1),fail.
subrFunction_call(help,[],t) :- nl,call(function(A,closure(_,B,_))),
				errorset(length(B,L),succ),write(A/L),
				tab(1),fail.
subrFunction_call(help,[],t) :-!, nl.
subrFunction_call(getdef,[F],[lambda,B,C]) :-call(function(F,closure(_,B,C))),!.
subrFunction_call(getdef,[_],[]):-!.
subrFunction_call(bye,[],t):-!.
subrFunction_call(terpri,[],t) :-!, nl.
subrFunction_call(save,[F],t) :-!, tell(F),listing(function),told.
subrFunction_call(load,[F],t) :- consult(F).

%%%%%%%%%%
%%%%%%%%%%
/*
lispEval([Macro|Args],V,E) :-
	macroFunction(Macro,ExpFunc),
	!,
	apply(ExpFunc,[[Macro|Args],E],ExpandedForm),
	lispEval(ExpandedForm,V,E).

 %%%  USER DEFINED FUNCTION    %%%
function(ap,closure([],[x,y],[[cond,[[eq,x,nil],y],[t,[cons,[car,x],[ap,[cdr,x],y]]]]]),_).

*/
%%%%%%%%
lisp_err(X) :- write(X),nl,abort.
%%%%%%%%