%%%%%%%%%%%%%%%%%

%%% 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.

%%%%%%%%