1:- module(st_expr, [
    2    st_eval/4,         % + Expr, +Scope, +Options, -Result
    3    st_set_function/3, % +Name, +Arity, :Goal
    4    st_set_global/2    % +Name, +Value
    5]).

   13:- use_module(library(error)).   14
   15:- dynamic(user_function/3).   16
   17:- meta_predicate(st_set_function(+, +, :)).

 st_set_function(+Name, +Arity, :Goal) is det

Registers new function. Goal must have arity Arity + 1. Last argument of goal is used as the return value.

   25st_set_function(Name, Arity, Goal):-
   26    must_be(atom, Name),
   27    must_be(nonneg, Arity),
   28    must_be(nonvar, Goal),
   29    assert_function(Name, Arity, Goal).
   30
   31assert_function(Name, Arity, Goal):-
   32    (   user_function(Name, Arity, Goal)
   33    ->  true
   34    ;   assertz(user_function(Name, Arity, Goal))).
   35
   36:- dynamic(global/2).

 st_set_global(+Name, +Value) is det

Sets the global value. Value must be ground. Overwrites the existing global with the same name.

   44st_set_global(Name, Value):-
   45    must_be(atom, Name),
   46    must_be(ground, Value),
   47    retractall(global(Name, _)),
   48    assertz(global(Name, Value)).
   49
   50% Strings.
   51
   52st_eval(String, _, _, String):-
   53    string(String), !.
   54
   55% Numbers.
   56
   57st_eval(Number, _, _, Number):-
   58    number(Number), !.
   59
   60% Variables.
   61
   62st_eval(Name, Scope, Options, Value):-
   63    atom(Name), !,
   64    (   get_dict(Name, Scope, Value)
   65    ->  true
   66    ;   (   global(Name, Value)
   67        ->  true
   68        ;   option(undefined(Undefined), Options, error),
   69            (   Undefined = false
   70            ->  Value = false
   71            ;   throw(error(no_entry(Name)))))).
   72
   73% Boolean negation.
   74
   75st_eval(\+(Cond), Scope, Options, Value):- !,
   76    st_eval_bool(Cond, Scope, Options, Bool),
   77    bool_neg(Bool, Value).
   78
   79% Less-than.
   80
   81st_eval(Left < Right, Scope, Options, Value):- !,
   82    st_eval(Left, Scope, Options, LeftValue),
   83    st_eval(Right, Scope, Options, RightValue),
   84    (   LeftValue < RightValue
   85    ->  Value = 1
   86    ;   Value = 0).
   87
   88% Greater-than.
   89
   90st_eval(Left > Right, Scope, Options, Value):- !,
   91    st_eval(Left, Scope, Options, LeftValue),
   92    st_eval(Right, Scope, Options, RightValue),
   93    (   LeftValue > RightValue
   94    ->  Value = 1
   95    ;   Value = 0).
   96
   97% Equality.
   98
   99st_eval(Left = Right, Scope, Options, Value):- !,
  100    st_eval(Left, Scope, Options, LeftValue),
  101    st_eval(Right, Scope, Options, RightValue),
  102    (   test_equality(LeftValue, RightValue)
  103    ->  Value = 1
  104    ;   Value = 0).
  105
  106% Inequality.
  107
  108st_eval(Left \= Right, Scope, Options, Value):- !,
  109    st_eval(Left, Scope, Options, LeftValue),
  110    st_eval(Right, Scope, Options, RightValue),
  111    (   test_equality(LeftValue, RightValue)
  112    ->  Value = 0
  113    ;   Value = 1).
  114
  115% Less-than-equal.
  116
  117st_eval(Left =< Right, Scope, Options, Value):- !,
  118    st_eval(Left, Scope, Options, LeftValue),
  119    st_eval(Right, Scope, Options, RightValue),
  120    (   LeftValue =< RightValue
  121    ->  Value = 1
  122    ;   Value = 0).
  123
  124% Greater-than-equal.
  125
  126st_eval(Left >= Right, Scope, Options, Value):- !,
  127    st_eval(Left, Scope, Options, LeftValue),
  128    st_eval(Right, Scope, Options, RightValue),
  129    (   LeftValue >= RightValue
  130    ->  Value = 1
  131    ;   Value = 0).
  132
  133% Logical and.
  134
  135st_eval(','(Left, Right), Scope, Options, Value):- !,
  136    st_eval_bool(Left, Scope, Options, LeftValue),
  137    (   LeftValue = 0
  138    ->  Value = 0
  139    ;   st_eval_bool(Right, Scope, Options, RightValue),
  140        (   RightValue = 0
  141        ->  Value = 0
  142        ;   Value = 1)).
  143
  144% Logical or.
  145
  146st_eval(';'(Left, Right), Scope, Options, Value):- !,
  147    st_eval_bool(Left, Scope, Options, LeftValue),
  148    (   LeftValue = 1
  149    ->  Value = 1
  150    ;   st_eval_bool(Right, Scope, Options, RightValue),
  151        (   RightValue = 1
  152        ->  Value = 1
  153        ;   Value = 0)).
  154
  155% Unary minus.
  156
  157st_eval(-(Expr), Scope, Options, Value):- !,
  158    st_eval(Expr, Scope, Options, ExprValue),
  159    Value is -ExprValue.
  160
  161% Unary plus.
  162
  163st_eval(+(Expr), Scope, Options, Value):- !,
  164    st_eval(Expr, Scope, Options, ExprValue),
  165    Value is ExprValue.
  166
  167% Scope get.
  168
  169st_eval(Term, Scope, Options, Value):-
  170    Term =.. ['.', Base, Name], !,
  171    st_eval(Base, Scope, Options, Tmp),
  172    '.'(Tmp, Name, Value).
  173
  174% Addition. String concatenation.
  175
  176st_eval(Left + Right, Scope, Options, Value):- !,
  177    st_eval(Left, Scope, Options, LeftValue),
  178    st_eval(Right, Scope, Options, RightValue),
  179    (   number(LeftValue)
  180    ->  Value is LeftValue + RightValue
  181    ;   string_concat(LeftValue, RightValue, Value)).
  182
  183% Substraction.
  184
  185st_eval(Left - Right, Scope, Options, Value):- !,
  186    st_eval(Left, Scope, Options, LeftValue),
  187    st_eval(Right, Scope, Options, RightValue),
  188    Value is LeftValue - RightValue.
  189
  190% Multiplication.
  191
  192st_eval(Left * Right, Scope, Options, Value):- !,
  193    st_eval(Left, Scope, Options, LeftValue),
  194    st_eval(Right, Scope, Options, RightValue),
  195    Value is LeftValue * RightValue.
  196
  197% Division.
  198
  199st_eval(Left / Right, Scope, Options, Value):- !,
  200    st_eval(Left, Scope, Options, LeftValue),
  201    st_eval(Right, Scope, Options, RightValue),
  202    Value is LeftValue / RightValue.
  203
  204% Modulo.
  205
  206st_eval(Left mod Right, Scope, Options, Value):- !,
  207    st_eval(Left, Scope, Options, LeftValue),
  208    st_eval(Right, Scope, Options, RightValue),
  209    Value is LeftValue mod RightValue.
  210
  211% Reminder.
  212
  213st_eval(Left rem Right, Scope, Options, Value):- !,
  214    st_eval(Left, Scope, Options, LeftValue),
  215    st_eval(Right, Scope, Options, RightValue),
  216    Value is LeftValue rem RightValue.
  217
  218% Integer division.
  219
  220st_eval(Left // Right, Scope, Options, Value):- !,
  221    st_eval(Left, Scope, Options, LeftValue),
  222    st_eval(Right, Scope, Options, RightValue),
  223    Value is LeftValue // RightValue.
  224
  225% Integer division (variant 2).
  226
  227st_eval(Left div Right, Scope, Options, Value):- !,
  228    st_eval(Left, Scope, Options, LeftValue),
  229    st_eval(Right, Scope, Options, RightValue),
  230    Value is LeftValue div RightValue.
  231
  232% Absolute value.
  233
  234st_eval(abs(Expr), Scope, Options, Abs):- !,
  235    st_eval(Expr, Scope, Options, Value),
  236    Abs is abs(Value).
  237
  238% Sign.
  239
  240st_eval(sign(Expr), Scope, Options, Sign):- !,
  241    st_eval(Expr, Scope, Options, Value),
  242    Sign is sign(Value).
  243
  244% Max.
  245
  246st_eval(max(Left, Right), Scope, Options, Value):- !,
  247    st_eval(Left, Scope, Options, LeftValue),
  248    st_eval(Right, Scope, Options, RightValue),
  249    Value is max(LeftValue, RightValue).
  250
  251% Min.
  252
  253st_eval(min(Left, Right), Scope, Options, Value):- !,
  254    st_eval(Left, Scope, Options, LeftValue),
  255    st_eval(Right, Scope, Options, RightValue),
  256    Value is min(LeftValue, RightValue).
  257
  258% Random.
  259
  260st_eval(random(Expr), Scope, Options, Sign):- !,
  261    st_eval(Expr, Scope, Options, Value),
  262    Sign is random(Value).
  263
  264% Round.
  265
  266st_eval(round(Expr), Scope, Options, Sign):- !,
  267    st_eval(Expr, Scope, Options, Value),
  268    Sign is round(Value).
  269
  270% Truncate.
  271
  272st_eval(truncate(Expr), Scope, Options, Sign):- !,
  273    st_eval(Expr, Scope, Options, Value),
  274    Sign is truncate(Value).
  275
  276% Floor.
  277
  278st_eval(floor(Expr), Scope, Options, Sign):- !,
  279    st_eval(Expr, Scope, Options, Value),
  280    Sign is floor(Value).
  281
  282% Ceiling.
  283
  284st_eval(ceiling(Expr), Scope, Options, Sign):- !,
  285    st_eval(Expr, Scope, Options, Value),
  286    Sign is ceiling(Value).
  287
  288% Power.
  289
  290st_eval(Left ** Right, Scope, Options, Value):- !,
  291    st_eval(Left, Scope, Options, LeftValue),
  292    st_eval(Right, Scope, Options, RightValue),
  293    Value is LeftValue ** RightValue.
  294
  295% Power, alternative.
  296
  297st_eval(Left ^ Right, Scope, Options, Value):- !,
  298    st_eval(Left, Scope, Options, LeftValue),
  299    st_eval(Right, Scope, Options, RightValue),
  300    Value is LeftValue ^ RightValue.
  301
  302% Conditional expressions.
  303
  304st_eval(if(Cond, True, False), Scope, Options, Value):- !,
  305    st_eval_bool(Cond, Scope, Options, CondValue),
  306    (   CondValue = 0
  307    ->  st_eval(False, Scope, Options, Value)
  308    ;   st_eval(True, Scope, Options, Value)).
  309
  310% "Literal" atom.
  311
  312st_eval(atom(Atom), _, _, Atom):-
  313    atom(Atom), !.
  314
  315% List literal
  316
  317st_eval(List, Scope, Options, Value):-
  318    is_list(List), !,
  319    st_eval_list(List, Scope, Options, Value).
  320
  321% Function calls.
  322
  323st_eval(Compound, Scope, Options, Value):-
  324    compound(Compound), !,
  325    function_call(Compound, Scope, Options, Value).
  326
  327st_eval_bool(Expr, Scope, Options, Bool):-
  328    st_eval(Expr, Scope, Options, Value),
  329    (   (Value = 0 ; Value = false)
  330    ->  Bool = 0
  331    ;   Bool = 1).
  332
  333bool_neg(1, 0).
  334bool_neg(0, 1).
  335
  336% Evaluates list of expressions.
  337
  338st_eval_list([Expr|Exprs], Scope, Options, [Value|Values]):-
  339    st_eval(Expr, Scope, Options, Value),
  340    st_eval_list(Exprs, Scope, Options, Values).
  341
  342st_eval_list([], _, _, []).
  343
  344% Performs coercion from atom to
  345% string when necessary.
  346
  347test_equality(Value1, Value2):-
  348    (   string(Value1)
  349    ->  (   string(Value2)
  350        ->  Value1 = Value2
  351        ;   test_equality_string(Value1, Value2))
  352    ;   (   string(Value2)
  353        ->  test_equality_string(Value2, Value1)
  354        ;   Value1 = Value2)).
  355
  356test_equality_string(String, Value):-
  357    (   string(Value)
  358    ->  String = Value
  359    ;   atom(Value),
  360        atom_string(Value, TestString),
  361        String = TestString).
  362
  363function_call(Fun, Scope, Options, Value):-
  364    Fun =.. [Name|Args],
  365    length(Args, Arity),
  366    (   user_function(Name, Arity, Goal)
  367    ->  st_eval_list(Args, Scope, Options, Vals),
  368        append(Vals, [Value], GoalArgs),
  369        (   apply(Goal, GoalArgs)
  370        ->  true
  371        ;   throw(error(function_call_failed(GoalArgs))))
  372    ;   throw(error(no_function(Name/Arity))))