% Final Interview
%########## Call
this function first !! ##################
init:-op(800,fx,if),op(800,yfx,then),op(250,yfx,else),
op(800,fx,while),op(850,yfx,do),op(200,fx,return),
op(50,yfx, .),op(100,xfx,
:=),op(100,fx,class),op(100,fx,new),
assert(varstruct(dummyvarstruct)),assert(typed(dummytyped)).
%#########################################################
program(
Program, Fs, Vs ) :- reset,
stmt( Program, [], Fs, [], Vs ).
%******* ADDED:
dotted expression *********
stmt(
class(Rec,Fields) ,Fs,Fs,Vs,Vs ):-
recF(Rec,Fields).
stmt(
Var:=new(Rec) ,Fs,Fs,Vs,Vs ):-
not(varstruct(Var)),new_rec(Var,Rec),assert(typed(Rec)).
stmt( Var := E,
Fs, Fs, Vsi, Vso ) :-
expr_value(E, Fs, Vsi, Val),
store(Var, Val, Vsi, Vso).
stmt( Var := E,
Fs, Fs, Vsi, Vso ) :-
not(regular(Var)),
expr_value(E, Fs, Vsi, Val), Vso=Val,
setValVar(Var,Val).
stmt( Var := E,
Fs, Fs, Vsi, Vso ) :-
not(regular(E)),
getValVar(E,Val),
store(Var, Val, Vsi, Vso).
stmt( Var := E,
Fs, Fs, Vs, Vs ) :-
not(regular(Var)),not(regular(E)),
getValVar(E,Val),
setValVar(Var,Val).
stmt( S1; S2 ,
Fsi, Fso, Vsi, Vso ) :-
stmt(S1, Fsi, Fsx, Vsi, Vsx),
stmt(S2, Fsx, Fso, Vsx, Vso).
stmt(
function(F, Body), Fsi, Fso, Vs, Vs ) :-
F =.. [Name | Params],
store(Name, function(Params, Body), Fsi,
Fso).
% ***** old if
*****
stmt( if(Cond,
ThenPart, ElsePart), Fsi, Fso, Vsi, Vso ) :-
expr_value(Cond, Fsi, Vsi, Val),
ifBody(Val, ThenPart, ElsePart, Fsi, Fso, Vsi, Vso).
%****** new
if ******
stmt( if(Cond)
then(ThenPart) else(ElsePart), Fsi, Fso, Vsi, Vso ) :-
expr_value(Cond, Fsi, Vsi, Val),
ifBody(Val, ThenPart, ElsePart, Fsi, Fso, Vsi, Vso).
% ***** old while
*****
stmt(
while(Cond, Body), Fsi, Fso, Vsi, Vso ) :-
expr_value(Cond, Fsi, Vsi, Val),
whileBody(Val, Cond, Body, Fsi, Fso, Vsi,
Vso),write('while 1'),nl.
% ***** new while
*****
stmt(
while(Cond) do(Body), Fsi, Fso, Vsi, Vso ) :-
expr_value(Cond, Fsi, Vsi, Val),
whileBody(Val, Cond, Body, Fsi, Fso, Vsi,
Vso),write('while 2'),nl.
stmt(
dowhile(Body, Cond), Fsi, Fso, Vsi, Vso ) :-
stmt( Body; while(Cond) do(Body), Fsi, Fso,
Vsi, Vso).
stmt(
return(Expr), Fs, Fs, Vsi, Vso) :-
stmt( result := Expr, Fs, Fs, Vsi, Vso).
ifBody(true,
ThenPart, _ElsePart, Fsi, Fso, Vsi, Vso) :-
stmt(ThenPart, Fsi, Fso, Vsi, Vso).
ifBody(false,
_ThenPart, ElsePart, Fsi, Fso, Vsi, Vso) :-
stmt(ElsePart, Fsi, Fso, Vsi, Vso).
whileBody(true,
Cond, Body, Fsi, Fso, Vsi, Vso) :-
stmt( Body; while(Cond, Body), Fsi, Fso,
Vsi, Vso),write('while Body True'),nl.
whileBody(false,
_, _, Fs, Fs, Vs, Vs):-write('while Body False'),nl.
%##################################################################
expr_value(E,_,Vs,V):-not(varstruct(E)),atomic(E),!,token_value(E,Vs,V).
expr_value(Var,_,_,Val):-varstruct(Var),
getValVar(Var,Val).
expr_value([E |
Es], Fs, Vs, [V | VRest]) :- !,
expr_value(E, Fs, Vs, V),
expr_value(Es, Fs, Vs, VRest).
expr_value(E,
Fs, Vs, V ) :-
E =.. [Name | Args],
expr_value(Args, Fs, Vs, ArgValues),
Expr =.. [Name | ArgValues],
perform(Name, Expr, Fs, V).
token_value(T,
_, T) :- literal(T), !.
token_value(Ident,
Vs, V) :- identifier(Ident), !, fetch(Ident, Vs, V).
token_value(T,
_, _) :-
write('ERROR: Invalid token: '),
writeln(T),
fail.
literal(Int) :-
integer(Int).
literal(Lit) :-
member(Lit, [true, false, null, []]).
identifier(Ident)
:-
atomic(Ident),
\+ literal(Ident),
\+ current_op(_, _, Ident),
atom_chars(Ident, [First | _Rest]),
char_type(First, lower).
perform(Op,
Expr, _Fs, V) :-
member(Op, [+, -, *]), !,
V is Expr.
perform(Op,
Expr, _Fs, V) :-
member(Op, [==, =\=, >, >=, <,
=<]), !,
boolean(Expr, V).
perform(Name,
Expr, Fs, V) :-
fetch(Name, Fs, function(Params, Body)),
Expr =.. [Name | ArgValues],
bind(Params, ArgValues, [], Vs_bound),
stmt(Body, Fs, _, Vs_bound, Rs),
fetch(result, Rs, V).
boolean(E, true)
:- E, !.
boolean(_,
false).
bind( [], _, Vs,
Vs).
bind( [Ph|Pt],
[Ah|At], Vs_in, Vs_out ) :-
store( Ph, Ah, Vs_in, Vs_temp ),
bind( Pt, At, Vs_temp, Vs_out ).
%##################################################################
fetch(Val,_S,Val):-literal(Val),
!.
fetch(Var,S,Val)
:-member(Var = Val, S), !.
fetch(Var, _, _)
:-
not(varstruct(Var)),
not(typed(Var)),
write('ERROR: Attempting to retreive value
of undefined variable: '),
writeln(Var),
fail.
store(Val, _, S,
S) :- literal(Val), !.
store(Var, Val,
S_in, [Var = Val | S_out]) :-
not(typed(Var)),
deleteOnce(Var = _, S_in, S_out).
deleteOnce(X, [X
| Xs], Xs) :- !.
deleteOnce(X, [Y
| Ys], [Y | Zs]) :- deleteOnce(X, Ys, Zs).
deleteOnce(_,
[], []).
%##################################################################
% called when we
see class(rec,[a,b,c.....])
recF(Rec,F):-assert( record(Rec,F) ). % associate record
"Rec" with fields "F"
%==== setup the
variable with fields, all fields are set to "null" ====
setfield(_,[]).
setfield(Var,[F|Fs]):-assert(
fieldof(Var,F,null) ), setfield(Var,Fs).
%==== called
when we encounter "Var=new(Rec)" ====
% declare the
variable to be structured with "varstruct(Var)"
new_rec(Var,Rec):-
record(Rec,Field), % retrieve
fields from rec
setfield(Var,Field), % set the field for the variable
assert( varstruct(Var)
). % declare var to be of type
"structured"
%==== called
when we do "x.a=5"==>
setValF(x,a,5) ====
setVal(Var,F,Val):-retractall(
fieldof(Var,F,_) ), % remove old predicate
assert( fieldof(Var,F,Val)
). % replace with new one
getVal(Var,F,Val):-
fieldof(Var,F,Val).
lastelem(X,[X]).
lastelem(X,[_|L]):-lastelem(X,L).
flatten(List,
Flat) :- flatten(List, Flat, []).
flatten([], Res,
Res) :- !.
flatten([Head|Tail],
Res, Cont) :- !,
flatten(Head, Res, Cont1),
flatten(Tail, Cont1, Cont).
flatten(Term,
[Term|Cont], Cont).
%***** getminor(
a.b.c.d.e , L ) ==> L=e *****
getminor(Var,L):-flatten(Var,F),lastelem(L,F).
%***** getmajor(
a.b.c.d.e , L ) ==> L=a.b.c.d *****
getmajor(Var,L):-
getminor(Var,M),append(Temp,M,Var), [L|_]=Temp .
%
getmajor(Var,L):- getminor(Var,M),append(L,M,Var) .
%***** getfield(
a.b.c.d.e , L ) ==> L=e *****
getfield(Var,L):-flatten(Var,F),lastelem(L,F).
%***** getvar(
a.b.c.d.e , L ) ==> L=a.b.c.d *****
getvar(Var,L):-
getminor(Var,M),append(L,M,Var).
/********************************************
op(100,yfx, .).
X=a.b.c.d.e.f.
==> X = [[[[[a|b]|c]|d]|e]|f]
getfield([[[[[a|b]|c]|d]|e]|f]
,L) ==> L = f
getvar([[[[[a|b]|c]|d]|e]|f]
,L) ==> L = [[[[[a|b]|c]|d]|e]]
********************************************/
setValVar(Var,Val):-getmajor(Var,Major),getfield(Var,Minor),setVal(Major,Minor,Val).
getValVar(Var,Val):-getmajor(Var,Major),getfield(Var,Minor),getVal(Major,Minor,Val).
regular(Var):-getminor(Var,L),L==Var.
reset:-retractall(fieldof(X,Y,Z)),retractall(record(X,Y)),retractall(varstruct(X)),typed(X),!.
%##############################################################
%##############################################################
%##############################################################
/*####################
TESTS #######################
*** addition ***
program(
function(sum(a,b), return(a+b)
);s:=sum(100,300),F,V)==>
F = [sum=function([a,
b], return (a+b))]
V = [s=400]
***
multiplication ***
program(
function(mul(x,y),return(x * y) );z:=mul(5,5),F,V)==>
F =
[mul=function([x, y], return(x*y))]
V = [z=25] ;
*** factorial ***
program(function(factorial(x),if(x<2)
then(return(1)) else(temp:=factorial(x-1)
;return(x*temp)));z:=factorial(5),Fs,Vs)==>
Fs =
[factorial=function([x], (if (x<2))then (return 1)else
(temp:=factorial(x-1);return (x*temp)))]
Vs = [z=120] ;
*** Fibonnacci number
fibo(x), x<=16 works fine, after 16 "out of global stack" ***
********
recursive nested if ************
program(
function(fibo(n), if(n==0)
then(return(0)) else(if(n==1) then(return(1)) else(if(n>1)
then(return(fibo(n-1)+fibo(n-2))) else(_)))) ;s:=fibo(16),F,V).
F =
[fibo=function([n], (if (n==0))then (return 0)else (if (n==1))then (return
1)else (if (... >...))then (return...)else _G49)]
V = [s=987] ;
****************
without executing
"init" first while( , ) works, then after while() do() doesnt work
after doing "init"
program(a:=221;b:=493;while(a=\=b,if(a>b,a:=a-b,b:=b-a))
,Fs,Vs)
Fs = []
Vs = [b=17, a=17]
;
program(a:=221;b:=493;while(a=\=b)
do( if(a>b) then(a:=a-b) else(b:=b-a) ) ,Fs,Vs)==> not working
But this while()
do() works fine
program(a:=1;b:=1;
while(a==b) do( a:=5; b:=10 ) ,Fs,Vs).
Fs = []
Vs = [b=8, a=10]
;
****************
Testing dotted
expressions
program(class(cor,[x,y,z]);f:=new(cor);a:=5;
f.y:=8 , Fs, Vs)==>
Fs = []
Vs = [[f|y]=8,
a=5] ;
program(class(cor,[x,y,z]);f:=new(cor);a:=5;
f.y:=a , Fs, Vs)==>
Vs = [[f|y]=5,
a=5] ;
##################################################*/