diff --git a/.gitignore b/.gitignore index 042c6b7..945ee20 100644 --- a/.gitignore +++ b/.gitignore @@ -22,4 +22,7 @@ al-*.tar # Temporary files, for example, from tests. /tmp/ -/.mnesiastore/ \ No newline at end of file +/.mnesiastore/ + +# Mnesia core/checkpoint dumps written to the project root. +/MnesiaCore.* \ No newline at end of file diff --git a/.mnesiastore/LATEST.LOG b/.mnesiastore/LATEST.LOG deleted file mode 100644 index 3fbfe36..0000000 Binary files a/.mnesiastore/LATEST.LOG and /dev/null differ diff --git a/.mnesiastore/meta.DCD b/.mnesiastore/meta.DCD deleted file mode 100644 index f8dd237..0000000 --- a/.mnesiastore/meta.DCD +++ /dev/null @@ -1 +0,0 @@ -cXM \ No newline at end of file diff --git a/.mnesiastore/schema.DAT b/.mnesiastore/schema.DAT deleted file mode 100644 index 12e5d60..0000000 Binary files a/.mnesiastore/schema.DAT and /dev/null differ diff --git a/README.md b/README.md index 5771e2e..38fc6dc 100644 --- a/README.md +++ b/README.md @@ -1,35 +1,49 @@ # AL -**TODO: Add description** +AL is a live, ACID, (eventually) bitemporal, relational-object operating system built around an append-only command log. It combines inspiration from: -## Installation +- XTDB -If [available in Hex](https://hex.pm/docs/publish), the package can be installed -by adding `al` to your list of dependencies in `mix.exs`: +- GlamorousToolkit/Pharo -```elixir -def deps do - [ - {:al, "~> 0.1.0"} - ] -end -``` +- Git -Documentation can be generated with [ExDoc](https://github.com/elixir-lang/ex_doc) -and published on [HexDocs](https://hexdocs.pm). Once published, the docs can -be found at . +- PROLOG +- LISP -TODO +- BEAM -- Re-evaluate this list! +- Urbit -- Loads more docs -- concurrency +The goal of the system is to be the first truly principled object-oriented PROLOG, and the personal computing environment of the future. +This runtime is the first version of AL, written in Elixir. The irony of the first Erlang interpreter having been written in PROLOG is not lost on us. -- constraint processing +## Features -- more bootstrapping for diff kinds of objects +- Live Smalltalk-style objects, defined relationally. No more faux-ADTs. Define protocols and their implementations. Mix and match at your leisure. +- Bidirectional Execution thanks to WAM semantics. +- Shutdown your system, continue later. All transactions are backed up by an on-disk database, hydrated at startup. +- ACID transactions ensure your work is safe and easy to reason about. +- Constraint Processing -- system wipes and rollbacks +And to come: + +- Bitemporality features: Model temporal systems. Spin off new branches of your system at different points in time and move between them easily. + +For discussion of the design philosophy of AL and resources that were consulted during its design, please see: +https://forum.anoma.net/t/design-philosophy-of-al-bibliography/2698 + +## Getting Started + +Install from terminal using `iex -S mix` or as a mix dependency. +From IEx, you can run `require AL`. + +`lib/examples` contains examples. +`lib/AL/package` contains the bundled packages (the `bootstrap` package is the foundational one). +`lib/AL` contains the runtime code. + +Tips: + +- Use `examine(:my_object_id_here, info)` in order to get quick information about an object via its ID, such as its class(es!), superclass(es!), methods, and in the case of method objects, relevant clauses. diff --git a/config/config.exs b/config/config.exs index e7c293c..b16ccc8 100644 --- a/config/config.exs +++ b/config/config.exs @@ -5,6 +5,15 @@ config :logger, handle_otp_reports: false, handle_sasl_reports: false +# Packages installed at startup. +config :al, + packages: [ + AL.Package.Bootstrap, + AL.Package.Users, + AL.Package.ElixirProcess, + AL.Package.Constraints + ] + # Import environment specific config. This must remain at the bottom # of this file so it overrides the configuration defined above. if File.exists?("config/#{config_env()}.exs") do diff --git a/config/test.exs b/config/test.exs index fd8b896..27d5c9e 100644 --- a/config/test.exs +++ b/config/test.exs @@ -2,5 +2,3 @@ import Config config :logger, level: :error - -config :al, mnesia_storage: :ram_copies diff --git a/lib/AL.ex b/lib/AL.ex index 79802b1..f8c8196 100644 --- a/lib/AL.ex +++ b/lib/AL.ex @@ -70,9 +70,15 @@ defmodule AL do | {:retract_super, AL.Var.t(), AL.Var.t()} | {:retract_method, AL.Var.t(), AL.Var.t(), AL.Var.t()} | {:retract_oapply, AL.Var.t(), AL.Var.t()} - | {:spawn_process, AL.Var.t(), AL.Var.t(), [goal()]} + | {:retract_slots, AL.Var.t(), AL.Var.t()} + | {:send_async, AL.Var.t(), AL.Var.t(), AL.Var.t()} + | {:send_elixir, AL.Var.t(), AL.Var.t()} | {:gensym, AL.Var.t()} | {:print, AL.Var.t()} + | {:not, [goal()]} + | {:unify, AL.Var.t(), AL.Var.t()} + | {:call, [AL.Var.t()], [goal()], [AL.Var.t()]} + | {:send, AL.Var.t(), AL.Var.t(), AL.Var.t()} | :fail @type stack_entry() :: AL.Choicepoint.t() | {:mark, scope()} | :implies_mark @@ -83,6 +89,9 @@ defmodule AL do field(:tx_id, non_neg_integer(), enforce: true, default: 0) field(:trace, [goal()], enforce: true, default: []) field(:program, [goal()], enforce: true, default: []) + field(:tracepoints, MapSet.t(), enforce: true, default: %MapSet{}) + field(:traced_calls, %{optional(scope()) => tuple()}, default: %{}) + field(:store, AL.Object.store(), default: :main) end defmacro __using__(_opts) do @@ -91,6 +100,15 @@ defmodule AL do end end + defdelegate trace(point), to: AL.Trace + defdelegate untrace(point), to: AL.Trace + defdelegate notrace(), to: AL.Trace + defdelegate tracepoints(), to: AL.Trace + + @arithmetic_ops [:+, :-, :*, :/, :**] + @oapply_primitives [:is, :map_get, :map_put, :lookup, :fresh_id, :current_tx] + @primitive_methods [:is, :map_get, :map_put, :gensym, :fresh_id] + def ast_to_pattern([{:do, {:__block__, _, goals}}]), do: ast_to_pattern(goals) def ast_to_pattern([{:do, nil}]), do: nil @@ -161,6 +179,9 @@ defmodule AL do def ast_to_pattern({:retract_oapply, _, [object, head]}), do: {:retract_oapply, ast_to_pattern(object), ast_to_pattern(head)} + def ast_to_pattern({:retract_slots, _, [object, slots]}), + do: {:retract_slots, ast_to_pattern(object), ast_to_pattern(slots)} + def ast_to_pattern({:gensym, _, [var]}), do: {:gensym, ast_to_pattern(var)} def ast_to_pattern({:print, _, [pattern]}), do: {:print, ast_to_pattern(pattern)} @@ -174,37 +195,70 @@ defmodule AL do def ast_to_pattern({:findall, _, [template, condition, result]}), do: {:findall, ast_to_pattern(template), ast_to_pattern(condition), ast_to_pattern(result)} - def ast_to_pattern({:spawn_process, _, [object, head, body]}), - do: {:spawn_process, ast_to_pattern(object), ast_to_pattern(head), ast_to_pattern(body)} + + def ast_to_pattern({:not, _, [goals]}), + do: {:not, ast_to_pattern(goals)} + + def ast_to_pattern({:unify, _, [a, b]}), + do: {:unify, ast_to_pattern(a), ast_to_pattern(b)} + + def ast_to_pattern({:call, _, [head, body, args]}), + do: {:call, ast_to_pattern(head), ast_to_pattern(body), ast_to_pattern(args)} + + def ast_to_pattern({:send, _, [receiver, method, args]}), + do: {:send, ast_to_pattern(receiver), ast_to_pattern(method), ast_to_pattern(args)} + + def ast_to_pattern({:send_async, _, [object, method, args]}), + do: {:send_async, ast_to_pattern(object), ast_to_pattern(method), ast_to_pattern(args)} + + def ast_to_pattern({:send_elixir, _, [pid, message]}), + do: {:send_elixir, ast_to_pattern(pid), ast_to_pattern(message)} def ast_to_pattern({:defmethod, _, [class, method_name, head, body]}) do - {:oapply, :defmethod, [ - ast_to_pattern(class), - ast_to_pattern(method_name), - ast_to_pattern(head), - ast_to_pattern(body)] - } + {:oapply, :defmethod, + [ + ast_to_pattern(class), + ast_to_pattern(method_name), + ast_to_pattern(head), + ast_to_pattern(body) + ]} end + def ast_to_pattern({op, _, args}) when op in @arithmetic_ops and is_list(args), + do: {:oapply, op, Enum.map(args, &ast_to_pattern/1)} + + def ast_to_pattern({fun, _, args}) when fun in @oapply_primitives and is_list(args), + do: {:oapply, fun, Enum.map(args, &ast_to_pattern/1)} + + def ast_to_pattern({method, _, [receiver | args]}) when is_atom(method) and is_list(args), + do: {:send, ast_to_pattern(receiver), method, Enum.map(args, &ast_to_pattern/1)} + def ast_to_pattern({fun, _, args}) when is_atom(fun) and is_list(args), do: {:oapply, fun, Enum.map(args, &ast_to_pattern/1)} def ast_to_pattern({name, _, _module}), do: AL.Var.var(name) + def ast_to_pattern({a, b}), do: {ast_to_pattern(a), ast_to_pattern(b)} + def ast_to_pattern(x), do: x @doc """ - I provide the DSL for the AL interpreter + I provide the DSL for the AL interpreter. I run against the live store by + default; `run store: s do ... end` runs against store `s` (e.g. a `fork`). """ - defmacro run(do: program) do + defmacro run(opts \\ [], do: program) do goals = case ast_to_pattern(program) do list when is_list(list) -> list goal -> [goal] end - quote do - AL.eval(unquote(Macro.escape(goals, unquote: true))) + escaped = Macro.escape(goals, unquote: true) + + if Keyword.has_key?(opts, :store) do + quote do: AL.eval(unquote(escaped), nil, unquote(opts[:store])) + else + quote do: AL.eval(unquote(escaped), nil, AL.Branch.head()) end end @@ -254,8 +308,9 @@ defmodule AL do TODO fix leakiness on -> marks? Or maybe not necessary TODO Make fresheners deterministic """ - @spec eval([goal()], AL.Var.bindings()) :: {:atomic, t() | nil} | {:aborted, term()} - def eval(program, initial_bindings \\ nil) do + @spec eval([goal()], AL.Var.bindings(), AL.Object.store()) :: + {:atomic, t() | nil} | {:aborted, term()} + def eval(program, initial_bindings \\ nil, store \\ :main) do bindings = initial_bindings || AL.Var.empty_bindings() input_vars = AL.Var.find_vars(program) @@ -273,23 +328,27 @@ defmodule AL do }, choicepoint_stack: [{:mark, 0}], tx_id: tx_id, + store: store, trace: [], - program: program + program: program, + tracepoints: AL.Trace.tracepoints() }) if result.active_choicepoint.bindings == nil do :mnesia.abort(format_failure(result.trace)) else - output_vars = input_vars - |> Enum.map(fn variable -> - val = AL.Var.subst(variable, result.active_choicepoint.bindings) - if AL.Var.var?(val) do - {variable, variable} - else - {variable, val} - end - end) - |> Map.new() + output_vars = + input_vars + |> Enum.map(fn variable -> + val = AL.Var.subst(variable, result.active_choicepoint.bindings) + + if AL.Var.var?(val) do + {variable, variable} + else + {variable, val} + end + end) + |> Map.new() {output_vars, result} end @@ -336,8 +395,8 @@ defmodule AL do } } - [{:mark, _} | rest_choices] -> - backtrack(%AL{state | choicepoint_stack: rest_choices}) + [{:mark, f} | rest_choices] -> + backtrack(%AL{trace_fail(state, f) | choicepoint_stack: rest_choices}) [:implies_mark | rest_choices] -> backtrack(%AL{state | choicepoint_stack: rest_choices}) @@ -394,7 +453,6 @@ defmodule AL do } result = interp(goal, next_frame) - continue(result) end end @@ -423,41 +481,51 @@ defmodule AL do } end else - case AL.Objects.scan_class(object_pattern, class_pattern) do - [] -> - backtrack(state) - - [choice | next_choices] -> - %AL{ - state - | active_choicepoint: %AL.Choicepoint{ - state.active_choicepoint - | bindings: - AL.Var.unify( - choice, - {:class, object_pattern, class_pattern}, - state.active_choicepoint.bindings - ) - }, - choicepoint_stack: - Enum.map(next_choices, fn c -> - %AL.Choicepoint{ - state.active_choicepoint - | bindings: - AL.Var.unify( - c, - {:class, object_pattern, class_pattern}, - state.active_choicepoint.bindings - ) - } - end) ++ state.choicepoint_stack - } + if is_list(object_pattern) do + %AL{ + state + | active_choicepoint: %AL.Choicepoint{ + state.active_choicepoint + | bindings: AL.Var.unify(:list, class_pattern, state.active_choicepoint.bindings) + } + } + else + case AL.Object.scan_class(object_pattern, class_pattern, state.store) do + [] -> + backtrack(state) + + [choice | next_choices] -> + %AL{ + state + | active_choicepoint: %AL.Choicepoint{ + state.active_choicepoint + | bindings: + AL.Var.unify( + choice, + {:class, object_pattern, class_pattern}, + state.active_choicepoint.bindings + ) + }, + choicepoint_stack: + Enum.map(next_choices, fn c -> + %AL.Choicepoint{ + state.active_choicepoint + | bindings: + AL.Var.unify( + c, + {:class, object_pattern, class_pattern}, + state.active_choicepoint.bindings + ) + } + end) ++ state.choicepoint_stack + } + end end end end def interp({:get_super, object_pattern, super_pattern}, state) do - case AL.Objects.scan_super(object_pattern, super_pattern) do + case AL.Object.scan_super(object_pattern, super_pattern, state.store) do [] -> backtrack(state) @@ -490,7 +558,12 @@ defmodule AL do end def interp({:get_method, object_pattern, method_name_pattern, method_id_pattern}, state) do - case AL.Objects.scan_method(object_pattern, method_name_pattern, method_id_pattern) do + case AL.Object.scan_method( + object_pattern, + method_name_pattern, + method_id_pattern, + state.store + ) do [] -> backtrack(state) @@ -523,7 +596,7 @@ defmodule AL do end def interp({:get_oapply, object_pattern, head_pattern, body_pattern}, state) do - case AL.Objects.scan_oapply(object_pattern, head_pattern, body_pattern) do + case AL.Object.scan_oapply(object_pattern, head_pattern, body_pattern, state.store) do [] -> backtrack(state) @@ -555,24 +628,23 @@ defmodule AL do end end - def interp({:oapply, :gensym, [result]}, state) do - fresh = :"gensym_#{System.unique_integer([:monotonic, :positive])}" - + def interp({:oapply, :fresh_id, [result]}, state) do %AL{ state | active_choicepoint: %AL.Choicepoint{ state.active_choicepoint - | bindings: AL.Var.unify(result, fresh, state.active_choicepoint.bindings) + | bindings: + AL.Var.unify(result, AL.Command.fresh_id(), state.active_choicepoint.bindings) } } end - def interp({:oapply, :fresh_id, [result]}, state) do + def interp({:oapply, :current_tx, [result]}, state) do %AL{ state | active_choicepoint: %AL.Choicepoint{ state.active_choicepoint - | bindings: AL.Var.unify(result, AL.Command.fresh_id(), state.active_choicepoint.bindings) + | bindings: AL.Var.unify(result, state.tx_id, state.active_choicepoint.bindings) } } end @@ -604,24 +676,50 @@ defmodule AL do end end + def interp({:oapply, :map_put, [m1, k_pattern, v_pattern, m2]}, state) do + case AL.Var.unify(m2, Map.put(m1, k_pattern, v_pattern), state.active_choicepoint.bindings) do + nil -> + backtrack(state) + + choice -> + %AL{ + state + | active_choicepoint: %AL.Choicepoint{ + state.active_choicepoint + | bindings: choice + }, + choicepoint_stack: state.choicepoint_stack + } + end + end + def interp({:oapply, :is, [a, b]}, state) do a_deref = AL.Var.deref(state.active_choicepoint.bindings, a) - expr = interp_is(b, state.active_choicepoint.bindings) - %AL{state | - active_choicepoint: %AL.Choicepoint{ - state.active_choicepoint | - bindings: AL.Var.unify(a_deref, expr, state.active_choicepoint.bindings), - }, - choicepoint_stack: state.choicepoint_stack} + + case interp_is(b, state.active_choicepoint.bindings) do + :error -> + backtrack(state) + + expr -> + %AL{ + state + | active_choicepoint: %AL.Choicepoint{ + state.active_choicepoint + | bindings: AL.Var.unify(a_deref, expr, state.active_choicepoint.bindings) + }, + choicepoint_stack: state.choicepoint_stack + } + end end def interp({:oapply, method_id_pattern, bind_head_pattern}, state) do - case AL.Objects.scan_oapply(method_id_pattern, :"$head", :"$body") do + trace_info = trace_call(state, method_id_pattern, bind_head_pattern) + + case AL.Object.scan_oapply(method_id_pattern, :"$head", :"$body", state.store) do [] -> backtrack(state) [{:oapply, id, head, body} | next_choices] -> - freshener = AL.Command.fresh_scope() head_pattern = AL.Var.freshen(head, freshener) @@ -663,6 +761,7 @@ defmodule AL do goal_pointer: 0, scope_pointer: freshener }, + traced_calls: record_traced_call(state.traced_calls, freshener, trace_info), choicepoint_stack: alternative_choicepoints ++ [{:mark, freshener} | state.choicepoint_stack] } @@ -676,8 +775,11 @@ defmodule AL do choicepoint_stack: Enum.drop_while(state.choicepoint_stack, fn choice -> case choice do - {:mark, f} -> f != state.active_choicepoint.scope_pointer - _choice -> true + {:mark, f} -> + f != state.active_choicepoint.scope_pointer + + _choice -> + true end end) } @@ -747,36 +849,47 @@ defmodule AL do end def interp({:set_class, object, _class}, state) when is_map(object), do: state + def interp({:set_class, object_pattern, class_pattern}, state) do - AL.Command.set_class(state.tx_id, object_pattern, class_pattern) - AL.Objects.set_class(object_pattern, class_pattern) + AL.Command.set_class(state.tx_id, object_pattern, class_pattern, state.store) + AL.Object.set_class(object_pattern, class_pattern, state.store) state end def interp({:set_super, object, _super}, state) when is_map(object), do: state + def interp({:set_super, object_pattern, super_pattern}, state) do - AL.Command.set_super(state.tx_id, object_pattern, super_pattern) - AL.Objects.set_super(object_pattern, super_pattern) + AL.Command.set_super(state.tx_id, object_pattern, super_pattern, state.store) + AL.Object.set_super(object_pattern, super_pattern, state.store) state end def interp({:set_method, object, _name, _id}, state) when is_map(object), do: state + def interp({:set_method, object_pattern, method_name_pattern, method_id_pattern}, state) do - AL.Command.set_method(state.tx_id, object_pattern, method_name_pattern, method_id_pattern) - AL.Objects.set_method(object_pattern, method_name_pattern, method_id_pattern) + AL.Command.set_method( + state.tx_id, + object_pattern, + method_name_pattern, + method_id_pattern, + state.store + ) + + AL.Object.set_method(object_pattern, method_name_pattern, method_id_pattern, state.store) state end def interp({:set_oapply, object, _head, _body}, state) when is_map(object), do: state + def interp({:set_oapply, object_pattern, head_pattern, body_pattern}, state) do - AL.Command.set_oapply(state.tx_id, object_pattern, head_pattern, body_pattern) - AL.Objects.set_oapply(object_pattern, head_pattern, body_pattern) + AL.Command.set_oapply(state.tx_id, object_pattern, head_pattern, body_pattern, state.store) + AL.Object.set_oapply(object_pattern, head_pattern, body_pattern, state.store) state end def interp({:get_slot, object, key, value}, state) do entries = - case :mnesia.read(:slots, object) do + case AL.Object.read_slots(object, state.store) do [{:slots, ^object, m}] when is_map(m) -> if AL.Var.var?(key) do Map.to_list(m) @@ -815,43 +928,60 @@ defmodule AL do end def interp({:set_slots, object, _slots}, state) when is_map(object), do: state + def interp({:set_slots, object_pattern, slots_pattern}, state) do - AL.Command.set_slots(state.tx_id, object_pattern, slots_pattern) - AL.Objects.set_slots(object_pattern, slots_pattern) + AL.Command.set_slots(state.tx_id, object_pattern, slots_pattern, state.store) + AL.Object.set_slots(object_pattern, slots_pattern, state.store) state end def interp({:retract_class, object, _class}, state) when is_map(object), do: state + def interp({:retract_class, object, class}, state) do - AL.Command.retract_class(state.tx_id, object, class) - AL.Objects.retract_class(object, class) + AL.Command.retract_class(state.tx_id, object, class, state.store) + AL.Object.retract_class(object, class, state.store) state end def interp({:retract_super, object, _super}, state) when is_map(object), do: state + def interp({:retract_super, object, super}, state) do - AL.Command.retract_super(state.tx_id, object, super) - AL.Objects.retract_super(object, super) + AL.Command.retract_super(state.tx_id, object, super, state.store) + AL.Object.retract_super(object, super, state.store) state end def interp({:retract_method, object, _name, _id}, state) when is_map(object), do: state + def interp({:retract_method, object, name, id}, state) do - AL.Command.retract_method(state.tx_id, object, name, id) - AL.Objects.retract_method(object, name, id) + AL.Command.retract_method(state.tx_id, object, name, id, state.store) + AL.Object.retract_method(object, name, id, state.store) state end def interp({:retract_oapply, object, _head}, state) when is_map(object), do: state + def interp({:retract_oapply, object, head}, state) do - AL.Command.retract_oapply(state.tx_id, object, head) - AL.Objects.retract_oapply(object, head) + AL.Command.retract_oapply(state.tx_id, object, head, state.store) + AL.Object.retract_oapply(object, head, state.store) + state + end + + def interp({:retract_slots, object, _slots}, state) when is_map(object), do: state + + def interp({:retract_slots, object, slots}, state) do + AL.Command.retract_slots(state.tx_id, object, slots, state.store) + AL.Object.retract_slots(object, slots, state.store) + state + end + + def interp({:send_async, object, method, args}, state) do + AL.Command.send_async(state.tx_id, object, method, args, state.store) state end - - def interp({:spawn_process, object, head, body}, state) do - AL.Command.spawn_process(state.tx_id, object, head, body) + def interp({:send_elixir, pid, message}, state) do + AL.Command.send_elixir(state.tx_id, pid, message, state.store) state end @@ -874,7 +1004,13 @@ defmodule AL do end def interp({:forall, condition, body}, state) do - solutions = collect_all_solutions(condition, state.active_choicepoint.bindings, state.tx_id) + solutions = + collect_all_solutions( + condition, + state.active_choicepoint.bindings, + state.tx_id, + state.store + ) body_goals = Enum.flat_map(solutions, fn bindings -> @@ -890,7 +1026,13 @@ defmodule AL do end def interp({:findall, template, condition, result}, state) do - solutions = collect_all_solutions(condition, state.active_choicepoint.bindings, state.tx_id) + solutions = + collect_all_solutions( + condition, + state.active_choicepoint.bindings, + state.tx_id, + state.store + ) collected = Enum.map(solutions, fn bindings -> AL.Var.subst(template, bindings) end) @@ -903,11 +1045,140 @@ defmodule AL do } end + def interp({:call, head, body, args}, state) do + freshener = AL.Command.fresh_scope() + fresh_head = AL.Var.freshen(head, freshener) + fresh_body = AL.Var.freshen(body, freshener) + + bindings = AL.Var.unify(fresh_head, args, state.active_choicepoint.bindings) + + if bindings == nil do + backtrack(state) + else + continuation = %AL.Continuation{ + goals: state.active_choicepoint.goals, + goal_pointer: state.active_choicepoint.goal_pointer, + scope_pointer: state.active_choicepoint.scope_pointer + } + + %AL{ + state + | active_choicepoint: %AL.Choicepoint{ + goals: fresh_body, + bindings: bindings, + continuations: [continuation | state.active_choicepoint.continuations], + goal_pointer: 0, + scope_pointer: freshener + }, + choicepoint_stack: [{:mark, freshener} | state.choicepoint_stack] + } + end + end + + def interp({:unify, a, b}, state) do + case AL.Var.unify(a, b, state.active_choicepoint.bindings) do + nil -> + backtrack(state) + + bindings -> + %AL{ + state + | active_choicepoint: %AL.Choicepoint{state.active_choicepoint | bindings: bindings} + } + end + end + + def interp({:not, condition}, state) do + case collect_all_solutions( + condition, + state.active_choicepoint.bindings, + state.tx_id, + state.store + ) do + [] -> state + _ -> backtrack(state) + end + end + def interp(:fail, state) do backtrack(state) end - defp collect_all_solutions(condition, bindings, tx_id) do + def interp({:send, self, method, args}, state) do + call_args = [self | args] + + case resolve_method_id(self, method, state.store) do + nil -> + dnu(self, method, args, state) + + id -> + if has_matching_clause?(id, call_args, state.active_choicepoint.bindings, state.store) do + interp({:oapply, id, call_args}, state) + else + dnu(self, method, args, state) + end + end + end + + defp dnu(_self, :does_not_understand, _args, state), do: backtrack(state) + + defp dnu(self, method, args, state), + do: interp({:send, self, :does_not_understand, [method, args]}, state) + + defp resolve_method_id(self, method, store) when is_map(self), + do: resolve_in_chain([Map.get(self, :class, :map)], method, store) + + defp resolve_method_id(self, method, store) when is_list(self), + do: resolve_in_chain([:list], method, store) + + defp resolve_method_id(self, method, store) do + case method_ids(self, method, store) do + [id | _] -> + id + + [] -> + resolve_in_chain( + for({:class, _o, c} <- AL.Object.scan_class(self, :"$class", store), do: c), + method, + store + ) + end + end + + defp resolve_in_chain(classes, method, store), + do: Enum.find_value(classes, fn c -> chain_first_id(c, method, store) end) + + defp chain_first_id(class, method, store) do + case method_ids(class, method, store) do + [id | _] -> + id + + [] -> + resolve_in_chain( + for({:super, _o, s} <- AL.Object.scan_super(class, :"$super", store), do: s), + method, + store + ) + end + end + + defp method_ids(obj, method, store) do + for {:method, _o, _n, id} <- AL.Object.scan_method(obj, method, :"$id", store), do: id + end + + defp has_matching_clause?(id, call_args, bindings, store) do + id in @primitive_methods or any_clause_matches?(id, call_args, bindings, store) + end + + defp any_clause_matches?(id, call_args, bindings, store) do + scope = AL.Command.fresh_scope() + + Enum.any?(AL.Object.scan_oapply(id, :"$head", :"$body", store), fn {:oapply, _id, head, _body} -> + AL.Var.unify(AL.Var.freshen(head, scope), call_args, bindings) != nil + end) + end + + defp collect_all_solutions(condition, bindings, tx_id, store) do initial = %AL{ active_choicepoint: %AL.Choicepoint{ goals: condition, @@ -918,8 +1189,10 @@ defmodule AL do }, choicepoint_stack: [], tx_id: tx_id, + store: store, trace: [], - program: condition + program: condition, + tracepoints: AL.Trace.tracepoints() } do_collect(continue(initial), []) @@ -939,49 +1212,92 @@ defmodule AL do end defp format_failure(trace) do - steps = trace |> Enum.reverse() |> Enum.map(&normalize_term/1) + steps = trace |> Enum.reverse() |> Enum.map(&AL.Trace.pretty/1) %{failed_on: List.last(steps), trace: steps} end - defp normalize_term(a) when is_atom(a) do - s = Atom.to_string(a) + defp trace_call(state, method_id, bind_head) do + {receiver, args} = + case bind_head do + [r | rest] -> {r, rest} + other -> {other, []} + end - cond do - Regex.match?(~r/^[0-9a-f]{32}$/, s) -> - :"##{AL.Command.id_label(a)}" + traced? = + MapSet.member?(state.tracepoints, method_id) or + (method_id != :send and MapSet.member?(state.tracepoints, receiver)) - true -> - a + if traced? do + depth = length(state.active_choicepoint.continuations) + AL.Trace.call(depth, receiver, method_id, args) + {depth, receiver, method_id} end end - defp normalize_term(t) when is_tuple(t), - do: t |> Tuple.to_list() |> Enum.map(&normalize_term/1) |> List.to_tuple() + defp record_traced_call(traced_calls, _freshener, nil), do: traced_calls - defp normalize_term(l) when is_list(l), do: Enum.map(l, &normalize_term/1) + defp record_traced_call(traced_calls, freshener, info), + do: Map.put(traced_calls, freshener, info) - defp normalize_term(m) when is_map(m), - do: Map.new(m, fn {k, v} -> {normalize_term(k), normalize_term(v)} end) + defp trace_fail(state, freshener) do + case Map.pop(state.traced_calls, freshener) do + {nil, _} -> + state - defp normalize_term(x), do: x - - def interp_is({:oapply, :+, [a, b]}, bindings), do: interp_is(a, bindings) + interp_is(b, bindings) + {{depth, receiver, method}, rest} -> + AL.Trace.fail(depth, receiver, method) + %AL{state | traced_calls: rest} + end + end - def interp_is({:oapply, :-, [a, b]}, bindings), do: interp_is(a, bindings) - interp_is(b, bindings) + @doc """ + I evaluate an arithmetic expression against `bindings`, returning a number or + `:error` if any operand is unbound or non-numeric (so `is/2` can fail the goal + cleanly instead of crashing the transaction). Division by zero is `:error`. + """ + def interp_is({:oapply, :/, [a, b]}, bindings) do + with x when is_number(x) <- interp_is(a, bindings), + y when is_number(y) and y != 0 <- interp_is(b, bindings) do + div(x, y) + else + _ -> :error + end + end - def interp_is({:oapply, :*, [a, b]}, bindings), do: interp_is(a, bindings) * interp_is(b, bindings) + def interp_is({:oapply, op, [a, b]}, bindings) when op in [:+, :-, :*, :**] do + with x when is_number(x) <- interp_is(a, bindings), + y when is_number(y) <- interp_is(b, bindings) do + binop(op, x, y) + else + _ -> :error + end + end - def interp_is({:oapply, :/, [a, b]}, bindings), do: div(interp_is(a, bindings), interp_is(b, bindings)) + def interp_is({:oapply, op, [a]}, bindings) when op in [:+, :-] do + case interp_is(a, bindings) do + x when is_number(x) -> binop(op, x) + _ -> :error + end + end - def interp_is({:oapply, :**, [a, b]}, bindings), do: interp_is(a, bindings) ** interp_is(b, bindings) + def interp_is(a, _bindings) when is_number(a), do: a - def interp_is({:oapply, :-, [a]}, bindings), do: -interp_is(a, bindings) + def interp_is(a, bindings) when is_atom(a) do + case AL.Var.deref(bindings, a) do + x when is_number(x) -> x + _ -> :error + end + end - def interp_is({:oapply, :+, [a]}, bindings), do: +interp_is(a, bindings) + def interp_is(_a, _bindings), do: :error - def interp_is(a, _bindings) when is_integer(a), do: a + defp binop(:+, x, y), do: x + y + defp binop(:-, x, y), do: x - y + defp binop(:*, x, y), do: x * y + defp binop(:**, x, y), do: x ** y - def interp_is(a, bindings) when is_map_key(bindings, a), do: AL.Var.deref(bindings, a) + defp binop(:+, x), do: +x + defp binop(:-, x), do: -x end defimpl Inspect, for: AL do diff --git a/lib/AL/application.ex b/lib/AL/application.ex index d0ae979..f944e8c 100644 --- a/lib/AL/application.ex +++ b/lib/AL/application.ex @@ -5,15 +5,16 @@ defmodule AL.Application do """ use Application - use AL @impl true def start(_type, _args) do AL.Command.setup() - AL.Objects.setup() + AL.Branch.setup() opts = [strategy: :one_for_one, name: Al.Supervisor] - {:ok, pid} = Supervisor.start_link([AL.Scheduler], opts) + {:ok, pid} = Supervisor.start_link([AL.Scheduler.supervisor_spec()], opts) + + AL.Scheduler.start_all() bootstrap() @@ -21,127 +22,8 @@ defmodule AL.Application do end def bootstrap() do - case :mnesia.table_info(:command, :size) do - 0 -> do_bootstrap() - _ -> :ok - end - end - - defp do_bootstrap() do - run do - set_class(:class, :class) - set_class(:object, :class) - set_class(:behaviour, :class) - - set_super(:class, :object) - set_super(:behaviour, :object) - - set_method(:object, :lookup, :lookup) - set_method(:object, :send, :send) - set_method(:object, :meta, :metaclass) - set_method(:object, :defmethod, :defmethod) - - set_class(:metaclass, :behaviour) - - set_oapply(:metaclass, [self, class, meta]) do - class(self, class) - class(class, meta) - end - - set_class(:lookup, :behaviour) - set_oapply( - :lookup, - [self, name, id] - ) do - alternative([method(self, name, id)], - [super(self, super), - lookup(super, name, id)]) - end - - set_class(:send, :behaviour) - - set_oapply( - :send, - [self, method, args] - ) do - class(self, class) - implies( - [lookup(class, method, id)], - [ - print(["calling", id, "from", class, "with args", [self | args]]), - oapply(id, [self | args]) - ], - [:fail] - ) - end - - set_class(:defmethod, :behaviour) - set_oapply(:defmethod, [self, method_name, head, body]) do - fresh_id(impl) - set_method(self, method_name, impl) - set_class(impl, :behaviour) - set_oapply(impl, head, body) - end - - set_class(:map_get, :behaviour) - set_method(:map, :map_get, :map_get) - - defmethod(:class, :construct, [self, %{class: self}]) do - end - - set_method(:class, :allocate, :allocate_class) - set_class(:allocate_class, :behaviour) - - set_oapply( - :allocate_class, - [self, args, name] - ) do - map_get(args, :name, name) - map_get(args, :super, super) - map_get(args, :slots, slots) - - class(self, meta) - - set_class(name, meta) - set_super(name, super) - set_slots(name, slots) - end - - defmethod(:object, :allocate, [self, _, self]) do - print(["allocate", self]) - end - - defmethod(:object, :init, [self, _, self]) do - print(["initialise", self]) - end - - defmethod(:class, :new, [self, args, new]) do - send(self, :construct, [construct]) - send(construct, :allocate, [args, alloc]) - send(alloc, :init, [args, new]) - end - - defmethod(:object, :examine, [self, %{classes: classes, - objects: objects, - supers: supers, - subs: subs, - methods: methods, - clauses: clauses}]) do - findall(c, [class(self, c)], classes) - findall(c, [class(c, self)], objects) - findall(s, [super(self, s)], supers) - findall(sub, [super(sub, self)], subs) - findall([n, id], [method(self, n, id)], methods) - findall([head, body], [clause(self, head, body)], clauses) - end - - send(:class, :new, [%{name: :process, super: :object, slots: []}, _]) - defmethod(:process, :init, [self, args, new_obj]) do - map_get(args, :head, head) - map_get(args, :body, body) - gensym(new_obj) - spawn_process(new_obj, head, body) - end - end + :al + |> Application.get_env(:packages, []) + |> AL.Package.install_all() end end diff --git a/lib/AL/branch.ex b/lib/AL/branch.ex new file mode 100644 index 0000000..4341253 --- /dev/null +++ b/lib/AL/branch.ex @@ -0,0 +1,104 @@ +defmodule AL.Branch do + @moduledoc """ + I manage branches of the command log. A branch is a fork: its own command log + (the parent's prefix copied in) and its own object projection. `:main` is the + root branch. I also track which branch is checked out (HEAD). + + Branch metadata lives in the `:meta` table: `:stores` (the list of forks) and + `:head` (the checked-out branch). `AL.Command` owns command-log primitives and + `AL.Object` owns projection primitives; I orchestrate both. + """ + + @doc """ + Bring up every branch: for `:main` and each persisted fork, create its + projection tables and replay its command log. Run at startup. + """ + @spec setup() :: :ok + def setup() do + init_meta() + + for branch <- [:main | list()] do + AL.Object.create_store(branch) + AL.Object.hydrate_since(0, branch) + end + + :ok + end + + @doc """ + Fork a new branch from `from` (default the checked-out branch, HEAD) as of time + `at` (default `:tip`, i.e. now). The branch gets its own (disc) command log with + `from`'s prefix copied in, plus its own projection; subsequent writes against it + diverge. `from` may be `:main` or any existing fork, so forks can be forked. + Returns the new branch's name. + """ + @spec fork(non_neg_integer() | :tip, AL.Object.store()) :: AL.Object.store() + def fork(at \\ :tip, from \\ head()) do + unless from == :main or from in list() do + raise ArgumentError, "cannot fork from unknown branch #{inspect(from)}" + end + + branch = :"fork_#{System.unique_integer([:positive])}" + AL.Command.create_log(branch) + AL.Command.copy_prefix(from, branch, at_time(at)) + AL.Object.create_store(branch) + AL.Object.hydrate_since(0, branch) + register(branch) + AL.Scheduler.start(branch) + branch + end + + @doc "Discard a branch: drop its projection and command log, untrack it." + @spec discard(AL.Object.store()) :: :ok + def discard(branch) do + unregister(branch) + if head() == branch, do: set_head(:main) + AL.Scheduler.stop(branch) + AL.Object.drop_store(branch) + AL.Command.drop_log(branch) + :ok + end + + @doc "Check out a branch (Git HEAD-style): `run do ... end` now acts against it." + @spec checkout(AL.Object.store()) :: :ok + def checkout(branch), do: set_head(branch) + + @doc "The currently checked-out branch (default `:main`)." + @spec head() :: AL.Object.store() + def head() do + case :mnesia.dirty_read(:meta, :head) do + [{_, :head, branch}] -> branch + [] -> :main + end + end + + @doc "All forks (not including `:main`)." + @spec list() :: [AL.Object.store()] + def list() do + case :mnesia.dirty_read(:meta, :stores) do + [{_, :stores, names}] -> names + [] -> [] + end + end + + defp at_time(:tip), do: AL.Command.system_time() + defp at_time(t) when is_integer(t), do: t + + defp set_head(branch), do: :mnesia.dirty_write({:meta, :head, branch}) + + defp register(name), do: :mnesia.dirty_write({:meta, :stores, Enum.uniq([name | list()])}) + + defp unregister(name), do: :mnesia.dirty_write({:meta, :stores, list() -- [name]}) + + defp init_meta() do + case :mnesia.dirty_read(:meta, :stores) do + [] -> :mnesia.dirty_write({:meta, :stores, []}) + _ -> :ok + end + + case :mnesia.dirty_read(:meta, :head) do + [] -> :mnesia.dirty_write({:meta, :head, :main}) + _ -> :ok + end + end +end diff --git a/lib/AL/command.ex b/lib/AL/command.ex index 6197531..b317c41 100644 --- a/lib/AL/command.ex +++ b/lib/AL/command.ex @@ -13,6 +13,9 @@ defmodule AL.Command do | :retract_super | :retract_method | :retract_oapply + | :retract_slots + | :send_async + | :send_elixir @type command() :: {:set_class, {AL.Var.t(), AL.Var.t()}} @@ -24,7 +27,9 @@ defmodule AL.Command do | {:retract_super, {AL.Var.t(), AL.Var.t()}} | {:retract_method, {AL.Var.t(), AL.Var.t(), AL.Var.t()}} | {:retract_oapply, {AL.Var.t(), AL.Var.t()}} - | {:spawn_process, {AL.Var.t(), AL.Var.t(), [AL.goal()]}} + | {:retract_slots, {AL.Var.t(), AL.Var.t()}} + | {:send_async, {AL.Var.t(), AL.Var.t(), AL.Var.t()}} + | {:send_elixir, {AL.Var.t(), AL.Var.t()}} @doc """ Initialise the event log, or re-use the one on disc. @@ -86,12 +91,21 @@ defmodule AL.Command do end end + @doc """ + Table name for a store's command log. `:main` is the live log; a fork uses a + suffixed table created with `record_name: :command`. + """ + @spec log(AL.Object.store()) :: atom() + def log(store \\ :main) + def log(:main), do: :command + def log(store), do: :"command@#{store}" + @doc """ Read a command at time t """ - @spec command(non_neg_integer()) :: command() | :absent - def command(t) do - case :mnesia.read(:command, t) do + @spec command(non_neg_integer(), AL.Object.store()) :: command() | :absent + def command(t, store \\ :main) do + case :mnesia.read(log(store), t) do [{_, ^t, _tx_id, command}] -> command [] -> :absent end @@ -100,108 +114,174 @@ defmodule AL.Command do @doc """ Read all commands since time t """ - @spec commands_since(non_neg_integer()) :: [command()] - def commands_since(t) do - :mnesia.select(:command, [ + @spec commands_since(non_neg_integer(), AL.Object.store()) :: [command()] + def commands_since(t, store \\ :main) do + :mnesia.select(log(store), [ {{:command, :"$1", :"$2", :"$3"}, [{:>=, :"$1", t}], [:"$_"]} ]) end + @doc """ + Read all commands up to and including time t + """ + @spec commands_until(non_neg_integer(), AL.Object.store()) :: [command()] + def commands_until(t, store \\ :main) do + :mnesia.select(log(store), [ + {{:command, :"$1", :"$2", :"$3"}, [{:"=<", :"$1", t}], [:"$_"]} + ]) + end + @doc """ Read all commands for a given transaction """ - def commands_for_transaction(tx_id) do - :mnesia.select(:command, [ + def commands_for_transaction(tx_id, store \\ :main) do + :mnesia.select(log(store), [ {{:command, :"$1", tx_id, :"$3"}, [], [:"$_"]} ]) end + @doc "Create a fork's command log (persisted to disc). Idempotent." + @spec create_log(AL.Object.store()) :: :ok + def create_log(store) do + case :mnesia.create_table(log(store), + attributes: [:t, :tx_id, :command], + type: :ordered_set, + disc_copies: [node()], + record_name: :command + ) do + {:atomic, :ok} -> :ok + {:aborted, {:already_exists, _}} -> :ok + end + + :mnesia.wait_for_tables([log(store)], 5_000) + :ok + end + + @doc "Delete a fork's command log." + @spec drop_log(AL.Object.store()) :: :ok + def drop_log(store) do + :mnesia.delete_table(log(store)) + :ok + end + + @doc "Copy `src`'s commands up to and including time `t` into `dst`'s log." + @spec copy_prefix(AL.Object.store(), AL.Object.store(), non_neg_integer()) :: + {:atomic, any()} | {:aborted, term()} + def copy_prefix(src, dst, t) do + :mnesia.transaction(fn -> + for {:command, ct, tx, cmd} <- commands_until(t, src) do + :mnesia.write(log(dst), {:command, ct, tx, cmd}, :write) + end + end) + end + @doc """ Write a command that says a class of an object was set """ - @spec set_class(non_neg_integer(), AL.Var.t(), AL.Var.t()) :: :ok - def set_class(tx_id, object, class) do - write_command(tx_id, {:set_class, {object, class}}) + @spec set_class(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: :ok + def set_class(tx_id, object, class, store \\ :main) do + write_command(tx_id, {:set_class, {object, class}}, store) end @doc """ Write a command that says a superclass of an object was set """ - @spec set_super(non_neg_integer(), AL.Var.t(), AL.Var.t()) :: :ok - def set_super(tx_id, object, super) do - write_command(tx_id, {:set_super, {object, super}}) + @spec set_super(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: :ok + def set_super(tx_id, object, super, store \\ :main) do + write_command(tx_id, {:set_super, {object, super}}, store) end @doc """ Write a command that says a method was set for an object """ - @spec set_method(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Var.t()) :: :ok - def set_method(tx_id, object, method_name, method_id) do - write_command(tx_id, {:set_method, {object, method_name, method_id}}) + @spec set_method(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: + :ok + def set_method(tx_id, object, method_name, method_id, store \\ :main) do + write_command(tx_id, {:set_method, {object, method_name, method_id}}, store) end @doc """ Write a command that says the object was given a run method """ - @spec set_oapply(non_neg_integer(), AL.Var.t(), AL.Var.t(), [AL.goal()]) :: :ok - def set_oapply(tx_id, object, head, body) do - write_command(tx_id, {:set_oapply, {object, head, body}}) + @spec set_oapply(non_neg_integer(), AL.Var.t(), AL.Var.t(), [AL.goal()], AL.Object.store()) :: + :ok + def set_oapply(tx_id, object, head, body, store \\ :main) do + write_command(tx_id, {:set_oapply, {object, head, body}}, store) end @doc """ Write a command that says slots were set for an object """ - @spec set_slots(non_neg_integer(), AL.Var.t(), AL.Var.t()) :: :ok - def set_slots(tx_id, object, slots) do - write_command(tx_id, {:set_slots, {object, slots}}) + @spec set_slots(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: :ok + def set_slots(tx_id, object, slots, store \\ :main) do + write_command(tx_id, {:set_slots, {object, slots}}, store) + end + + @spec retract_class(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: :ok + def retract_class(tx_id, object, class, store \\ :main) do + write_command(tx_id, {:retract_class, {object, class}}, store) + end + + @spec retract_super(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: :ok + def retract_super(tx_id, object, super, store \\ :main) do + write_command(tx_id, {:retract_super, {object, super}}, store) end - @spec retract_class(non_neg_integer(), AL.Var.t(), AL.Var.t()) :: :ok - def retract_class(tx_id, object, class) do - write_command(tx_id, {:retract_class, {object, class}}) + @spec retract_method(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: + :ok + def retract_method(tx_id, object, name, id, store \\ :main) do + write_command(tx_id, {:retract_method, {object, name, id}}, store) end - @spec retract_super(non_neg_integer(), AL.Var.t(), AL.Var.t()) :: :ok - def retract_super(tx_id, object, super) do - write_command(tx_id, {:retract_super, {object, super}}) + @spec retract_oapply(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: :ok + def retract_oapply(tx_id, object, head, store \\ :main) do + write_command(tx_id, {:retract_oapply, {object, head}}, store) end - @spec retract_method(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Var.t()) :: :ok - def retract_method(tx_id, object, name, id) do - write_command(tx_id, {:retract_method, {object, name, id}}) + @spec retract_slots(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: :ok + def retract_slots(tx_id, object, slots, store \\ :main) do + write_command(tx_id, {:retract_slots, {object, slots}}, store) end - @spec retract_oapply(non_neg_integer(), AL.Var.t(), AL.Var.t()) :: :ok - def retract_oapply(tx_id, object, head) do - write_command(tx_id, {:retract_oapply, {object, head}}) + @spec send_async(non_neg_integer(), AL.Var.t(), AL.Var.t(), AL.Var.t(), AL.Object.store()) :: + :ok + def send_async(tx_id, object, method, args, store \\ :main) do + write_command(tx_id, {:send_async, {object, method, args}}, store) end - @spec spawn_process(non_neg_integer(), AL.Var.t(), AL.Var.t(), [AL.goal()]) :: :ok - def spawn_process(tx_id, object, head, body) do - write_command(tx_id, {:spawn_process, {object, head, body}}) + @spec send_elixir(non_neg_integer(), pid(), term(), AL.Object.store()) :: :ok + def send_elixir(tx_id, pid, message, store \\ :main) do + write_command(tx_id, {:send_elixir, {pid, message}}, store) end - @spec write_command(non_neg_integer(), command()) :: :ok - def write_command(tx_id, command) do + @spec write_command(non_neg_integer(), command(), AL.Object.store()) :: :ok + def write_command(tx_id, command, store \\ :main) do {t1, _t2} = inc_system_time() - :mnesia.write({:command, t1, tx_id, command}) + :mnesia.write(log(store), {:command, t1, tx_id, command}, :write) end @doc """ I increase the monotonic system time of the log """ def inc_system_time() do - t = system_time() - :mnesia.dirty_write({:meta, :system_time, t + 1}) + t = + case :mnesia.read(:meta, :system_time, :write) do + [{_, :system_time, t}] -> t + [] -> 0 + end + + :mnesia.write({:meta, :system_time, t + 1}) {t, t + 1} end @spec fresh_id() :: atom() def fresh_id() do - label = case :mnesia.dirty_read(:meta, :id_counter) do - [{:meta, :id_counter, n}] -> n - [] -> 0 - end + label = + case :mnesia.read(:meta, :id_counter) do + [{:meta, :id_counter, n}] -> n + [] -> 0 + end + :mnesia.dirty_write({:meta, :id_counter, label + 1}) :"##{label}" end @@ -213,10 +293,12 @@ defmodule AL.Command do @spec fresh_scope() :: String.t() def fresh_scope() do - n = case :mnesia.dirty_read(:meta, :scope_counter) do - [{:meta, :scope_counter, n}] -> n - [] -> 0 - end + n = + case :mnesia.read(:meta, :scope_counter) do + [{:meta, :scope_counter, n}] -> n + [] -> 0 + end + :mnesia.dirty_write({:meta, :scope_counter, n + 1}) Integer.to_string(n) end @@ -228,14 +310,18 @@ defmodule AL.Command do defp meta_label(namespace, counter_key, key) do meta_key = {namespace, key} + case :mnesia.dirty_read(:meta, meta_key) do [{:meta, ^meta_key, label}] -> label + [] -> - label = case :mnesia.dirty_read(:meta, counter_key) do - [{:meta, ^counter_key, n}] -> n - [] -> 0 - end + label = + case :mnesia.dirty_read(:meta, counter_key) do + [{:meta, ^counter_key, n}] -> n + [] -> 0 + end + :mnesia.dirty_write({:meta, counter_key, label + 1}) :mnesia.dirty_write({:meta, meta_key, label}) label diff --git a/lib/AL/object.ex b/lib/AL/object.ex new file mode 100644 index 0000000..3a0f625 --- /dev/null +++ b/lib/AL/object.ex @@ -0,0 +1,227 @@ +defmodule AL.Object do + @moduledoc """ + I am the in-memory store for AL objects. State is a materialised view of the + command log. I am parameterised by a `store` (a namespace): `:main` is the live + store (base table names); any other store uses suffixed tables (`:class@name`, + ...) created with `record_name:` the base relation, so record tags — and every + scan pattern — are identical across stores. + """ + + use TypedStruct + + @type class_record() :: {:class, AL.Var.t(), AL.Var.t()} + @type super_record() :: {:super, AL.Var.t(), AL.Var.t()} + @type slots_record() :: {:slots, AL.Var.t(), AL.Var.t()} + @type method_record() :: {:method, AL.Var.t(), AL.Var.t(), AL.Var.t()} + @type oapply_record() :: {:oapply, AL.Var.t(), AL.Var.t(), [AL.goal()]} + @type store() :: atom() + + @relations %{ + class: [:object, :class], + super: [:object, :super], + slots: [:object, :slots], + method: [:object, :method_name, :method_id], + oapply: [:object, :head, :body] + } + @bags [:class, :super, :method, :oapply] + + typedstruct enforce: true do + field(:id, any(), enforce: true) + end + + @spec table(atom(), store()) :: atom() + def table(relation, store \\ :main) + def table(relation, :main), do: relation + def table(relation, store), do: :"#{relation}@#{store}" + + @doc "Create the table set for a store. Idempotent." + @spec create_store(store()) :: :ok + def create_store(store) do + for relation <- Map.keys(@relations), do: create_table(relation, store) + :mnesia.wait_for_tables(Enum.map(Map.keys(@relations), &table(&1, store)), 5_000) + :ok + end + + @doc "Delete a store's table set." + @spec drop_store(store()) :: :ok + def drop_store(store) do + for relation <- Map.keys(@relations), do: :mnesia.delete_table(table(relation, store)) + :ok + end + + defp create_table(relation, store) do + opts = [attributes: @relations[relation], type: type(relation), ram_copies: [node()]] + opts = if store == :main, do: opts, else: [{:record_name, relation} | opts] + + case :mnesia.create_table(table(relation, store), opts) do + {:atomic, :ok} -> :ok + {:aborted, {:already_exists, _}} -> :ok + end + end + + defp type(relation) when relation in @bags, do: :bag + defp type(_relation), do: :set + + @spec scan_class(AL.Var.t(), AL.Var.t(), store()) :: [class_record()] + def scan_class(self_pattern, class_pattern, store \\ :main) do + :mnesia.select(table(:class, store), [ + {AL.Var.to_mnesia_pattern({:class, self_pattern, class_pattern}), [], [:"$_"]} + ]) + end + + @spec scan_super(AL.Var.t(), AL.Var.t(), store()) :: [super_record()] + def scan_super(self_pattern, super_pattern, store \\ :main) do + :mnesia.select(table(:super, store), [ + {AL.Var.to_mnesia_pattern({:super, self_pattern, super_pattern}), [], [:"$_"]} + ]) + end + + @spec scan_slots(AL.Var.t(), AL.Var.t(), store()) :: [slots_record()] + def scan_slots(self_pattern, slots_pattern, store \\ :main) do + :mnesia.select(table(:slots, store), [ + {AL.Var.to_mnesia_pattern({:slots, self_pattern, slots_pattern}), [], [:"$_"]} + ]) + end + + @spec scan_method(AL.Var.t(), AL.Var.t(), AL.Var.t(), store()) :: [method_record()] + def scan_method(self_pattern, method_name_pattern, method_id_pattern, store \\ :main) do + :mnesia.select(table(:method, store), [ + {AL.Var.to_mnesia_pattern({:method, self_pattern, method_name_pattern, method_id_pattern}), + [], [:"$_"]} + ]) + end + + @spec scan_oapply(AL.Var.t(), AL.Var.t(), AL.Var.t(), store()) :: [oapply_record()] + def scan_oapply(self_pattern, head_pattern, body_pattern, store \\ :main) do + :mnesia.select(table(:oapply, store), [ + {AL.Var.to_mnesia_pattern({:oapply, self_pattern, head_pattern, body_pattern}), [], [:"$_"]} + ]) + end + + @spec read_slots(AL.Var.t(), store()) :: [slots_record()] + def read_slots(object, store \\ :main) do + :mnesia.read(table(:slots, store), object) + end + + @spec retract_class(AL.Var.t(), AL.Var.t(), store()) :: :ok + def retract_class(object_pattern, class_pattern, store \\ :main) do + delete_all(:class, scan_class(object_pattern, class_pattern, store), store) + end + + @spec retract_super(AL.Var.t(), AL.Var.t(), store()) :: :ok + def retract_super(object_pattern, super_pattern, store \\ :main) do + delete_all(:super, scan_super(object_pattern, super_pattern, store), store) + end + + @spec retract_method(AL.Var.t(), AL.Var.t(), AL.Var.t(), store()) :: :ok + def retract_method(object_pattern, method_name_pattern, method_id_pattern, store \\ :main) do + delete_all( + :method, + scan_method(object_pattern, method_name_pattern, method_id_pattern, store), + store + ) + end + + @spec retract_oapply(AL.Var.t(), AL.Var.t(), store()) :: :ok + def retract_oapply(object_pattern, head_pattern, store \\ :main) do + delete_all(:oapply, scan_oapply(object_pattern, head_pattern, :"$body", store), store) + end + + defp delete_all(relation, records, store) do + for record <- records, do: :mnesia.delete_object(table(relation, store), record, :write) + :ok + end + + @spec retract_slots(AL.Var.t(), AL.Var.t(), store()) :: :ok + def retract_slots(object, slots, store \\ :main) + + def retract_slots(object, slots, store) when is_map(slots) do + case read_slots(object, store) do + [{:slots, ^object, existing}] when is_map(existing) -> + case Map.drop(existing, Map.keys(slots)) do + remaining when remaining == %{} -> :mnesia.delete(table(:slots, store), object, :write) + remaining -> :mnesia.write(table(:slots, store), {:slots, object, remaining}, :write) + end + + _ -> + :mnesia.delete(table(:slots, store), object, :write) + end + end + + def retract_slots(object, _slots, store) do + :mnesia.delete(table(:slots, store), object, :write) + end + + @spec set_class(AL.Var.t(), AL.Var.t(), store()) :: :ok + def set_class(object, class, store \\ :main) do + :mnesia.write(table(:class, store), {:class, object, class}, :write) + end + + @spec set_super(AL.Var.t(), AL.Var.t(), store()) :: :ok + def set_super(object, super, store \\ :main) do + :mnesia.write(table(:super, store), {:super, object, super}, :write) + end + + @spec set_method(AL.Var.t(), AL.Var.t(), AL.Var.t(), store()) :: :ok + def set_method(object, method_name, method_id, store \\ :main) do + :mnesia.write(table(:method, store), {:method, object, method_name, method_id}, :write) + end + + @spec set_oapply(AL.Var.t(), AL.Var.t(), [AL.goal()], store()) :: :ok + def set_oapply(object, head, body, store \\ :main) do + :mnesia.write(table(:oapply, store), {:oapply, object, head, body}, :write) + end + + @spec set_slots(AL.Var.t(), AL.Var.t(), store()) :: :ok + def set_slots(object, new_slots, store \\ :main) + + def set_slots(object, new_slots, store) when is_map(new_slots) do + existing = + case read_slots(object, store) do + [{:slots, _, slots}] when is_map(slots) -> slots + _ -> %{} + end + + :mnesia.write(table(:slots, store), {:slots, object, Map.merge(existing, new_slots)}, :write) + end + + def set_slots(object, slots, store) do + :mnesia.write(table(:slots, store), {:slots, object, slots}, :write) + end + + @spec hydrate_event(AL.Command.command_op(), tuple(), store()) :: any() + def hydrate_event(op, event, store \\ :main) do + case op do + :set_class -> with {o, c} <- event, do: set_class(o, c, store) + :set_super -> with {o, s} <- event, do: set_super(o, s, store) + :set_method -> with {o, n, id} <- event, do: set_method(o, n, id, store) + :set_oapply -> with {o, h, b} <- event, do: set_oapply(o, h, b, store) + :set_slots -> with {o, s} <- event, do: set_slots(o, s, store) + :retract_class -> with {o, c} <- event, do: retract_class(o, c, store) + :retract_super -> with {o, s} <- event, do: retract_super(o, s, store) + :retract_method -> with {o, n, id} <- event, do: retract_method(o, n, id, store) + :retract_oapply -> with {o, h} <- event, do: retract_oapply(o, h, store) + :retract_slots -> with {o, s} <- event, do: retract_slots(o, s, store) + :send_async -> :ok + :send_elixir -> :ok + end + end + + @doc "Replay commands at or after time `t` into `store`." + @spec hydrate_since(non_neg_integer(), store()) :: {:atomic, any()} | {:aborted, term()} + def hydrate_since(t, store \\ :main) do + hydrate(fn -> AL.Command.commands_since(t, store) end, store) + end + + @doc "Replay commands up to and including time `t` into `store`." + @spec hydrate_until(non_neg_integer(), store()) :: {:atomic, any()} | {:aborted, term()} + def hydrate_until(t, store \\ :main) do + hydrate(fn -> AL.Command.commands_until(t, store) end, store) + end + + defp hydrate(fetch, store) do + :mnesia.transaction(fn -> + for {:command, _, _, {op, event}} <- fetch.(), do: hydrate_event(op, event, store) + end) + end +end diff --git a/lib/AL/objects.ex b/lib/AL/objects.ex deleted file mode 100644 index d6ed94a..0000000 --- a/lib/AL/objects.ex +++ /dev/null @@ -1,229 +0,0 @@ -defmodule AL.Objects do - @moduledoc """ - I am the in-memory store for AL objects - """ - - @type class_record() :: {:class, AL.Var.t(), AL.Var.t()} - @type super_record() :: {:super, AL.Var.t(), AL.Var.t()} - @type slots_record() :: {:slots, AL.Var.t(), AL.Var.t()} - @type method_record() :: {:method, AL.Var.t(), AL.Var.t(), AL.Var.t()} - @type oapply_record() :: {:oapply, AL.Var.t(), AL.Var.t(), [AL.goal()]} - - def setup() do - case :mnesia.create_table(:class, - attributes: [:object, :class], - type: :bag, - ram_copies: [node()] - ) do - {:atomic, :ok} -> :ok - {:aborted, {:already_exists, _}} -> :ok - end - - case :mnesia.create_table(:super, - attributes: [:object, :super], - type: :bag, - ram_copies: [node()] - ) do - {:atomic, :ok} -> :ok - {:aborted, {:already_exists, _}} -> :ok - end - - case :mnesia.create_table(:slots, - attributes: [:object, :slots], - type: :set, - ram_copies: [node()] - ) do - {:atomic, :ok} -> :ok - {:aborted, {:already_exists, _}} -> :ok - end - - case :mnesia.create_table(:method, - attributes: [:object, :method_name, :method_id], - type: :bag, - ram_copies: [node()] - ) do - {:atomic, :ok} -> :ok - {:aborted, {:already_exists, _}} -> :ok - end - - case :mnesia.create_table(:oapply, - attributes: [:object, :head, :body], - type: :bag, - ram_copies: [node()] - ) do - {:atomic, :ok} -> :ok - {:aborted, {:already_exists, _}} -> :ok - end - - :mnesia.wait_for_tables([:class, :super, :slots, :method, :oapply], 5_000) - - hydrate_since(0) - end - - @spec scan_class(AL.Var.t(), AL.Var.t()) :: [class_record()] - def scan_class(self_pattern, class_pattern) do - :mnesia.select(:class, [ - {AL.Var.to_mnesia_pattern({:class, self_pattern, class_pattern}), [], [:"$_"]} - ]) - end - - @spec scan_super(AL.Var.t(), AL.Var.t()) :: [super_record()] - def scan_super(self_pattern, super_pattern) do - :mnesia.select(:super, [ - {AL.Var.to_mnesia_pattern({:super, self_pattern, super_pattern}), [], [:"$_"]} - ]) - end - - @spec scan_slots(AL.Var.t(), AL.Var.t()) :: [slots_record()] - def scan_slots(self_pattern, slots_pattern) do - :mnesia.select(:slots, [ - {AL.Var.to_mnesia_pattern({:slots, self_pattern, slots_pattern}), [], [:"$_"]} - ]) - end - - @spec scan_method(AL.Var.t(), AL.Var.t(), AL.Var.t()) :: [method_record()] - def scan_method(self_pattern, method_name_pattern, method_id_pattern) do - :mnesia.select(:method, [ - {AL.Var.to_mnesia_pattern({:method, self_pattern, method_name_pattern, method_id_pattern}), - [], [:"$_"]} - ]) - end - - @spec scan_oapply(AL.Var.t(), AL.Var.t(), AL.Var.t()) :: [oapply_record()] - def scan_oapply(self_pattern, head_pattern, body_pattern) do - :mnesia.select(:oapply, [ - {AL.Var.to_mnesia_pattern({:oapply, self_pattern, head_pattern, body_pattern}), [], [:"$_"]} - ]) - end - - @spec retract_class(AL.Var.t(), AL.Var.t()) :: :ok - def retract_class(object_pattern, class_pattern) do - for record <- scan_class(object_pattern, class_pattern), do: :mnesia.delete_object(record) - :ok - end - - @spec retract_super(AL.Var.t(), AL.Var.t()) :: :ok - def retract_super(object_pattern, super_pattern) do - for record <- scan_super(object_pattern, super_pattern), do: :mnesia.delete_object(record) - :ok - end - - @spec retract_method(AL.Var.t(), AL.Var.t(), AL.Var.t()) :: :ok - def retract_method(object_pattern, method_name_pattern, method_id_pattern) do - for record <- scan_method(object_pattern, method_name_pattern, method_id_pattern), - do: :mnesia.delete_object(record) - - :ok - end - - @spec retract_oapply(AL.Var.t(), AL.Var.t()) :: :ok - def retract_oapply(object_pattern, head_pattern) do - for record <- scan_oapply(object_pattern, head_pattern, :"$body"), - do: :mnesia.delete_object(record) - - :ok - end - - @spec set_class(AL.Var.t(), AL.Var.t()) :: :ok - def set_class(object_pattern, class_pattern) do - :mnesia.write({:class, object_pattern, class_pattern}) - end - - @spec set_super(AL.Var.t(), AL.Var.t()) :: :ok - def set_super(object_pattern, super_pattern) do - :mnesia.write({:super, object_pattern, super_pattern}) - end - - @spec set_method(AL.Var.t(), AL.Var.t(), AL.Var.t()) :: :ok - def set_method(object_pattern, method_name_pattern, method_id_pattern) do - :mnesia.write({:method, object_pattern, method_name_pattern, method_id_pattern}) - end - - @spec set_oapply(AL.Var.t(), AL.Var.t(), [AL.goal()]) :: :ok - def set_oapply(object_pattern, head_pattern, body_pattern) do - :mnesia.write({:oapply, object_pattern, head_pattern, body_pattern}) - end - - @spec set_slots(AL.Var.t(), AL.Var.t()) :: :ok - def set_slots(object, new_slots) when is_map(new_slots) do - existing = - case :mnesia.read(:slots, object) do - [{:slots, _, slots}] when is_map(slots) -> slots - _ -> %{} - end - - :mnesia.write({:slots, object, Map.merge(existing, new_slots)}) - end - - def set_slots(object, slots) do - :mnesia.write({:slots, object, slots}) - end - - def hydrate_event(op, event) do - case op do - :set_class -> - {object, class} = event - :mnesia.write({:class, object, class}) - - :set_super -> - {object, super} = event - :mnesia.write({:super, object, super}) - - :set_method -> - {object, method_name, method_id} = event - :mnesia.write({:method, object, method_name, method_id}) - - :set_oapply -> - {object, head, body} = event - :mnesia.write({:oapply, object, head, body}) - - :retract_class -> - {object, class} = event - retract_class(object, class) - - :retract_super -> - {object, super} = event - retract_super(object, super) - - :retract_method -> - {object, name, id} = event - retract_method(object, name, id) - - :retract_oapply -> - {object, head} = event - retract_oapply(object, head) - - :set_slots -> - {object, new_slots} = event - - merged = - if is_map(new_slots) do - existing = - case :mnesia.read(:slots, object) do - [{:slots, _, slots}] when is_map(slots) -> slots - _ -> %{} - end - - Map.merge(existing, new_slots) - else - new_slots - end - - :mnesia.write({:slots, object, merged}) - - :spawn_process -> - :ok - # TODO Consider whether this should be where the scheduler hydration occurs - end - end - - def hydrate_since(t) do - f = fn -> - for {:command, _, _, {op, event}} <- AL.Command.commands_since(t) do - hydrate_event(op, event) - end - end - - :mnesia.transaction(f) - end -end diff --git a/lib/AL/package.ex b/lib/AL/package.ex new file mode 100644 index 0000000..5728b1d --- /dev/null +++ b/lib/AL/package.ex @@ -0,0 +1,158 @@ +defmodule AL.Package do + @moduledoc """ + I define and install AL packages. A package is a durable object created as the + receipt of running its definitions, authored with `defpackage/3`. + """ + + defmacro __using__(_opts) do + quote do + require AL + import AL.Package, only: [defpackage: 3] + end + end + + defmacro defpackage(name, opts, do: body) do + version = Keyword.get(opts, :version, 1) + deps = Keyword.get(opts, :deps, []) + + statements = + case body do + {:__block__, _, list} -> list + single -> [single] + end + + receipt = + quote do + new(:package, %{name: unquote(name), version: unquote(version), deps: unquote(deps)}, _) + end + + program = {:__block__, [], statements ++ [receipt]} + + quote do + def __package__ do + %{name: unquote(name), version: unquote(version), deps: unquote(deps)} + end + + def install do + AL.run do + unquote(program) + end + end + end + end + + @spec install_all([module()]) :: :ok + def install_all(modules) do + by_name = Map.new(modules, fn m -> {m.__package__().name, m} end) + + modules + |> order(by_name) + |> Enum.each(fn m -> ensure(m.__package__().name, &m.install/0) end) + end + + @spec installed?(atom()) :: boolean() + def installed?(name) do + case :mnesia.transaction(fn -> + Enum.any?(AL.Object.scan_class(:"$p", :package), fn {:class, p, :package} -> + match?([{:slots, ^p, %{name: ^name}}], :mnesia.read(:slots, p)) + end) + end) do + {:atomic, installed?} -> installed? + _ -> false + end + end + + @spec ensure(atom(), (-> any())) :: :ok + def ensure(name, install) do + unless installed?(name), do: install.() + :ok + end + + @doc """ + I retract everything a package installed by reversing the commands of its + install transaction (recorded in the receipt's `:tx` slot). I refuse if another + installed package depends on this one. + """ + @spec uninstall(atom()) :: {:atomic, any()} | {:aborted, term()} | {:error, term()} + def uninstall(name) do + case dependents(name) do + [] -> do_uninstall(name) + deps -> {:error, {:depended_on_by, deps}} + end + end + + defp do_uninstall(name) do + case :mnesia.transaction(fn -> + case find_package(name) do + {_p, %{tx: tx}} -> AL.Command.commands_for_transaction(tx) + _ -> nil + end + end) do + {:atomic, nil} -> {:error, :not_installed} + {:atomic, commands} -> commands |> Enum.reverse() |> Enum.flat_map(&inverse/1) |> AL.eval() + other -> other + end + end + + defp dependents(name) do + {:atomic, names} = + :mnesia.transaction(fn -> + for {:class, p, :package} <- AL.Object.scan_class(:"$p", :package), + {:slots, ^p, %{name: dependent, deps: deps}} <- :mnesia.read(:slots, p), + name in deps, + do: dependent + end) + + names + end + + defp find_package(name) do + Enum.find_value(AL.Object.scan_class(:"$p", :package), fn {:class, p, :package} -> + case :mnesia.read(:slots, p) do + [{:slots, ^p, %{name: ^name} = slots}] -> {p, slots} + _ -> nil + end + end) + end + + defp inverse({:command, _t, _tx, command}) do + case command do + {:set_class, {o, c}} -> [{:retract_class, o, c}] + {:set_super, {o, s}} -> [{:retract_super, o, s}] + {:set_method, {o, n, id}} -> [{:retract_method, o, n, id}] + {:set_oapply, {o, h, _b}} -> [{:retract_oapply, o, h}] + {:set_slots, {o, s}} -> [{:retract_slots, o, s}] + _ -> [] + end + end + + defp order(modules, by_name) do + {ordered, _seen} = + Enum.reduce(modules, {[], MapSet.new()}, fn m, acc -> visit(m, by_name, acc, []) end) + + Enum.reverse(ordered) + end + + defp visit(m, by_name, {ordered, seen}, stack) do + name = m.__package__().name + + cond do + name in seen -> + {ordered, seen} + + name in stack -> + raise "AL package dependency cycle: #{inspect(Enum.reverse([name | stack]))}" + + true -> + {ordered, seen} = + Enum.reduce(m.__package__().deps, {ordered, seen}, fn dep, acc -> + case Map.fetch(by_name, dep) do + {:ok, dep_module} -> visit(dep_module, by_name, acc, [name | stack]) + :error -> raise "AL package #{inspect(name)} depends on unknown #{inspect(dep)}" + end + end) + + {[m | ordered], MapSet.put(seen, name)} + end + end +end diff --git a/lib/AL/package/bootstrap.ex b/lib/AL/package/bootstrap.ex new file mode 100644 index 0000000..8154b41 --- /dev/null +++ b/lib/AL/package/bootstrap.ex @@ -0,0 +1,239 @@ +defmodule AL.Package.Bootstrap do + use AL.Package + + defpackage :bootstrap, version: 1, deps: [] do + set_class(:class, :class) + set_class(:object, :class) + set_class(:behaviour, :class) + + set_super(:class, :object) + set_super(:behaviour, :object) + + set_method(:object, :lookup, :lookup) + set_method(:object, :meta, :metaclass) + set_method(:object, :defmethod, :defmethod) + + set_class(:metaclass, :behaviour) + + set_oapply(:metaclass, [self, class, meta]) do + class(self, class) + class(class, meta) + end + + set_class(:lookup, :behaviour) + + set_oapply(:lookup, [self, name, id]) do + alternative( + [method(self, name, id)], + [super(self, super), lookup(super, name, id)] + ) + end + + set_class(:defmethod, :behaviour) + + set_oapply(:defmethod, [self, method_name, head, body]) do + fresh_id(impl) + set_method(self, method_name, impl) + set_class(impl, :behaviour) + set_oapply(impl, head, body) + end + + defmethod(:object, :does_not_understand, [self, method, args]) do + :fail + end + + set_class(:map, :class) + set_super(:map, :ephemeral) + + set_class(:map_get, :behaviour) + set_method(:map, :get, :map_get) + + set_class(:map_put, :behaviour) + set_method(:map, :put, :map_put) + + defmethod(:class, :construct, [self, %{class: self}]) do + end + + set_method(:class, :allocate, :allocate_class) + set_class(:allocate_class, :behaviour) + + set_oapply(:allocate_class, [self, args, name]) do + map_get(args, :name, name) + map_get(args, :super, super) + map_get(args, :slots, slots) + + class(self, meta) + + set_class(name, meta) + set_super(name, super) + set_slots(name, slots) + end + + defmethod(:object, :allocate, [self, args, name]) do + class(self, meta) + alternative([map_get(args, :name, name)], [gensym(name)]) + set_class(name, meta) + end + + defmethod(:object, :init, [self, _, self]) do + # print(["initialise", self]) + end + + defmethod(:class, :new, [self, args, new]) do + construct(self, construct) + allocate(construct, args, alloc) + init(alloc, args, new) + end + + new(:class, %{name: :ephemeral, super: :object, slots: []}, _) + + defmethod(:ephemeral, :allocate, [self, _, self]) do + # print(["allocate", self]) + end + + defmethod(:object, :examine, [ + self, + %{ + id: self, + classes: classes, + objects: objects, + supers: supers, + subs: subs, + methods: methods, + providers: providers, + clauses: clauses, + slots: slots + } + ]) do + findall(c, [class(self, c)], classes) + findall(c, [class(c, self)], objects) + findall(s, [super(self, s)], supers) + findall(sub, [super(sub, self)], subs) + findall([n, id], [method(self, n, id)], methods) + findall([provider, n], [method(provider, n, self)], providers) + findall([head, body], [clause(self, head, body)], clauses) + findall([slot_name, slot_value], [get_slot(self, slot_name, slot_value)], slots) + end + + new(:class, %{name: :package, super: :object, slots: [:name, :version, :deps, :tx]}, _) + + defmethod(:package, :init, [self, args, self]) do + map_get(args, :name, name) + map_get(args, :version, version) + map_get(args, :deps, deps) + current_tx(tx) + set_slots(self, %{name: name, version: version, deps: deps, tx: tx}) + end + + new(:class, %{name: :list, super: :ephemeral, slots: []}, _) + + defmethod(:list, :hd, [[h | _t], h]) do + end + + defmethod(:list, :tl, [[_h | t], t]) do + end + + set_method(:list, :concat, :list_concat) + set_class(:list_concat, :behaviour) + + set_oapply(:list_concat, [[], second, second]) do + end + + set_oapply(:list_concat, [[fh | ft], second, [fh | inner]]) do + concat(ft, second, inner) + end + + set_method(:list, :member, :list_member) + set_class(:list_member, :behaviour) + + set_oapply(:list_member, [[x | _t], x]) do + end + + set_oapply(:list_member, [[_h | t], x]) do + member(t, x) + end + + set_method(:list, :reverse, :list_reverse) + set_class(:list_reverse, :behaviour) + + set_oapply(:list_reverse, [[], []]) do + end + + set_oapply(:list_reverse, [[h | t], reversed]) do + reverse(t, reversed_tl) + concat(reversed_tl, [h], reversed) + end + + set_method(:list, :map, :list_map) + set_class(:list_map, :behaviour) + + set_oapply(:list_map, [[], _func, []]) do + end + + set_oapply(:list_map, [[], _head, _body, []]) do + end + + set_oapply(:list_map, [[fh | ft], func, [sh | st]]) do + send(fh, func, [sh]) + map(ft, func, st) + end + + set_oapply(:list_map, [[fh | ft], head, body, [sh | st]]) do + call(head, body, [fh, sh]) + map(ft, head, body, st) + end + + set_method(:list, :fold_left, :list_fold_left) + set_class(:list_fold_left, :behaviour) + + set_oapply(:list_fold_left, [[], _func, acc, acc]) do + end + + set_oapply(:list_fold_left, [[], _head, _body, acc, acc]) do + end + + set_oapply(:list_fold_left, [[h | t], func, acc, result]) do + send(acc, func, [h, next_acc]) + fold_left(t, func, next_acc, result) + end + + set_oapply(:list_fold_left, [[h | t], head, body, acc, result]) do + print(acc) + call(head, body, [acc, h, next_acc]) + fold_left(t, head, body, next_acc, result) + end + + set_method(:list, :fold_right, :list_fold_right) + set_class(:list_fold_right, :behaviour) + + set_oapply(:list_fold_right, [[], _func, acc, acc]) do + end + + set_oapply(:list_fold_right, [[], _head, _body, acc, acc]) do + end + + set_oapply(:list_fold_right, [[h | t], func, acc, result]) do + fold_right(t, func, acc, next_acc) + send(next_acc, func, [h, result]) + end + + set_oapply(:list_fold_right, [[h | t], head, body, acc, result]) do + fold_right(t, head, body, acc, next_acc) + call(head, body, [next_acc, h, result]) + end + + defmethod(:list, :flatten, [lists, result]) do + fold_left(lists, :concat, [], result) + end + + set_method(:list, :same_length, :list_same_length) + set_class(:list_same_length, :behaviour) + + set_oapply(:list_same_length, [[], []]) do + end + + set_oapply(:list_same_length, [[_fh | ft], [_sh | st]]) do + same_length(ft, st) + end + end +end diff --git a/lib/AL/package/constraints.ex b/lib/AL/package/constraints.ex new file mode 100644 index 0000000..8505826 --- /dev/null +++ b/lib/AL/package/constraints.ex @@ -0,0 +1,67 @@ +defmodule AL.Package.Constraints do + use AL.Package + + defpackage :constraints, version: 1, deps: [:bootstrap] do + new(:class, %{name: :cell, super: :object, slots: [:subscribers, :value, :name]}, _) + + defmethod(:cell, :init, [self, args, self]) do + set_slots(self, %{name: self, subscribers: [], value: :absent}) + end + + defmethod(:cell, :constrain, [self, value]) do + get_slot(self, :value, :absent) + set_slots(self, %{value: value}) + + forall( + [get_slot(self, :subscribers, subscribers), member(subscribers, subscriber)], + [send_async(subscriber, :cell_updated, [self, value])] + ) + + cut + end + + defmethod(:cell, :subscribe, [self, subscriber]) do + get_slot(self, :subscribers, subscribers) + set_slots(self, %{subscribers: [subscriber | subscribers]}) + end + + new( + :class, + %{name: :propagator, super: :object, slots: [:input_cells, :output_cell, :name]}, + _ + ) + + defmethod(:propagator, :init, [self, args, self]) do + map_get(args, :input_cells, input_cells) + map_get(args, :output_cell, output_cell) + + set_slots(self, %{input_cells: input_cells, output_cell: output_cell, name: self}) + + forall( + [member(input_cells, input_cell)], + [subscribe(input_cell, self)] + ) + + send_async(self, :cell_updated, [:none, :none]) + end + + defmethod(:propagator, :cell_updated, [self, _cell_name, _value]) do + get_slot(self, :input_cells, input_cells) + get_slot(self, :output_cell, output_cell) + + findall( + input_cell_value, + [member(input_cells, input_cell), get_slot(input_cell, :value, input_cell_value)], + input_cell_values + ) + + forall( + [member(input_cell_values, input_cell_value)], + [not [unify(input_cell_value, :absent)]] + ) + + constrain(self, input_cell_values, output_value) + send_async(output_cell, :constrain, [output_value]) + end + end +end diff --git a/lib/AL/package/elixir_process.ex b/lib/AL/package/elixir_process.ex new file mode 100644 index 0000000..f9f938d --- /dev/null +++ b/lib/AL/package/elixir_process.ex @@ -0,0 +1,19 @@ +defmodule AL.Package.ElixirProcess do + use AL.Package + + defpackage :elixir_process, version: 1, deps: [:bootstrap] do + new(:class, %{name: :elixir_process, super: :object, slots: []}, _) + + defmethod(:elixir_process, :allocate, [self, args, new_obj]) do + class(self, meta) + map_get(args, :name, new_obj) + set_class(new_obj, meta) + set_super(new_obj, :object) + end + + defmethod(:elixir_process, :init, [self, args, self]) do + map_get(args, :pid, pid) + set_slots(self, %{pid: pid}) + end + end +end diff --git a/lib/AL/package/users.ex b/lib/AL/package/users.ex new file mode 100644 index 0000000..0a52535 --- /dev/null +++ b/lib/AL/package/users.ex @@ -0,0 +1,30 @@ +defmodule AL.Package.Users do + use AL.Package + + defpackage :users, version: 1, deps: [:bootstrap] do + new(:class, %{name: :user, super: :object, slots: [:name]}, _) + new(:class, %{name: :owned, super: :object, slots: [:name, :owner]}, _) + + defmethod(:owned, :init, [self, args, self]) do + set_slots(self, args) + end + + defmethod(:owned, :update, [self, slots]) do + set_slots(self, slots) + end + + defmethod(:owned, :may, [self, caller, _method, _args]) do + get_slot(self, :owner, owner) + unify(caller, owner) + end + + defmethod(:owned, :guarded_send, [self, caller, method, args]) do + may(self, caller, method, args) + send(self, method, args) + end + + defmethod(:owned, :does_not_understand, [self, method, [caller, args]]) do + guarded_send(self, caller, method, args) + end + end +end diff --git a/lib/AL/scheduler.ex b/lib/AL/scheduler.ex index 482c914..f900394 100644 --- a/lib/AL/scheduler.ex +++ b/lib/AL/scheduler.ex @@ -1,54 +1,77 @@ defmodule AL.Scheduler do + @moduledoc """ + I react to the command log: I turn `send_async`/`send_elixir` writes into live + execution. I run one scheduler per store (`:main` and each fork), since a + Mnesia subscription is per-table and each branch is its own live world. A + scheduler dispatches the sends it sees against its own store, so async work on + a fork stays on that fork. + """ + use GenServer - def start_link(args) do - GenServer.start_link(__MODULE__, args, name: __MODULE__) + @supervisor AL.Scheduler.Supervisor + + @doc "The DynamicSupervisor child spec that owns the per-store schedulers." + def supervisor_spec do + {DynamicSupervisor, name: @supervisor, strategy: :one_for_one} end - def processes() do - GenServer.call(__MODULE__, :processes) + @doc "Start schedulers for `:main` and every existing fork. Run at boot." + @spec start_all() :: :ok + def start_all() do + for store <- [:main | AL.Branch.list()], do: start(store) + :ok end - @impl true - def handle_call(:processes, _from, state) do - {:reply, state.processes, state} + @doc "Start (idempotently) the scheduler for `store`." + @spec start(AL.Object.store()) :: :ok + def start(store) do + case DynamicSupervisor.start_child(@supervisor, {__MODULE__, store}) do + {:ok, _pid} -> :ok + {:error, {:already_started, _pid}} -> :ok + other -> other + end end - @impl true - def init(_opts) do - :mnesia.subscribe({:table, :command, :detailed}) + @doc "Stop the scheduler for `store` (unsubscribing it). Idempotent." + @spec stop(AL.Object.store()) :: :ok + def stop(store) do + case Process.whereis(name(store)) do + nil -> :ok + pid -> DynamicSupervisor.terminate_child(@supervisor, pid) + end + end - {:atomic, commands} = :mnesia.transaction(fn -> AL.Command.commands_since(0) end) + def start_link(store) do + GenServer.start_link(__MODULE__, store, name: name(store)) + end - processes = - for {:command, t, _, {:spawn_process, {object, head, body}}} <- commands, into: %{} do - {object, start_process(object, head, body, t)} - end + defp name(store), do: :"#{__MODULE__}.#{store}" - {:ok, %{processes: processes}} + @impl true + def init(store) do + :mnesia.subscribe({:table, AL.Command.log(store), :detailed}) + {:ok, %{store: store}} end @impl true def handle_info( {:mnesia_table_event, - {:write, :command, {:command, t, _tx_id, {:spawn_process, {object, head, body}}}, _old, _tid}}, - state + {:write, _table, {:command, _t, _tx_id, {:send_async, {object, method, args}}}, _old, + _tid}}, + %{store: store} = state ) do - {:noreply, %{state | processes: Map.put(state.processes, object, start_process(object, head, body, t))}} + Task.start(fn -> AL.eval([{:send, object, method, args}], nil, store) end) + {:noreply, state} end @impl true def handle_info( - {:mnesia_table_event, {:write, :command, {:command, t, _tx_id, command}, _old, _tid}}, + {:mnesia_table_event, + {:write, _table, {:command, _t, _tx_id, {:send_elixir, {pid, message}}}, _old, _tid}}, state ) do - Enum.each(state.processes, fn {_object, {head, pid}} -> - case AL.Var.unify(command, head, AL.Var.empty_bindings()) do - nil -> :ok - bindings -> send(pid, {:dispatch, t, bindings}) - end - end) - + send(pid, message) {:noreply, state} end @@ -56,17 +79,4 @@ defmodule AL.Scheduler do def handle_info({:mnesia_table_event, _}, state) do {:noreply, state} end - - defp start_process(_object, head, body, _spawn_t) do - pid = spawn_link(fn -> worker_loop(body) end) - {head, pid} - end - - defp worker_loop(body) do - receive do - {:dispatch, _t, bindings} -> - AL.eval(body, bindings) - worker_loop(body) - end - end end diff --git a/lib/AL/trace.ex b/lib/AL/trace.ex new file mode 100644 index 0000000..02042f7 --- /dev/null +++ b/lib/AL/trace.ex @@ -0,0 +1,88 @@ +defmodule AL.Trace do + @moduledoc """ + I am the tracing module. I provide tracepoint functionality and readable + rendering of AL terms. + """ + + @spec trace(atom()) :: :ok + def trace(point) do + Application.put_env(:al, :tracepoints, MapSet.put(tracepoints(), point)) + end + + @spec untrace(atom()) :: :ok + def untrace(point) do + Application.put_env(:al, :tracepoints, MapSet.delete(tracepoints(), point)) + end + + @spec notrace() :: :ok + def notrace() do + Application.put_env(:al, :tracepoints, MapSet.new()) + end + + @spec tracepoints() :: MapSet.t() + def tracepoints() do + Application.get_env(:al, :tracepoints, MapSet.new()) + end + + @spec call(non_neg_integer(), term(), term(), [term()]) :: :ok + def call(depth, receiver, method, args) do + IO.puts([ + String.duplicate(" ", depth), + "Call: ", + inspect(pretty(receiver)), + " <- ", + inspect(pretty(method)), + "(", + args |> Enum.map(&inspect(pretty(&1))) |> Enum.join(", "), + ")" + ]) + end + + @spec fail(non_neg_integer(), term(), term()) :: :ok + def fail(depth, receiver, method) do + IO.puts([ + String.duplicate(" ", depth), + "Fail: ", + inspect(pretty(receiver)), + " ", + inspect(pretty(method)) + ]) + end + + @spec pretty(term()) :: term() + def pretty(a) when is_atom(a) do + s = Atom.to_string(a) + + cond do + hash?(s) -> :"##{AL.Command.id_label(a)}" + AL.Var.var?(a) -> :"#{strip_freshener(s)}" + true -> a + end + end + + def pretty(t) when is_tuple(t), + do: t |> Tuple.to_list() |> Enum.map(&pretty/1) |> List.to_tuple() + + def pretty(l) when is_list(l), do: Enum.map(l, &pretty/1) + + def pretty(m) when is_map(m), + do: Map.new(m, fn {k, v} -> {pretty(k), pretty(v)} end) + + def pretty(x), do: x + + defp hash?(s) do + byte_size(s) == 32 and Enum.all?(String.to_charlist(s), &(&1 in ?0..?9 or &1 in ?a..?f)) + end + + defp strip_freshener(s) do + s + |> String.split("_") + |> Enum.reverse() + |> Enum.drop_while(&integer_segment?/1) + |> Enum.reverse() + |> Enum.join("_") + end + + defp integer_segment?(""), do: false + defp integer_segment?(s), do: Enum.all?(String.to_charlist(s), &(&1 in ?0..?9)) +end diff --git a/lib/AL/var.ex b/lib/AL/var.ex index 645267b..571b42a 100644 --- a/lib/AL/var.ex +++ b/lib/AL/var.ex @@ -106,7 +106,7 @@ defmodule AL.Var do end end - @spec extend(bindings(), t(), t()) :: bindings() + @spec extend(bindings(), t(), t()) :: bindings() | nil def extend(bindings, x, y) do rx = deref(bindings, x) ry = deref(bindings, y) @@ -116,15 +116,44 @@ defmodule AL.Var do cond do rx == ry -> bindings - not is_var_rx && is_var_ry -> Map.put(bindings, ry, x) - rx == x && is_var_ry -> Map.put(bindings, ry, x) - not is_var_ry && is_var_rx -> Map.put(bindings, rx, y) - ry == y && is_var_rx -> Map.put(bindings, rx, y) - is_var_ry && is_var_rx -> Map.put(bindings, rx, ry) + not is_var_rx && is_var_ry -> bind(bindings, ry, x) + rx == x && is_var_ry -> bind(bindings, ry, x) + not is_var_ry && is_var_rx -> bind(bindings, rx, y) + ry == y && is_var_rx -> bind(bindings, rx, y) + is_var_ry && is_var_rx -> bind(bindings, rx, ry) true -> unify(rx, ry, bindings) end end + # Bind `var` to `term`, refusing (returning nil, i.e. unification failure) if + # `var` occurs in `term` — the occurs check, which keeps cyclic terms out of + # the bindings so `subst`/`deref` can't loop forever. + @spec bind(bindings(), variable(), t()) :: bindings() | nil + defp bind(bindings, var, term) do + if occurs?(var, term, bindings), do: nil, else: Map.put(bindings, var, term) + end + + @spec occurs?(variable(), t(), bindings()) :: boolean() + def occurs?(var, term, bindings) do + term = if is_atom(term), do: deref(bindings, term), else: term + + cond do + var?(term) -> term == var + # handle cons cells directly so improper lists (`[h | $tail]`) work + is_list(term) -> occurs_in_list?(var, term, bindings) + is_tuple(term) -> occurs_in_list?(var, Tuple.to_list(term), bindings) + is_map(term) -> occurs_in_list?(var, Map.values(term), bindings) + true -> false + end + end + + defp occurs_in_list?(var, [head | tail], bindings), + do: occurs?(var, head, bindings) or occurs_in_list?(var, tail, bindings) + + defp occurs_in_list?(_var, [], _bindings), do: false + + defp occurs_in_list?(var, tail, bindings), do: occurs?(var, tail, bindings) + @spec unify(t(), t(), bindings()) :: bindings() | nil def unify(x, y, bindings \\ %{}) do cond do diff --git a/lib/AL/views.ex b/lib/AL/views.ex new file mode 100644 index 0000000..6b0dd10 --- /dev/null +++ b/lib/AL/views.ex @@ -0,0 +1,97 @@ +defmodule AL.Views do + @doc """ + I define GlamorousToolkit views for AL + """ + + use AL + use GtBridge.View + + alias GtBridge.Phlow.Mondrian + + defview object_examine_view(self = %AL.Object{}, builder) do + {:atomic, {bindings, _program_state}} = + AL.run do + examine(^self.id, info) + end + + GtBridge.Views.MapGraph.graph(Map.get(bindings, :"$info"), builder) + |> Mondrian.title("Examine") + end + + defview cell_view(self = %AL.Object{}, builder) do + result = + AL.run do + class(^self.id, :cell) + get_slot(^self.id, :subscribers, subscribers) + get_slot(^self.id, :value, value) + unify(nodes, [^self.id | subscribers]) + unify(children, %{^self.id => subscribers}) + end + + case result do + {:atomic, {bindings, _program_state}} -> + builder.mondrian() + |> Mondrian.title("Cell View") + |> Mondrian.nodes( + Enum.map( + Map.get(bindings, :"$nodes"), + fn x -> %AL.Object{id: x} end + ) + ) + |> Mondrian.node_label(fn node -> Atom.to_string(node.id) end) + |> Mondrian.edges(fn node -> + case Map.get(Map.get(bindings, :"$children"), node.id) do + nil -> [] + children -> Enum.map(children, fn c -> %AL.Object{id: c} end) + end + end) + |> Mondrian.layout(:horizontal_tree) + + _e -> + builder.empty() + end + end + + defview propagator_view(self = %AL.Object{}, builder) do + result = + AL.run do + class(^self.id, :propagator) + get_slot(^self.id, :input_cells, input_cells) + get_slot(^self.id, :output_cell, output_cell) + unify(nodes, [^self.id | [output_cell | input_cells]]) + + fold_left( + input_cells, + [acc, h, result], + [put(acc, h, [^self.id], result)], + %{^self.id => [output_cell]}, + children + ) + end + + IO.inspect(result) + + case result do + {:atomic, {bindings, _program_state}} -> + builder.mondrian() + |> Mondrian.title("Propagator View") + |> Mondrian.nodes( + Enum.map( + Map.get(bindings, :"$nodes"), + fn x -> %AL.Object{id: x} end + ) + ) + |> Mondrian.node_label(fn node -> Atom.to_string(node.id) end) + |> Mondrian.edges(fn node -> + case Map.get(Map.get(bindings, :"$children"), node.id) do + nil -> [] + children -> Enum.map(children, fn c -> %AL.Object{id: c} end) + end + end) + |> Mondrian.layout(:horizontal_tree) + + _e -> + builder.empty() + end + end +end diff --git a/lib/examples/e_AL.ex b/lib/examples/e_AL.ex index 000bbd0..5cea129 100644 --- a/lib/examples/e_AL.ex +++ b/lib/examples/e_AL.ex @@ -37,6 +37,50 @@ defmodule Examples.AL do result end + example does_not_understand_dispatch() do + {:atomic, {b, _}} = + run do + new(:class, %{name: :gadget, super: :ephemeral, slots: []}, _) + + defmethod(:gadget, :poke, [self, x]) do + unify(x, :ok) + end + + defmethod(:gadget, :does_not_understand, [self, _m, _a]) do + end + + new(:gadget, _, g) + end + + g = Map.get(b, :"$g") + + # head matches, body succeeds -> runs + {:atomic, _} = + run do + poke(^g, :ok) + end + + # head matches, body fails -> plain failure, not DNU + {:aborted, _} = + run do + poke(^g, :bad) + end + + # absent selector -> DNU (override succeeds) + {:atomic, _} = + run do + zap(^g) + end + + # wrong arity, no clause head matches -> DNU + {:atomic, _} = + run do + poke(^g, :a, :b) + end + + :ok + end + example get_oapply_command() do run do method(:object, :init, init_method) @@ -48,7 +92,7 @@ defmodule Examples.AL do {:atomic, {bindings, result}} = run do method(:object, :init, init_method) - send(init_method, :meta, [:"$class", :"$metaclass"]) + meta(init_method, :"$class", :"$metaclass") end assert Map.get(bindings, :"$class") == :behaviour @@ -189,10 +233,11 @@ defmodule Examples.AL do assert slots == %{a: 99, b: 2} slots end + example map_get() do {:atomic, {bindings, program_state}} = run do - send(%{a: 3, b: 4, c: 3}, :map_get, [k, 3]) + get(%{a: 3, b: 4, c: 3}, k, 3) end assert Map.get(bindings, :"$k") == :c or Map.get(bindings, :"$k") == :a @@ -204,6 +249,17 @@ defmodule Examples.AL do program_state end + example map_put() do + {:atomic, {bindings, program_state}} = + run do + put(%{a: 3, b: 4, c: 3}, :c, 4, m2) + end + + assert bindings |> Map.get(:"$m2") |> Map.get(:c) == 4 + + program_state + end + example gensym() do {:atomic, {bindings, _}} = run do @@ -215,127 +271,55 @@ defmodule Examples.AL do :ok end - example create_process() do - head = {:set_class, {:"$object", :"$class"}} - body = [{:set_slots, :"$object", %{processed: true}}] - - {:atomic, {bindings, _}} = + example not_succeeds_when_goal_fails() do + {:atomic, {_bindings, _}} = run do - send(:process, :new, [%{head: ^head, body: ^body}, new_proc]) - cut - end - - new_proc = Map.get(bindings, :"$new_proc") - assert is_atom(new_proc) - assert Enum.any?(AL.Scheduler.processes(), fn {_t, {h, _pid}} -> h == head end) + not [class(:nonexistent_xyz, c)] + end - bindings + :ok end - example process_handles_command() do - create_process() - - {:atomic, _} = + example not_fails_when_goal_succeeds() do + {:aborted, _} = run do - set_class(:test_object, :some_class) + not [class(:object, c)] end - Process.sleep(50) + :ok + end - {:atomic, results} = - :mnesia.transaction(fn -> AL.Objects.scan_slots(:test_object, :"$slots") end) + example unify_binds_variable() do + {:atomic, {bindings, _}} = + run do + unify(x, :hello) + end - assert Enum.any?(results, fn {:slots, _, slots} -> Map.get(slots, :processed) == true end) - end - - example arithmetic() do - {:atomic, {bindings, result}} = run do - is(a, (123 + 5) - 3) - is(f, 10000 - 3) - is(a, 122 + 3) - is(1000122, 122 + 1000000) - is(b, a + 12) - is(c, (b ** 2) + 1) - is(d, c / 3) - is(e, (c * 3) + 2) - is(e, 5 - e + 2*e - 5) - is(g, -7) - is(h, +7) - end - assert Map.get(bindings, :"$a") == 125 - assert Map.get(bindings, :"$f") == 9997 - assert Map.get(bindings, :"$b") == 137 - assert Map.get(bindings, :"$c") == 18770 - assert Map.get(bindings, :"$d") == 6256 - assert Map.get(bindings, :"$e") == 56312 - assert Map.get(bindings, :"$g") == -7 - assert Map.get(bindings, :"$h") == 7 - result + assert Map.get(bindings, :"$x") == :hello + :ok end - - example list_tests() do - {:atomic, {bindings, result}} = run do - set_oapply(:hd, [[hd | tl], hd]) do - end - set_oapply(:tl, [[hd | tl], tl]) do - end - set_class(:concat_list, :behaviour) - set_oapply(:concat_list, [[], second, second]) do - end - set_oapply(:concat_list, [[first_hd | first_tl], second, [first_hd | inner]]) do - oapply(:concat_list, [first_tl, second, inner]) - end - set_oapply(:reverse_list, [[], []]) do - end - set_oapply(:reverse_list, [[first_hd | first_tl], reversed]) do - oapply(:reverse_list, [first_tl, reversed_tl]) - oapply(:concat_list, [reversed_tl, [first_hd], reversed]) - end - set_oapply(:map_list, [func, [], []]) do - end - set_oapply(:map_list, [func, [first_hd | first_tl], [second_hd | second_tl]]) do - oapply(func, [first_hd, second_hd]) - oapply(:map_list, [func, first_tl, second_tl]) - end - set_oapply(:fold_left, [func, acc, [], acc]) do - end - set_oapply(:fold_left, [func, acc, [hd | tl], result]) do - oapply(func, [acc, hd, next_acc]) - oapply(:fold_left, [func, next_acc, tl, result]) - end - set_oapply(:fold_right, [func, acc, [], acc]) do - end - set_oapply(:fold_right, [func, acc, [hd | tl], result]) do - oapply(:fold_right, [func, acc, tl, next_acc]) - oapply(func, [next_acc, hd, result]) - end - set_oapply(:flatten_list, [lists, result]) do - oapply(:fold_left, [:concat_list, [], lists, result]) + + example unify_checks_equality() do + {:aborted, _} = + run do + unify(:foo, :bar) end - set_oapply(:same_length, [[], []]) do + + {:atomic, _} = + run do + unify(:foo, :foo) end - set_oapply(:same_length, [[first_hd | first_tl], [second_hd | second_tl]]) do - oapply(:same_length, [first_tl, second_tl]) + + :ok + end + + example call_lambda() do + {:atomic, {bindings, _}} = + run do + call([x, result], [unify(result, x)], [:hello, out]) end - oapply(:hd, [[:w, :x, :y, :z], head]) - oapply(:tl, [[:w, :x, :y, :z], tail]) - oapply(:concat_list, [[:a, :b, :c], [:d, :e, :f], sum]) - oapply(:reverse_list, [[:b, :c, :d, :e, :f], reversed]) - oapply(:map_list, [:reverse_list, [[:a, :b], [:c, :d, :e]], mapped]) - oapply(:fold_left, [:concat_list, [:starter], [[:a], [:b], [:c], [:d]], folded_left]) - oapply(:fold_right, [:concat_list, [:starter], [[:a], [:b], [:c], [:d]], folded_right]) - oapply(:flatten_list, [[[:a, :b], [:c, :d, :e]], flattened]) - oapply(:same_length, [[:c, :d, :e, :f], of_same_length]) - end - assert Map.get(bindings, :"$sum") == [:a, :b, :c, :d, :e, :f] - assert Map.get(bindings, :"$reversed") == [:f, :e, :d, :c, :b] - assert Map.get(bindings, :"$mapped") == [[:b, :a], [:e, :d, :c]] - assert Map.get(bindings, :"$folded_left") == [:starter, :a, :b, :c, :d] - assert Map.get(bindings, :"$folded_right") == [:starter, :d, :c, :b, :a] - assert Map.get(bindings, :"$flattened") == [:a, :b, :c, :d, :e] - assert Map.get(bindings, :"$head") == :w - assert Map.get(bindings, :"$tail") == [:x, :y, :z] - assert length(Map.get(bindings, :"$of_same_length")) == 4 - result + + assert Map.get(bindings, :"$out") == :hello + :ok end end diff --git a/lib/examples/e_AL_arithmetic.ex b/lib/examples/e_AL_arithmetic.ex new file mode 100644 index 0000000..664df19 --- /dev/null +++ b/lib/examples/e_AL_arithmetic.ex @@ -0,0 +1,67 @@ +defmodule Examples.ALArithmetic do + @moduledoc """ + I provide arithmetic (`is/2`) examples for AL: evaluation of arithmetic + expressions, and graceful failure when an expression cannot be evaluated. + """ + + use ExExample + use AL + import ExUnit.Assertions + + example arithmetic() do + {:atomic, {bindings, result}} = + run do + is(a, 123 + 5 - 3) + is(f, 10000 - 3) + is(a, 122 + 3) + is(1_000_122, 122 + 1_000_000) + is(b, a + 12) + is(c, b ** 2 + 1) + is(d, c / 3) + is(e, c * 3 + 2) + is(e, 5 - e + 2 * e - 5) + is(g, -7) + is(h, +7) + end + + assert Map.get(bindings, :"$a") == 125 + assert Map.get(bindings, :"$f") == 9997 + assert Map.get(bindings, :"$b") == 137 + assert Map.get(bindings, :"$c") == 18770 + assert Map.get(bindings, :"$d") == 6256 + assert Map.get(bindings, :"$e") == 56312 + assert Map.get(bindings, :"$g") == -7 + assert Map.get(bindings, :"$h") == 7 + result + end + + example is_fails_gracefully_on_unbound() do + # `is/2` over an unbound operand fails the goal (backtracks) instead of + # crashing the transaction + {:aborted, _} = + run do + is(x, y + 1) + end + + :ok + end + + example is_fails_on_division_by_zero() do + {:aborted, _} = + run do + is(x, 1 / 0) + end + + :ok + end + + example is_still_computes() do + {:atomic, {bindings, _}} = + run do + is(x, 2 ** 3 + 1) + end + + assert Map.get(bindings, :"$x") == 9 + :ok + end +end diff --git a/lib/examples/e_AL_bootstrap.ex b/lib/examples/e_AL_bootstrap.ex index 84e0c06..83e7edc 100644 --- a/lib/examples/e_AL_bootstrap.ex +++ b/lib/examples/e_AL_bootstrap.ex @@ -9,7 +9,7 @@ defmodule Examples.ALBootstrap do example bootstrapped_classes() do :mnesia.transaction(fn -> - class_results = AL.Objects.scan_class(:"$object", :"$class") + class_results = AL.Object.scan_class(:"$object", :"$class") Enum.take(class_results, 3) end) @@ -17,7 +17,7 @@ defmodule Examples.ALBootstrap do example bootstrapped_supers() do :mnesia.transaction(fn -> - super_results = AL.Objects.scan_super(:"$object", :"$super") + super_results = AL.Object.scan_super(:"$object", :"$super") Enum.take(super_results, 3) end) @@ -25,7 +25,7 @@ defmodule Examples.ALBootstrap do example bootstrapped_methods() do :mnesia.transaction(fn -> - method_results = AL.Objects.scan_method(:"$object", :"$method_name", :"$method_id") + method_results = AL.Object.scan_method(:"$object", :"$method_name", :"$method_id") Enum.take(method_results, 1) end) @@ -33,7 +33,7 @@ defmodule Examples.ALBootstrap do example bootstrapped_oapply() do :mnesia.transaction(fn -> - oapply_results = AL.Objects.scan_oapply(:"$object", :"$head", :"$body") + oapply_results = AL.Object.scan_oapply(:"$object", :"$head", :"$body") Enum.take(oapply_results, 1) end) diff --git a/lib/examples/e_AL_branch.ex b/lib/examples/e_AL_branch.ex new file mode 100644 index 0000000..aca8bcd --- /dev/null +++ b/lib/examples/e_AL_branch.ex @@ -0,0 +1,204 @@ +defmodule Examples.ALBranch do + @moduledoc """ + I provide branch (Git-like command-log fork) examples for AL: a branch is a + divergent command log materialised into its own store. + """ + + use ExExample + use AL + import ExUnit.Assertions + + example read_from_fork() do + # time just before we introduce :tt_thing + before = AL.Command.system_time() + + sym = :crypto.strong_rand_bytes(16) |> Base.encode16(case: :lower) |> String.to_atom() + + {:atomic, _} = + run do + set_class(^sym, :object) + end + + past = AL.Branch.fork(before - 1) + tip = AL.Branch.fork() + + # the tip fork sees :tt_thing; the past fork does not + {:atomic, _} = + run store: tip do + class(^sym, :object) + end + + {:aborted, _} = + run store: past do + class(^sym, :object) + end + + # both forks still carry the bootstrap + {:atomic, _} = + run store: past do + class(:object, :class) + end + + AL.Branch.discard(past) + AL.Branch.discard(tip) + :ok + end + + example write_to_fork() do + tip = AL.Branch.fork() + + # write only into the fork, then read it back from the fork's projection + {:atomic, {bindings, _}} = + run store: tip do + set_slots(:widget, %{x: 3}) + get_slot(:widget, :x, x) + end + + assert Map.get(bindings, :"$x") == 3 + + # main never saw :widget — the write stayed in the fork's log + {:aborted, _} = + run do + get_slot(:widget, :x, x) + end + + AL.Branch.discard(tip) + :ok + end + + example checkout_switches_head() do + branch = AL.Branch.fork() + AL.Branch.checkout(branch) + + # with the branch checked out, plain `run` acts against it + {:atomic, _} = + run do + set_class(:on_branch, :object) + end + + {:atomic, _} = + run do + class(:on_branch, :object) + end + + # back on main, the branch's write is invisible + AL.Branch.checkout(:main) + + {:aborted, _} = + run do + class(:on_branch, :object) + end + + AL.Branch.discard(branch) + :ok + end + + example fork_from_another_branch() do + parent = AL.Branch.fork() + + # a write that lives only on the parent fork + {:atomic, _} = + run store: parent do + set_class(:on_parent, :object) + end + + # forking the parent (not main) carries the parent's divergent history + child = AL.Branch.fork(:tip, parent) + + {:atomic, _} = + run store: child do + class(:on_parent, :object) + end + + # writes to the parent after the child forked don't reach the child + {:atomic, _} = + run store: parent do + set_class(:later_on_parent, :object) + end + + {:aborted, _} = + run store: child do + class(:later_on_parent, :object) + end + + # main never saw any of it + {:aborted, _} = + run do + class(:on_parent, :object) + end + + AL.Branch.discard(child) + AL.Branch.discard(parent) + :ok + end + + example fork_defaults_to_head() do + branch = AL.Branch.fork() + AL.Branch.checkout(branch) + + {:atomic, _} = + run do + set_class(:on_head, :object) + end + + # fork() with no args forks the checked-out branch, not main + child = AL.Branch.fork() + + {:atomic, _} = + run store: child do + class(:on_head, :object) + end + + # main, which was never checked out, has no such object to fork + AL.Branch.checkout(:main) + fresh = AL.Branch.fork() + + {:aborted, _} = + run store: fresh do + class(:on_head, :object) + end + + AL.Branch.discard(fresh) + AL.Branch.discard(child) + AL.Branch.discard(branch) + :ok + end + + example async_send_stays_on_fork() do + branch = AL.Branch.fork() + + # a worker object that lives only on the fork, built from bootstrap primitives + {:atomic, _} = + run store: branch do + set_class(:fork_worker, :object) + + defmethod(:fork_worker, :handle, [self, object]) do + set_slots(object, %{processed: true}) + end + end + + # an async send written into the fork is handled against the fork + {:atomic, _} = + run store: branch do + send_async(:fork_worker, :handle, [:fork_obj]) + end + + Process.sleep(50) + + {:atomic, {fork_bindings, _}} = + run store: branch do + get_slot(:fork_obj, :processed, v) + end + + assert Map.get(fork_bindings, :"$v") == true + + # main never saw the worker or the effect + {:aborted, _} = + run do + get_slot(:fork_obj, :processed, v) + end + + AL.Branch.discard(branch) + :ok + end +end diff --git a/lib/examples/e_AL_constraints.ex b/lib/examples/e_AL_constraints.ex new file mode 100644 index 0000000..60e07de --- /dev/null +++ b/lib/examples/e_AL_constraints.ex @@ -0,0 +1,96 @@ +defmodule Examples.ALConstraints do + @moduledoc """ + """ + + use ExExample + use AL + import ExUnit.Assertions + + example constant() do + {:atomic, {_bindings, _state}} = + run do + new(:cell, %{name: :x}, x) + new(:propagator, %{input_cells: [], output_cell: x}, propagator) + + defmethod(propagator, :constrain, [_self, [], 2]) do + end + + cut + end + + Process.sleep(50) + + {:atomic, {bindings, _state}} = + run do + get_slot(:x, :value, value) + end + + assert Map.get(bindings, :"$value") == 2 + + bindings + end + + example inc() do + constant() + + {:atomic, {_bindings, _state}} = + run do + new(:cell, %{name: :y}, y) + new(:propagator, %{input_cells: [:x], output_cell: y}, propagator) + + defmethod(propagator, :constrain, [_self, [x_val], y_val]) do + is(y_val, 1 + x_val) + end + end + + Process.sleep(50) + + {:atomic, {bindings, _state}} = + run do + get_slot(:y, :value, value) + end + + assert Map.get(bindings, :"$value") == 3 + + bindings + end + + example bidirectional_adder() do + {:atomic, {_bindings, _state}} = + run do + new(:cell, %{name: :a}, a) + new(:cell, %{name: :b}, b) + new(:cell, %{name: :c}, c) + + new(:propagator, %{input_cells: [a, b], output_cell: c, name: :ab_c}, propagator_ab) + new(:propagator, %{input_cells: [a, c], output_cell: b, name: :ac_b}, propagator_ac) + new(:propagator, %{input_cells: [b, c], output_cell: a, name: :bc_a}, propagator_bc) + + defmethod(propagator_ab, :constrain, [_self, [a_val, b_val], c_val]) do + is(c_val, a_val + b_val) + end + + defmethod(propagator_ac, :constrain, [_self, [a_val, c_val], b_val]) do + is(b_val, c_val - a_val) + end + + defmethod(propagator_bc, :constrain, [_self, [b_val, c_val], a_val]) do + is(a_val, c_val - b_val) + end + + send_async(b, :constrain, [3]) + send_async(c, :constrain, [5]) + end + + Process.sleep(100) + + {:atomic, {bindings, _state}} = + run do + get_slot(:a, :value, value) + end + + assert Map.get(bindings, :"$value") == 2 + + bindings + end +end diff --git a/lib/examples/e_AL_genserver.ex b/lib/examples/e_AL_genserver.ex new file mode 100644 index 0000000..3576290 --- /dev/null +++ b/lib/examples/e_AL_genserver.ex @@ -0,0 +1,93 @@ +defmodule Examples.ALGenserver do + @moduledoc """ + I demonstrate the pattern of registering an Elixir GenServer as an AL object. + """ + + use ExExample + use AL + import ExUnit.Assertions + + defmodule CounterService do + use GenServer + use AL + + def start_link(object_id) do + GenServer.start_link(__MODULE__, object_id) + end + + @impl true + def init(object_id) do + pid = self() + + run do + new(:elixir_process, %{name: ^object_id, pid: ^pid}, _) + + defmethod(^object_id, :increment, [self, amount]) do + get_slot(self, :pid, p) + send_elixir(p, {:increment, amount}) + end + end + + {:ok, %{object_id: object_id, count: 0}} + end + + @impl true + def handle_info({:increment, amount}, state) do + {:noreply, %{state | count: state.count + amount}} + end + + @impl true + def handle_info({:get_count, reply_to}, state) do + send(reply_to, {:count, state.count}) + {:noreply, state} + end + + @impl true + def terminate(_reason, state) do + object_id = state.object_id + + run do + retract_class(^object_id, c) + retract_super(^object_id, s) + end + end + + def count(pid) do + send(pid, {:get_count, self()}) + + receive do + {:count, n} -> n + after + 1000 -> :timeout + end + end + end + + example genserver_registers_as_al_object() do + {:ok, pid} = CounterService.start_link(:my_counter) + + {:atomic, results} = + :mnesia.transaction(fn -> AL.Object.scan_class(:my_counter, :"$class") end) + + assert Enum.any?(results, fn {:class, _, c} -> c == :elixir_process end) + + {:atomic, _} = + run do + send_async(:my_counter, :increment, [5]) + end + + Process.sleep(50) + + assert CounterService.count(pid) == 5 + + GenServer.stop(pid) + Process.sleep(50) + + {:atomic, after_stop} = + :mnesia.transaction(fn -> AL.Object.scan_class(:my_counter, :"$class") end) + + assert after_stop == [] + + :ok + end +end diff --git a/lib/examples/e_AL_lists.ex b/lib/examples/e_AL_lists.ex new file mode 100644 index 0000000..17625e8 --- /dev/null +++ b/lib/examples/e_AL_lists.ex @@ -0,0 +1,46 @@ +defmodule Examples.ALLists do + @moduledoc """ + I provide list examples for AL: the bootstrap list protocol (hd, tl, concat, + reverse, map, fold, flatten, same_length) and mapping a lambda over a list. + """ + + use ExExample + use AL + import ExUnit.Assertions + + example list_tests() do + {:atomic, {bindings, result}} = + run do + hd([:w, :x, :y, :z], head) + tl([:w, :x, :y, :z], tail) + concat([:a, :b, :c], [:d, :e, :f], sum) + reverse([:b, :c, :d, :e, :f], reversed) + map([[:a, :b], [:c, :d, :e]], :reverse, mapped) + fold_left([[:a], [:b], [:c], [:d]], :concat, [:starter], folded_left) + fold_right([[:a], [:b], [:c], [:d]], :concat, [:starter], folded_right) + flatten([[:a, :b], [:c, :d, :e]], flattened) + same_length([:c, :d, :e, :f], of_same_length) + end + + assert Map.get(bindings, :"$sum") == [:a, :b, :c, :d, :e, :f] + assert Map.get(bindings, :"$reversed") == [:f, :e, :d, :c, :b] + assert Map.get(bindings, :"$mapped") == [[:b, :a], [:e, :d, :c]] + assert Map.get(bindings, :"$folded_left") == [:starter, :a, :b, :c, :d] + assert Map.get(bindings, :"$folded_right") == [:starter, :d, :c, :b, :a] + assert Map.get(bindings, :"$flattened") == [:a, :b, :c, :d, :e] + assert Map.get(bindings, :"$head") == :w + assert Map.get(bindings, :"$tail") == [:x, :y, :z] + assert length(Map.get(bindings, :"$of_same_length")) == 4 + result + end + + example call_lambda_map() do + {:atomic, {bindings, _}} = + run do + map([:a, :b, :c], [x, %{id: x}], [], out) + end + + assert Map.get(bindings, :"$out") == [%{id: :a}, %{id: :b}, %{id: :c}] + :ok + end +end diff --git a/lib/examples/e_AL_objects.ex b/lib/examples/e_AL_objects.ex index cb2fde3..4176725 100644 --- a/lib/examples/e_AL_objects.ex +++ b/lib/examples/e_AL_objects.ex @@ -10,13 +10,13 @@ defmodule Examples.ALObjects do example defmethod() do {:atomic, {bindings, _}} = run do - send(:class, :new, [%{name: :greeter, super: :object, slots: []}, _]) + new(:class, %{name: :greeter, super: :ephemeral, slots: []}, _) defmethod(:greeter, :greet, [self, name]) do end - send(:greeter, :new, [_, instance]) - send(instance, :greet, [:world]) + new(:greeter, _, instance) + greet(instance, :world) end assert Map.get(bindings, :"$instance") == %{class: :greeter} @@ -26,8 +26,8 @@ defmodule Examples.ALObjects do example make_point_object() do {:atomic, {bindings, result}} = run do - send(:class, :new, [%{name: :point, super: :object, slots: []}, new_point_class]) - send(new_point_class, :new, [_, new_point_object]) + new(:class, %{name: :point, super: :ephemeral, slots: []}, new_point_class) + new(new_point_class, _, new_point_object) cut end @@ -37,75 +37,27 @@ defmodule Examples.ALObjects do result end - example metaclass_init_override() do + example metaclass_alloc_override() do {:atomic, {b, program_state}} = run do - send(:class, :new, [ - %{name: :counter_meta, super: :class, slots: []}, - _ - ]) - set_slots(:counter_meta, %{count: []}) + new(:class, %{name: :durable_meta, super: :object, slots: []}, _) + + defmethod(:durable_meta, :allocate, [self, args, name]) do + map_get(args, :name, name) + map_get(args, :slots, slots) - defmethod(:counter_meta, :init, [self, args, self]) do class(self, meta) - get_slot(meta, :count, count) - set_slots(meta, %{count: ["new class!" | count]}) - set_method(self, :init, :initialise_counted_object) - cut - end - set_class(:initialise_counted_object, :behaviour) - set_oapply(:initialise_counted_object, [self, _, self]) do - send(self, :meta, [meta, metaclass]) - get_slot(metaclass, :count, count) - set_slots(metaclass, %{count: ["new object!" | count]}) - # TODO find a good way to do call next method - cut + set_class(name, meta) + set_super(name, :object) + set_slots(name, slots) end - send(:counter_meta, :new, [ - %{name: :example_counter_meta_instance, super: :object, slots: []}, - counter_example_meta_instance - ]) - - send(:counter_meta, :new, [ - %{name: :example_counter_meta_instance_2, super: :object, slots: []}, - counter_example_meta_instance_2 - ]) - - send(:example_counter_meta_instance, :new, [_, example_ii]) - cut + new(:durable_meta, %{slots: [], name: :alloc_overriden}, obj) - get_slot(:counter_meta, :count, c) + class(obj, obj_class) end - assert Map.get(b, :"$c") == ["new object!", "new class!", "new class!"] - - program_state - end - - example metaclass_alloc_override() do - {:atomic, {b, program_state}} = - run do - send(:class, :new, [ - %{name: :durable_meta, super: :object, slots: []}, - _]) - defmethod(:durable_meta, :allocate, [self, args, name]) do - map_get(args, :name, name) - map_get(args, :slots, slots) - - class(self, meta) - - set_class(name, meta) - set_super(name, :object) - set_slots(name, slots) - end - - send(:durable_meta, :new, [%{slots: [], name: :alloc_overriden}, obj]) - - class(obj, obj_class) - end - assert is_atom(Map.get(b, :"$obj")) assert Map.get(b, :"$obj_class") == :durable_meta @@ -113,14 +65,15 @@ defmodule Examples.ALObjects do end example examine() do - {:atomic, {bindings, program_state}} = run do - send(:class, :examine, [info]) - map_get(info, :methods, methods) - map_get(info, :classes, classes) - map_get(info, :supers, supers) - end - - assert Map.get(bindings, :"$classes") == [:class] + {:atomic, {bindings, program_state}} = + run do + examine(:class, info) + map_get(info, :methods, methods) + map_get(info, :classes, classes) + map_get(info, :supers, supers) + end + + assert Map.get(bindings, :"$classes") == [:class] assert Map.get(bindings, :"$supers") == [:object] program_state diff --git a/lib/examples/e_AL_tasks.ex b/lib/examples/e_AL_tasks.ex new file mode 100644 index 0000000..23e77fe --- /dev/null +++ b/lib/examples/e_AL_tasks.ex @@ -0,0 +1,60 @@ +defmodule Examples.ALTasks do + @moduledoc """ + I exercise AL's asynchronous send behaviour: `send_async` writes a command that + the per-store scheduler turns into a live `send`, run in its own transaction. + The receiving object is built from bootstrap primitives (`defmethod`), so these + examples cover the async machinery itself rather than any object package. + """ + + use ExExample + use AL + import ExUnit.Assertions + + # An object with one method that records, in a slot, that it ran. + example worker() do + {:atomic, _} = + run do + set_class(:worker, :object) + + defmethod(:worker, :handle, [self, object]) do + set_slots(object, %{processed: true}) + end + end + + :worker + end + + defp processed?(object) do + {:atomic, results} = + :mnesia.transaction(fn -> AL.Object.scan_slots(object, :"$slots") end) + + Enum.any?(results, fn {:slots, _, slots} -> Map.get(slots, :processed) == true end) + end + + example async_send_runs_handler() do + worker() + + {:atomic, _} = + run do + send_async(:worker, :handle, [:async_obj]) + end + + Process.sleep(50) + + assert processed?(:async_obj) + end + + example async_send_resolves_receiver_var() do + worker() + + {:atomic, _} = + run do + unify(w, :worker) + send_async(w, :handle, [:async_obj_2]) + end + + Process.sleep(50) + + assert processed?(:async_obj_2) + end +end diff --git a/lib/examples/e_AL_trace.ex b/lib/examples/e_AL_trace.ex new file mode 100644 index 0000000..adc1336 --- /dev/null +++ b/lib/examples/e_AL_trace.ex @@ -0,0 +1,43 @@ +defmodule Examples.ALTrace do + @moduledoc """ + I provide tracing examples for AL + """ + + use ExExample + use AL + import ExUnit.Assertions + import ExUnit.CaptureIO + + example trace_object() do + AL.trace(:cell) + + output = + capture_io(fn -> + run do + new(:cell, %{name: :traced}, c) + end + end) + + AL.notrace() + + assert String.contains?(output, "Call: :cell") + output + end + + example trace_clause_fail() do + AL.trace(:list_member) + + output = + capture_io(fn -> + run do + member([:a, :b], :z) + end + end) + + AL.notrace() + + assert String.contains?(output, "Call:") + assert String.contains?(output, "Fail:") + output + end +end diff --git a/lib/examples/e_AL_users.ex b/lib/examples/e_AL_users.ex new file mode 100644 index 0000000..a4d33bf --- /dev/null +++ b/lib/examples/e_AL_users.ex @@ -0,0 +1,55 @@ +defmodule Examples.ALUsers do + @moduledoc """ + I provide user and ownership examples for AL + """ + + use ExExample + use AL + import ExUnit.Assertions + + example owner_is_a_slot() do + {:atomic, {b, _}} = + run do + new(:user, %{name: :alice}, alice) + new(:owned, %{owner: alice, label: :thing}, obj) + get_slot(obj, :owner, owner) + class(obj, c) + end + + assert Map.get(b, :"$owner") == Map.get(b, :"$alice") + assert Map.get(b, :"$c") == :owned + :ok + end + + example owner_gated_update() do + {:atomic, {b, _}} = + run do + new(:user, %{name: :bob}, bob) + new(:user, %{name: :charlie}, charlie) + new(:owned, %{owner: charlie, label: :secret}, obj) + end + + charlie = Map.get(b, :"$charlie") + bob = Map.get(b, :"$bob") + obj = Map.get(b, :"$obj") + + {:atomic, _} = + run do + update(^obj, ^charlie, [%{label: :updated}]) + end + + {:atomic, {b2, _}} = + run do + get_slot(^obj, :label, l) + end + + assert Map.get(b2, :"$l") == :updated + + {:aborted, _} = + run do + update(^obj, ^bob, [%{label: :hacked}]) + end + + :ok + end +end diff --git a/lib/examples/e_var.ex b/lib/examples/e_var.ex index e1a916f..d824095 100644 --- a/lib/examples/e_var.ex +++ b/lib/examples/e_var.ex @@ -54,4 +54,19 @@ defmodule Examples.AL.Var do Base.encode16(:crypto.strong_rand_bytes(2)) ) end + + example occurs_check_rejects_cycle() do + # binding a var into a term that contains it would create a cyclic term; + # the occurs check refuses, so unification fails (nil) + assert AL.Var.unify(:"$x", [:"$x"]) == nil + assert AL.Var.unify([:"$x"], :"$x") == nil + assert AL.Var.occurs?(:"$x", {:f, [1, :"$x"]}, %{}) + + # an improper list (cons with a variable tail) is walked without crashing + refute AL.Var.occurs?(:"$x", [1 | :"$y"], %{}) + + # a var that does not occur in the term still binds normally + assert AL.Var.unify(:"$x", [1, 2, :"$y"]) == %{"$x": [1, 2, :"$y"]} + :ok + end end diff --git a/mix.exs b/mix.exs index 2300f85..dc2f8a0 100644 --- a/mix.exs +++ b/mix.exs @@ -24,7 +24,8 @@ defmodule AL.MixProject do defp deps do [ {:typed_struct, "~> 0.3.0"}, - {:ex_example, "~> 0.1.1"} + {:ex_example, "~> 0.1.1"}, + {:gt_bridge, git: "https://github.com/mariari/ElixirGtBridge.git"} ] end end diff --git a/mix.lock b/mix.lock index e4a9aac..0fe955b 100644 --- a/mix.lock +++ b/mix.lock @@ -1,11 +1,31 @@ %{ "cachex": {:hex, :cachex, "4.1.1", "574c5cd28473db313a0a76aac8c945fe44191659538ca6a1e8946ec300b1a19f", [:mix], [{:eternal, "~> 1.2", [hex: :eternal, repo: "hexpm", optional: false]}, {:ex_hash_ring, "~> 6.0", [hex: :ex_hash_ring, repo: "hexpm", optional: false]}, {:jumper, "~> 1.0", [hex: :jumper, repo: "hexpm", optional: false]}, {:sleeplocks, "~> 1.1", [hex: :sleeplocks, repo: "hexpm", optional: false]}, {:unsafe, "~> 1.0", [hex: :unsafe, repo: "hexpm", optional: false]}], "hexpm", "d6b7449ff98d6bb92dda58bd4fc3189cae9f99e7042054d669596f56dc503cd8"}, + "cowboy": {:hex, :cowboy, "2.16.1", "fa04080b602ff25c40a7700f2dc0152dbc1ba26b42093ae0fa9bb7a337d5a242", [:make, :rebar3], [{:cowlib, ">= 2.16.0 and < 3.0.0", [hex: :cowlib, repo: "hexpm", optional: false]}, {:ranch, ">= 1.8.0 and < 3.0.0", [hex: :ranch, repo: "hexpm", optional: false]}], "hexpm", "b8ea4dd317a043e3177ec840cfa3bcb47cfb41035d3abb24d954dc7d51def399"}, + "cowboy_telemetry": {:hex, :cowboy_telemetry, "0.4.0", "f239f68b588efa7707abce16a84d0d2acf3a0f50571f8bb7f56a15865aae820c", [:rebar3], [{:cowboy, "~> 2.7", [hex: :cowboy, repo: "hexpm", optional: false]}, {:telemetry, "~> 1.0", [hex: :telemetry, repo: "hexpm", optional: false]}], "hexpm", "7d98bac1ee4565d31b62d59f8823dfd8356a169e7fcbb83831b8a5397404c9de"}, + "cowlib": {:hex, :cowlib, "2.17.1", "3e6053016d1ab245730f0af688755476dcedb1c25ed8fb5751f59a2bfdc0c9af", [:make, :rebar3], [], "hexpm", "ff08bd17e6dd931445b18af77315b9b5fe052407110964ad2588c686b57b5e3f"}, "eternal": {:hex, :eternal, "1.2.2", "d1641c86368de99375b98d183042dd6c2b234262b8d08dfd72b9eeaafc2a1abd", [:mix], [], "hexpm", "2c9fe32b9c3726703ba5e1d43a1d255a4f3f2d8f8f9bc19f094c7cb1a7a9e782"}, + "event_broker": {:hex, :event_broker, "1.1.1", "40788d9131e5ff87ed97765dd8818186ada9b0cc816af9811a9270b0bfeff5a8", [:make, :mix], [{:ex_example, "~> 0.1.1", [hex: :ex_example, repo: "hexpm", optional: false]}, {:jason, "~> 1.4", [hex: :jason, repo: "hexpm", optional: false]}, {:typed_struct, "~> 0.3.0", [hex: :typed_struct, repo: "hexpm", optional: false]}], "hexpm", "15c9d400542f5f544eeea90979cf108b5b3220172d925eb33143b14af44b106b"}, "ex_example": {:hex, :ex_example, "0.1.1", "6651636401262149399420415b97b3dbcbe034aaf84e2336696eef4a780a6ee8", [:mix], [{:cachex, "~> 4.1.1", [hex: :cachex, repo: "hexpm", optional: false]}, {:libgraph, "~> 0.16.0", [hex: :libgraph, repo: "hexpm", optional: false]}, {:typed_struct, "~> 0.3.0", [hex: :typed_struct, repo: "hexpm", optional: false]}], "hexpm", "df2730873fa1ce4e2650693a67026517aadd4ac1a0011afd4e17b348474bbd23"}, "ex_hash_ring": {:hex, :ex_hash_ring, "6.0.4", "bef9d2d796afbbe25ab5b5a7ed746e06b99c76604f558113c273466d52fa6d6b", [:mix], [], "hexpm", "89adabf31f7d3dfaa36802ce598ce918e9b5b33bae8909ac1a4d052e1e567d18"}, + "finch": {:hex, :finch, "0.22.0", "5c48fa6f9706a78eb9036cacb67b8b996b4e66d111c543f4c29bb0f879a6806b", [:mix], [{:mime, "~> 1.0 or ~> 2.0", [hex: :mime, repo: "hexpm", optional: false]}, {:mint, "~> 1.8", [hex: :mint, repo: "hexpm", optional: false]}, {:nimble_options, "~> 0.4 or ~> 1.0", [hex: :nimble_options, repo: "hexpm", optional: false]}, {:nimble_pool, "~> 1.1", [hex: :nimble_pool, repo: "hexpm", optional: false]}, {:telemetry, "~> 0.4 or ~> 1.0", [hex: :telemetry, repo: "hexpm", optional: false]}], "hexpm", "b94e83c47780fc6813f746a1f1a34ee65cda42da4c5ea26a68f0acc4498e23dc"}, + "gt_bridge": {:git, "https://github.com/mariari/ElixirGtBridge.git", "97ceed38b42515911a7e01f5a314f6d944e4bed8", []}, + "hpax": {:hex, :hpax, "1.0.3", "ed67ef51ad4df91e75cc6a1494f851850c0bd98ebc0be6e81b026e765ee535aa", [:mix], [], "hexpm", "8eab6e1cfa8d5918c2ce4ba43588e894af35dbd8e91e6e55c817bca5847df34a"}, + "jason": {:hex, :jason, "1.4.5", "2e3a008590b0b8d7388c20293e9dcc9cf3e5d642fd2a114e4cbbb52e595d940a", [:mix], [{:decimal, "~> 1.0 or ~> 2.0 or ~> 3.0", [hex: :decimal, repo: "hexpm", optional: true]}], "hexpm", "b0c823996102bcd0239b3c2444eb00409b72f6a140c1950bc8b457d836b30684"}, + "jexon": {:hex, :jexon, "0.9.5", "fa4c851c0576b6f6e3d563fdccea6172bc32bc6fac1d7f34b5b47cad6c699359", [:mix], [{:jason, "~> 1.4.0", [hex: :jason, repo: "hexpm", optional: false]}], "hexpm", "76e4dea871745d5dc49515c74d3b287fb41fb742aca7d1c4b146cc8b8f70e2ba"}, "jumper": {:hex, :jumper, "1.0.2", "68cdcd84472a00ac596b4e6459a41b3062d4427cbd4f1e8c8793c5b54f1406a7", [:mix], [], "hexpm", "9b7782409021e01ab3c08270e26f36eb62976a38c1aa64b2eaf6348422f165e1"}, "libgraph": {:hex, :libgraph, "0.16.0", "3936f3eca6ef826e08880230f806bfea13193e49bf153f93edcf0239d4fd1d07", [:mix], [], "hexpm", "41ca92240e8a4138c30a7e06466acc709b0cbb795c643e9e17174a178982d6bf"}, + "mime": {:hex, :mime, "2.0.7", "b8d739037be7cd402aee1ba0306edfdef982687ee7e9859bee6198c1e7e2f128", [:mix], [], "hexpm", "6171188e399ee16023ffc5b76ce445eb6d9672e2e241d2df6050f3c771e80ccd"}, + "mint": {:hex, :mint, "1.9.0", "d6f534c2a3e98b2a8cc749b4796eb77e9e3af79a76f96e4c74035a827de0d318", [:mix], [{:castore, "~> 0.1.0 or ~> 1.0", [hex: :castore, repo: "hexpm", optional: true]}, {:hpax, "~> 0.1.1 or ~> 0.2.0 or ~> 1.0", [hex: :hpax, repo: "hexpm", optional: false]}], "hexpm", "007154c7d8c43916aed3c93afd1f11aebbaa9c5ff4b7ba55ebe0d17ee0296042"}, + "msgpax": {:hex, :msgpax, "2.4.0", "4647575c87cb0c43b93266438242c21f71f196cafa268f45f91498541148c15d", [:mix], [{:plug, "~> 1.0", [hex: :plug, repo: "hexpm", optional: true]}], "hexpm", "ca933891b0e7075701a17507c61642bf6e0407bb244040d5d0a58597a06369d2"}, + "nimble_options": {:hex, :nimble_options, "1.1.1", "e3a492d54d85fc3fd7c5baf411d9d2852922f66e69476317787a7b2bb000a61b", [:mix], [], "hexpm", "821b2470ca9442c4b6984882fe9bb0389371b8ddec4d45a9504f00a66f650b44"}, + "nimble_pool": {:hex, :nimble_pool, "1.1.0", "bf9c29fbdcba3564a8b800d1eeb5a3c58f36e1e11d7b7fb2e084a643f645f06b", [:mix], [], "hexpm", "af2e4e6b34197db81f7aad230c1118eac993acc0dae6bc83bac0126d4ae0813a"}, + "plug": {:hex, :plug, "1.19.2", "e4950525b22c6789dfb38a3f95d47171ba159da3fc5a33be9643b43d5e8adb98", [:mix], [{:mime, "~> 1.0 or ~> 2.0", [hex: :mime, repo: "hexpm", optional: false]}, {:plug_crypto, "~> 1.1.1 or ~> 1.2 or ~> 2.0", [hex: :plug_crypto, repo: "hexpm", optional: false]}, {:telemetry, "~> 0.4.3 or ~> 1.0", [hex: :telemetry, repo: "hexpm", optional: false]}], "hexpm", "b6fce20a56af5e60fa5dfecf3f907bb98ec981be43c79a3809a499bc3d133de0"}, + "plug_cowboy": {:hex, :plug_cowboy, "2.7.5", "261f21b67aea8162239b2d6d3b4c31efde4daa22a20d80b19c2c0f21b34b270e", [:mix], [{:cowboy, "~> 2.7", [hex: :cowboy, repo: "hexpm", optional: false]}, {:cowboy_telemetry, "~> 0.3", [hex: :cowboy_telemetry, repo: "hexpm", optional: false]}, {:plug, "~> 1.14", [hex: :plug, repo: "hexpm", optional: false]}], "hexpm", "20884bf58a90ff5a5663420f5d2c368e9e15ed1ad5e911daf0916ea3c57f77ac"}, + "plug_crypto": {:hex, :plug_crypto, "2.1.1", "19bda8184399cb24afa10be734f84a16ea0a2bc65054e23a62bb10f06bc89491", [:mix], [], "hexpm", "6470bce6ffe41c8bd497612ffde1a7e4af67f36a15eea5f921af71cf3e11247c"}, + "ranch": {:hex, :ranch, "2.2.0", "25528f82bc8d7c6152c57666ca99ec716510fe0925cb188172f41ce93117b1b0", [:make, :rebar3], [], "hexpm", "fa0b99a1780c80218a4197a59ea8d3bdae32fbff7e88527d7d8a4787eff4f8e7"}, + "req": {:hex, :req, "0.5.18", "48e6431cb4135e8a7815e745177485369a9b4a9924d5fe68ca00eb09ceaed1ef", [:mix], [{:brotli, "~> 0.3.1", [hex: :brotli, repo: "hexpm", optional: true]}, {:ezstd, "~> 1.0", [hex: :ezstd, repo: "hexpm", optional: true]}, {:finch, "~> 0.21.0 or ~> 0.22.0", [hex: :finch, repo: "hexpm", optional: false]}, {:jason, "~> 1.0", [hex: :jason, repo: "hexpm", optional: false]}, {:mime, "~> 2.0.6 or ~> 2.1", [hex: :mime, repo: "hexpm", optional: false]}, {:nimble_csv, "~> 1.0", [hex: :nimble_csv, repo: "hexpm", optional: true]}, {:plug, "~> 1.0", [hex: :plug, repo: "hexpm", optional: true]}], "hexpm", "fa03812c440a9754bf34355e0c5d4f3ed316458db62e3284b7a352ef8dc0b996"}, "sleeplocks": {:hex, :sleeplocks, "1.1.3", "96a86460cc33b435c7310dbd27ec82ca2c1f24ae38e34f8edde97f756503441a", [:rebar3], [], "hexpm", "d3b3958552e6eb16f463921e70ae7c767519ef8f5be46d7696cc1ed649421321"}, + "telemetry": {:hex, :telemetry, "1.4.2", "a0cb522801dffb1c49fe6e30561badffc7b6d0e180db1300df759faa22062855", [:rebar3], [], "hexpm", "928f6495066506077862c0d1646609eed891a4326bee3126ba54b60af61febb1"}, "typed_struct": {:hex, :typed_struct, "0.3.0", "939789e3c1dca39d7170c87f729127469d1315dcf99fee8e152bb774b17e7ff7", [:mix], [], "hexpm", "c50bd5c3a61fe4e198a8504f939be3d3c85903b382bde4865579bc23111d1b6d"}, "unsafe": {:hex, :unsafe, "1.0.2", "23c6be12f6c1605364801f4b47007c0c159497d0446ad378b5cf05f1855c0581", [:mix], [], "hexpm", "b485231683c3ab01a9cd44cb4a79f152c6f3bb87358439c6f68791b85c2df675"}, } diff --git a/test/al_test.exs b/test/al_test.exs index ba1a3cc..029ed95 100644 --- a/test/al_test.exs +++ b/test/al_test.exs @@ -9,3 +9,35 @@ end defmodule AlObjectsTest do use ExExample.ExUnit, for: Examples.ALObjects end + +defmodule ALTasksTest do + use ExExample.ExUnit, for: Examples.ALTasks +end + +defmodule ALArithmeticTest do + use ExExample.ExUnit, for: Examples.ALArithmetic +end + +defmodule ALListsTest do + use ExExample.ExUnit, for: Examples.ALLists +end + +defmodule ALBranchTest do + use ExExample.ExUnit, for: Examples.ALBranch +end + +defmodule ALGenserverTest do + use ExExample.ExUnit, for: Examples.ALGenserver +end + +defmodule ALConstraintsTest do + use ExExample.ExUnit, for: Examples.ALConstraints +end + +defmodule ALTraceTest do + use ExExample.ExUnit, for: Examples.ALTrace +end + +defmodule ALUsersTest do + use ExExample.ExUnit, for: Examples.ALUsers +end