Permalink
Browse files

Adding a forth interpreter written with object, and eoom the meta-mod…

…ule to setup the environment
  • Loading branch information...
1 parent 6a6eed9 commit a43959856610fecefafaa15291b426814a29a00d @cthulhuology committed Apr 9, 2012
Showing with 90 additions and 9 deletions.
  1. +4 −1 Makefile
  2. +14 −0 eoom.erl
  3. +33 −0 forth.erl
  4. +39 −8 object.erl
View
@@ -10,7 +10,10 @@ all: $(BEAMS)
erlc $<
-.PHONY: clean
+.PHONY: clean console
clean:
rm *.beam
+console: $(BEAMS)
+ erl -s toolbar
+
View
@@ -0,0 +1,14 @@
+%%
+%% erlang out of memory
+%%
+%% eoom meta module
+%%
+
+-module(eoom).
+-author({ "David J. Goehrig", "dave@dloh.org"}).
+-copyright("© 2012 David J. Goehrig").
+-export([ init/0 ]).
+
+init() ->
+ O = object:new(),
+ O ! [ named, object ]. %% register base objec
View
@@ -0,0 +1,33 @@
+%%
+%% erlang out of memory
+%%
+%% a Forth object in eoom
+%%
+
+-module(forth).
+-author({ "David J. Goehrig", "dave@dloh.org"}).
+-copyright("© 2012 David J. Goehrig").
+-export([ new/0 ]).
+
+new() ->
+ Ok = object:new(),
+ Ok ! [ def, stack, [] ],
+ Ok ! [ add, lit, fun(Self,X) -> Self ! [ stack, Self, push, X ] end],
+ Ok ! [ add, push, fun(Self,Stack,Value) -> Self ! [ def, stack, [ Value | Stack ]] end],
+ Ok ! [ add, pop, fun(Self,[ _Top | Stack ]) -> Self ! [ def, stack, Stack ] end],
+ Ok ! [ add, dump, fun(_Self,Stack,_Arg) -> io:format("Stack: ~p~n", [ Stack ]) end],
+ Ok ! [ add, '+', fun(Self) -> Self ! [ stack, Self, plus, 0 ] end ],
+ Ok ! [ add, plus, fun(Self, [ Top, Next | Stack], _Value) -> Self ! [ def, stack, [ Top + Next | Stack ]] end ],
+ Ok ! [ add, '*', fun(Self) -> Self ! [ stack, Self, times, 0 ] end ],
+ Ok ! [ add, times, fun(Self, [ Top, Next | Stack], _Value) -> Self ! [ def, stack, [ Top * Next | Stack ]] end ],
+ Ok ! [ add, '-', fun(Self) -> Self ! [ stack, Self, minus, 0 ] end ],
+ Ok ! [ add, minus, fun(Self, [ Top, Next | Stack], _Value) -> Self ! [ def, stack, [ Next - Top | Stack ]] end ],
+ Ok ! [ add, '/', fun(Self) -> Self ! [ stack, Self, divide, 0 ] end ],
+ Ok ! [ add, divide, fun(Self, [ Top, Next | Stack], _Value) -> Self ! [ def, stack, [ Next div Top | Stack ]] end ],
+ Ok ! [ add, '%', fun(Self) -> Self ! [ stack, Self, mod, 0 ] end ],
+ Ok ! [ add, mod, fun(Self, [ Top, Next | Stack], _Value) -> Self ! [ def, stack, [ Next rem Top | Stack ]] end ],
+ Ok ! [ add, dup, fun(Self) -> Self ! [ stack, Self, duplicate, 0 ] end ],
+ Ok ! [ add, duplicate, fun(Self, [ Top | Stack ], _Value) -> Self ! [ def, stack, [ Top, Top | Stack ]] end ],
+ Ok ! [ add, swap, fun(Self) -> Self ! [ stack, Self, swaptwo, 0 ] end ],
+ Ok ! [ add, swaptwo, fun(Self, [ Top, Next | Stack ], _Value) -> Self ! [ def, stack, [ Next, Top | Stack ]] end ],
+ Ok.
View
@@ -9,24 +9,55 @@
-copyright("© 2012 David J. Goehrig").
-export([ new/0, new/1, init/1 ]).
+%% Construct a new object
new() ->
?MODULE:new(object).
new(Proto) ->
- spawn_link(?MODULE, init, [ { prototype, Proto } ]).
+ spawn_link(?MODULE, init, [[ { prototype, Proto } ]]).
init(State) ->
receive
- { addMethod, Method, Function } ->
+ [ free ] ->
+ io:format("freeing ~p~n", [ self() ]); %% we just dump our state and allow our process to end
+ [ dump ] ->
+ lists:map(fun({X,Y}) -> io:format("~p: ~p~n", [ X, Y]) end, State),
+ init(State);
+ %% define a member variable, usage: Object ! [ Var, Delegate, Method ]
+ [ def, Var, Value ] when is_atom(Var) ->
+ self() ! [ add, Var, fun(_Self,Pid,Method,Arg) -> Pid ! [ Method, Value, Arg ] end ],
+ init(State);
+ %% registers the object as a global process
+ [ named, Name ] ->
+ register(Name,self()),
+ init(State);
+ %% adds a method to the object, does not remove previous binding
+ [ add, Method, Function ] when is_atom(Method), is_function(Function) ->
State2 = [ { Method, Function } | State ],
init(State2);
- { removeMethod, Method } ->
+ %% removes a method from the object (does not affect prototypes, never resends!)
+ [ remove, Method ] when is_atom(Method) ->
State2 = proplists:delete(Method,State),
init(State2);
- [ Method | Args ] ->
- State2 = case proplists:is_defined(Method,State) of
- true -> erlang:apply(?MODULE,Method,Args);
- _ -> erlang:apply(proplists:get_value(prototype, State),Method,Args)
+ [ fetch, Method, Pid ] when is_atom(Method), is_pid(Pid) ->
+ Pid ! [ fetched, proplists:get_value(Method,State) ],
+ init(State);
+ %% lookup does a parent method lookup. It allows us to inspect
+ [ lookup, Method, Pid | Args ] when is_atom(Method), is_pid(Pid) -> %% Prototype method lookup
+ Pid ! [ lookedup, proplists:get_value(Method,State) | Args ], %% Return the module if we have it
+ init(State);
+ %% lookedup dispatches the prototypes method on ourself
+ [ lookedup, Method | Args ] when is_function(Method) -> %% Prototype looked up method
+ apply(Method, [ self() | Args ]), %% We call this as if it were ours
+ init(State);
+ %% Methods can't mutate object state! must use add/remove messages to mutate
+ [ Method | Args ] when is_atom(Method) ->
+ case proplists:is_defined(Method,State) of
+ true -> apply(proplists:get_value(Method,State),[ self() | Args ]); %% straight method call
+ _ -> Proto = proplists:get_value(prototype, State),
+ Proto ! [ lookup, Method, self() | Args ] %% beg our prototype for method
end,
- init(State2)
+ init(State);
+ _ -> %% ignore things we do not know how to do
+ init(State)
end.

0 comments on commit a439598

Please sign in to comment.