module algebra_with_store.

import store string_helpers.

%%% semantic domains
kind value		type.
kind boolean		type.
kind abstractValueField	type.

type tt			boolean.
type ff			boolean.

type theVoidValue	value.
type unitialized	typeExpr -> value.
type inInteger		int -> value.
type inTruthValue	boolean -> value.
type inObjectTuple	string -> (list abstractValueField) -> value.
type inLocation		location -> value.

type field		string -> value -> abstractValueField.


%%% algebras
kind algebra		type.

type evaluate_in_algebra	algebra -> string
					-> (list value) -> (store value)
					-> value -> (store value) -> o.

type add_compiled_method	algebra
					-> string -> (list methodFormal)
					-> procBody
					-> algebra.
type search_for_method		algebra -> string -> (list value)
					-> (list methodFormal) -> procBody
					-> o.

search_for_method (add_compiled_method A MName MFDecls Body)
		MName Actuals MFDecls Body :-
	!.
search_for_method (add_compiled_method A MName MFDecls Body)
		MName' Actuals MFDecls' Body' :-
	!,
	(search_for_method A MName' Actuals MFDecls' Body').


%%% auxiliary functions for objects, creation and field access
type makeAbstractValueTuple	(list string) -> (list value)
					-> (list abstractValueField) -> o.
makeAbstractValueTuple nil nil nil.
makeAbstractValueTuple (Name::Names) (Val::Vals) ((field Name Val)::Tuple) :-
	makeAbstractValueTuple Names Vals Tuple.

type get_field_of_tuple		(list abstractValueField) -> string
					-> value -> o.
get_field_of_tuple ((field Name Value)::Rest) Name Value :- !.
get_field_of_tuple ((field N V)::Rest) Name Value :-
	get_field_of_tuple Rest Name Value.


type set_field_of_tuple		(list abstractValueField) -> string
					-> value
					-> (list abstractValueField) -> o.
set_field_of_tuple ((field Name OldValue)::Rest) Name NewValue
		   ((field Name NewValue)::Rest) :- !.
set_field_of_tuple ((field N V)::OldRest) Name Value
		   ((field N V)::NewRest) :-
	set_field_of_tuple OldRest Name Value NewRest.


%%% special generic methods for field access.
evaluate_in_algebra A MName ((inLocation ObjLoc)::nil) Store FieldVal Store :-
	(split_string 4 MName "get_" FieldName),
	(access Store ObjLoc (inObjectTuple T Fields)),
	(get_field_of_tuple Fields FieldName FieldVal).

evaluate_in_algebra A MName ((inLocation ObjLoc)::NewVal::nil) Store
		theVoidValue Store' :-
	(split_string 4 MName "set_" FieldName),
	(access Store ObjLoc (inObjectTuple T Fields)),
	(set_field_of_tuple Fields FieldName NewVal NewFields),
	(update Store ObjLoc (inObjectTuple T NewFields) Store').