Index: README.md ================================================================== --- README.md +++ README.md @@ -25,10 +25,12 @@ - `Pools`: task-safe pool of referencesjj - `S-expressions`: library for dealing with [S-expressions][1] - `Atom_Buffers`: dynamic buffer for S-expression atoms - `Atom_Ref_Constructors`: helper constructors for atom references - `Atom_Refs`: common reference-counted atoms + - `Conditionals`: S-expression boolean expressions about some object + - `Generic_Evaluate`: Generic boolean expression evaluation framework - `Dynamic_Interpreters`: S-expression interpreter with mutable commands and callbacks - `Encodings`: translators to and from official S-expression encodings - `File_Readers`: objects reading a file to an atom or a S-expression - `File_Writers`: file-backed S-expression printer ADDED src/natools-s_expressions-conditionals-generic_evaluate.adb Index: src/natools-s_expressions-conditionals-generic_evaluate.adb ================================================================== --- src/natools-s_expressions-conditionals-generic_evaluate.adb +++ src/natools-s_expressions-conditionals-generic_evaluate.adb @@ -0,0 +1,169 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2015, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Natools.S_Expressions.Interpreter_Loop; + +function Natools.S_Expressions.Conditionals.Generic_Evaluate + (Context : in Context_Type; + Expression : in out Lockable.Descriptor'Class) + return Boolean +is + type State_Type is record + Result : Boolean; + Conjunction : Boolean; + end record; + + + procedure Evaluate_Element + (State : in out State_Type; + Context : in Context_Type; + Name : in Atom); + -- Evaluate a name as part of an "and" or "or" operation + + procedure Evaluate_Element + (State : in out State_Type; + Context : in Context_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class); + -- Evaluate a name as part of an "and" or "or" operation + + function Internal_Evaluate + (Context : in Context_Type; + Name : in Atom) + return Boolean; + -- Evaluate a boolean name or a context name + + function Internal_Evaluate + (Context : in Context_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) + return Boolean; + -- Evaluate a boolean function or a context function + + + procedure Run is new Natools.S_Expressions.Interpreter_Loop + (State_Type, Context_Type, Evaluate_Element, Evaluate_Element); + + + ------------------------------ + -- Local Helper Subprograms -- + ------------------------------ + + procedure Evaluate_Element + (State : in out State_Type; + Context : in Context_Type; + Name : in Atom) is + begin + if State.Result = State.Conjunction then + State.Result := Internal_Evaluate (Context, Name); + end if; + end Evaluate_Element; + + + procedure Evaluate_Element + (State : in out State_Type; + Context : in Context_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) is + begin + if State.Result = State.Conjunction then + State.Result := Internal_Evaluate (Context, Name, Arguments); + end if; + end Evaluate_Element; + + + function Internal_Evaluate + (Context : in Context_Type; + Name : in Atom) + return Boolean + is + S_Name : constant String := To_String (Name); + begin + if S_Name = "true" then + return True; + elsif S_Name = "false" then + return False; + else + return Simple_Evaluate (Context, Name); + end if; + end Internal_Evaluate; + + + function Internal_Evaluate + (Context : in Context_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) + return Boolean + is + State : State_Type; + S_Name : constant String := To_String (Name); + begin + if S_Name = "and" then + State := (True, True); + Run (Arguments, State, Context); + return State.Result; + + elsif S_Name = "or" then + State := (False, False); + Run (Arguments, State, Context); + return State.Result; + + elsif S_Name = "not" then + return not Generic_Evaluate (Context, Arguments); + + else + return Parametric_Evaluate (Context, Name, Arguments); + end if; + end Internal_Evaluate; + + + ------------------- + -- Function Body -- + ------------------- + + Event : Events.Event; + Lock : Lockable.Lock_State; + Result : Boolean; +begin + case Expression.Current_Event is + when Events.Add_Atom => + Result := Internal_Evaluate (Context, Expression.Current_Atom); + + when Events.Open_List => + Expression.Lock (Lock); + begin + Expression.Next (Event); + if Event = Events.Add_Atom then + declare + Name : constant Atom := Expression.Current_Atom; + begin + Expression.Next (Event); + Result := Internal_Evaluate (Context, Name, Expression); + end; + end if; + exception + when others => + Expression.Unlock (Lock, False); + raise; + end; + Expression.Unlock (Lock); + + when Events.Close_List | Events.Error | Events.End_Of_Input => + raise Constraint_Error with "Conditional on empty expression"; + end case; + + return Result; +end Natools.S_Expressions.Conditionals.Generic_Evaluate; ADDED src/natools-s_expressions-conditionals-generic_evaluate.ads Index: src/natools-s_expressions-conditionals-generic_evaluate.ads ================================================================== --- src/natools-s_expressions-conditionals-generic_evaluate.ads +++ src/natools-s_expressions-conditionals-generic_evaluate.ads @@ -0,0 +1,47 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2015, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.S_Expressions.Conditionals.Generic_Evaluate provides an -- +-- evaluation function based on elementary names and functions, allowing -- +-- boolean combination of them. -- +-- For example Simple_Evaluate might evaluate the word "is_empty", while -- +-- Parameteric_Evaluate might check "contains", then Generic_Evaluate -- +-- handles expressions like: -- +-- (or is-empty (contains part_1) (and (not is-empty) (contains part_2))) -- +------------------------------------------------------------------------------ + +with Natools.S_Expressions.Lockable; + +generic + type Context_Type (<>) is limited private; + + with function Parametric_Evaluate + (Context : in Context_Type; + Name : in Natools.S_Expressions.Atom; + Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class) + return Boolean; + + with function Simple_Evaluate + (Context : in Context_Type; + Name : in Natools.S_Expressions.Atom) + return Boolean; + +function Natools.S_Expressions.Conditionals.Generic_Evaluate + (Context : in Context_Type; + Expression : in out Lockable.Descriptor'Class) + return Boolean; +pragma Pure (Natools.S_Expressions.Conditionals.Generic_Evaluate); ADDED src/natools-s_expressions-conditionals.ads Index: src/natools-s_expressions-conditionals.ads ================================================================== --- src/natools-s_expressions-conditionals.ads +++ src/natools-s_expressions-conditionals.ads @@ -0,0 +1,25 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2015, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.S_Expressions.Conditionals is a common parent for all -- +-- conditional packages. -- +------------------------------------------------------------------------------ + +package Natools.S_Expressions.Conditionals is + pragma Pure; + +end Natools.S_Expressions.Conditionals;