builtin_lisp_functions.pl

   1 /*******************************************************************
   2  *
   3  * A Lisp compiler, written in Prolog
   4  *
   5  * (builtin_lisp_functions.pl)
   6  *
   7  * (c) Neil Smith, 2001
   8  *
   9  * This program provides some built-in functionality for the
  10  * Lisp compiler.  It requires that the file lisp_compiler.pl has
  11  * already been successfully compiled.
  12  *
  13  *******************************************************************/
  14
  15
  16
  17 :- ensure_loaded(library(writef)).
  18 :- use_module(library(lists)).
  19
  20
  21 first(List, Result):-
  22         once((  List = [Result|_]
  23             ;   lisp_error_description(first_not_cons, ErrMsg),
  24                         throw(error(first_not_cons(List), context(first, ErrMsg))) )).
  25
  26 rest(List, Result):-
  27         once((  List = [_|Result]
  28             ;   lisp_error_description(rest_not_cons, ErrMsg),
  29                         throw(error(first_not_cons(List), context(first, ErrMsg)))      )).
  30
  31 cons(Item, List, Result):-
  32         Result = [Item|List].
  33
  34 null(Item, Result):-
  35                 Item = []
  36         ->      Result = t
  37         ;       Result = [].
  38
  39 eq(Item1, Item2, Result):-
  40                 Item1 == Item2
  41         ->      Result = t
  42         ;       Result = [].
  43
  44 equalp(Item1, Item2, Result):-
  45                 Item1 = Item2
  46         ->      Result = t
  47         ;       Result = [].
  48
  49
  50 plus(Num1, Num2, Result):-
  51         Result is Num1 + Num2.
  52 minus(Num1, Num2, Result):-
  53         Result is Num1 - Num2.
  54 times(Num1, Num2, Result):-
  55         Result is Num1 * Num2.
  56 divide(Num1, Num2, Result):-
  57         Result is Num1 / Num2.
  58
  59
  60 lisp_not(Boolean, Result):-
  61                 Boolean = []
  62         ->      Result = t
  63         ;       Result = [].
  64
  65 or(Bool1, Bool2, Result):-
  66                 once(Bool1 \= [] ; Bool2 \= [])
  67         ->      Result = t
  68         ;       Result = [].
  69
  70 and(Bool1, Bool2, Result):-
  71                 (Bool1 \= [] , Bool2 \= [])
  72         ->      Result = t
  73         ;       Result = [].
  74
  75
  76 lisp_apply(FunctionObject, Arguments, Result):-
  77                 % FunctionObject = closure(FormalArgs, Body, Environment)
  78                 FunctionObject = closure(FormalArgs, Body, ClosureEnvironment, Environment)
  79         ->      % zip_with(FormalArgs, Arguments, [Arg, Val, binding(Arg, [Val|_])]^true, Bindings),
  80                 maplist(make_binding, FormalArgs, Arguments, Bindings),
  81                 append(ClosureEnvironment, Environment, ActualEnvironment),
  82                 % apply(Body, [[Bindings|Environment], Result])
  83                 apply(Body, [[Bindings|ActualEnvironment], Result])
  84         ;       FunctionObject = function(FunctionName),
  85                 append(Arguments, [Result], ArgumentsResult),
  86                 Function =.. [FunctionName|ArgumentsResult],
  87                 call(Function).
  88
  89
  90 extract_variable_value([Val|Vals], FoundVal, Hole):-
  91                 var(Vals)
  92         ->      FoundVal = Val,
  93                 Hole = Vals
  94         ;       extract_variable_value(Vals, FoundVal, Hole).
  95
  96
  97 lisp_call(Function, Result):-
  98         apply(Function, [Result]).
  99
 100
 101
 102 /*
 103 show_special:-
 104                 setof(sv(Var, Value), special_var(Var, Value), SVs)
 105         ->      format('Variable ~tValue~n~n'),
 106                 maplist((sv(Var2, Value2), format('~w :~t~w~n', [Var2, Value2])), SVs)
 107         ;       format('No special variables~n').
 108 */
 109
 110 show_special:-
 111         setof(sv(Var, Value), special_var(Var, Value), SVs),
 112         !,
 113         format('Variable ~tValue~20|~n~n'),
 114         % maplist((sv(Var2, Value2), format('~w :~t~w~n', [Var2, Value2])), SVs).
 115         maplist(show_one_special, SVs).
 116 show_special:-
 117         format('No special variables~n').
 118
 119 show_one_special(sv(Var, Value)):-
 120         format('~w :~t~w~20|~n', [Var, Value]).