toplevel.pl 2.52 KB
Newer Older
Thierry Martinez's avatar
Thierry Martinez committed
1
2
3
:- module(
  toplevel,
  [
Thierry Martinez's avatar
Thierry Martinez committed
4
    execute_command/1,
Thierry Martinez's avatar
Thierry Martinez committed
5
    toplevel/0,
Thierry Martinez's avatar
Thierry Martinez committed
6
7
    quit/0,
    command/1
Thierry Martinez's avatar
Thierry Martinez committed
8
9
  ]).

Thierry Martinez's avatar
Thierry Martinez committed
10

Thierry Martinez's avatar
Thierry Martinez committed
11
12
13
14
15
16
17
18
toplevel :-
  loop.


loop :-
  repeat,
  \+ read_execute_print.

Thierry Martinez's avatar
Thierry Martinez committed
19

Thierry Martinez's avatar
Thierry Martinez committed
20
21
read_execute_print :-
  read_command(Command),
Thierry Martinez's avatar
Thierry Martinez committed
22
23
24
25
26
27
28
29
30
  (
    Command = end_of_file
  ->
    nl,
    quit
  ;
    execute_command(Command)
  ).

Thierry Martinez's avatar
Thierry Martinez committed
31
32
33

:- dynamic(prompt/1).

Thierry Martinez's avatar
Thierry Martinez committed
34

Thierry Martinez's avatar
Thierry Martinez committed
35
36
prompt('biocham: ').

Thierry Martinez's avatar
Thierry Martinez committed
37

Thierry Martinez's avatar
Thierry Martinez committed
38
39
40
41
set_prompt(NewPrompt) :-
  retract(prompt(_OldPrompt)),
  asserta(prompt(NewPrompt)).

Thierry Martinez's avatar
Thierry Martinez committed
42

Thierry Martinez's avatar
Thierry Martinez committed
43
44
read_command(Command) :-
  prompt(Prompt),
Thierry Martinez's avatar
Thierry Martinez committed
45
46
  read_history('', '', [], Prompt, Command, VariableNames),
  name_variables_and_anonymous(Command, VariableNames).
Thierry Martinez's avatar
Thierry Martinez committed
47

Thierry Martinez's avatar
Thierry Martinez committed
48
49
50
51
52
53
54
55
56
57
58
59
60
61

execute_command(Command) :-
  catch(
    (
      command(Command)
    ->
      true
    ;
      throw(error(prolog_failure))
    ),
    Exception,
    print_exception(Exception)
  ).

Thierry Martinez's avatar
Thierry Martinez committed
62

Thierry Martinez's avatar
Thierry Martinez committed
63
64
print_exception(Exception) :-
  (
Thierry Martinez's avatar
Thierry Martinez committed
65
66
    Exception = error(Error),
    error_message(Error, Message)
Thierry Martinez's avatar
Thierry Martinez committed
67
68
69
70
71
72
  ->
    format('~w\n', Message)
  ;
    format('Uncaught exception: ~p\n', Exception)
  ).

Thierry Martinez's avatar
Thierry Martinez committed
73

Thierry Martinez's avatar
Thierry Martinez committed
74
75
76
error_message(unknown_command(Command), Message) :-
  format(atom(Message), 'Unknown command: ~p', [Command]).

Thierry Martinez's avatar
Thierry Martinez committed
77

Thierry Martinez's avatar
Thierry Martinez committed
78
error_message(prolog_failure, Message) :-
Thierry Martinez's avatar
Thierry Martinez committed
79
80
  format(atom(Message), 'Prolog failure', []).

Thierry Martinez's avatar
Thierry Martinez committed
81

Thierry Martinez's avatar
Thierry Martinez committed
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
check_types(Command, ArgumentTypes, NewCommand) :-
  Command =.. [Functor | Arguments],
  findall(
    NewArgument,
    (
      nth0(Index, Arguments, Argument),
      nth0(Index, ArgumentTypes, ArgumentType),
      (
        var(ArgumentType)
      ->
        NewArgument = Argument
      ;
        catch(
          (
            check_type(ArgumentType, Argument, NewArgument)
          ->
            true
          ;
            throw(error(failure))
          ),
          error(Type),
          throw(error(invalid_type(Argument, Type)))
        )
      )
    ),
    NewArguments
  ),
  NewCommand =.. [Functor | NewArguments].


Thierry Martinez's avatar
Thierry Martinez committed
112
command(Command) :-
Thierry Martinez's avatar
Thierry Martinez committed
113
  functor(Command, Functor, Arity),
Thierry Martinez's avatar
Thierry Martinez committed
114
  (
Thierry Martinez's avatar
Thierry Martinez committed
115
116
117
118
119
    (
      predicate_info(Functor/Arity, ArgumentTypes, yes, _)
    ->
      Command0 = Command
    ;
Thierry Martinez's avatar
Thierry Martinez committed
120
121
      between(1, Arity, Arity0),
      predicate_info(Functor/Arity0, ArgumentTypes, variantargs, _)
Thierry Martinez's avatar
Thierry Martinez committed
122
123
    ->
      Command =.. [Functor | Arguments],
Thierry Martinez's avatar
Thierry Martinez committed
124
125
126
127
128
      PrefixLength is Arity0 - 1,
      length(Prefix, PrefixLength),
      append(Prefix, Tail, Arguments),
      append(Prefix, [Tail], NewArguments),
      Command0 =.. [Functor | NewArguments]
Thierry Martinez's avatar
Thierry Martinez committed
129
    )
Thierry Martinez's avatar
Thierry Martinez committed
130
  ->
Thierry Martinez's avatar
Thierry Martinez committed
131
    check_types(Command0, ArgumentTypes, NewCommand),
Thierry Martinez's avatar
Thierry Martinez committed
132
    NewCommand
Thierry Martinez's avatar
Thierry Martinez committed
133
  ;
Thierry Martinez's avatar
Thierry Martinez committed
134
135
136
137
138
    rule(Command)
  ->
    add_rule(Command)
  ;
    throw(error(unknown_command(Functor/Arity)))
Thierry Martinez's avatar
Thierry Martinez committed
139
140
  ).

Thierry Martinez's avatar
Thierry Martinez committed
141

Thierry Martinez's avatar
Thierry Martinez committed
142
143
quit :-
  biocham_command,
Thierry Martinez's avatar
Thierry Martinez committed
144
  doc('quits the interpreter.'),
Thierry Martinez's avatar
Thierry Martinez committed
145
  halt.