[SCM] applications.git branch, master, updated. 67fed2b0c4845f7e36dc8dfae2b8d5c2ce74d530
ontologiae
ontologiae at ordinateur-de-ontologiae-3.local
Thu Apr 8 11:41:15 UTC 2010
The following commit has been merged in the master branch:
commit 67fed2b0c4845f7e36dc8dfae2b8d5c2ce74d530
Author: ontologiae <ontologiae at ordinateur-de-ontologiae-3.local>
Date: Thu Apr 8 13:40:56 2010 +0200
Damien's prolog
diff --git a/prolog/any.li b/prolog/any.li
new file mode 100644
index 0000000..1be7e7a
--- /dev/null
+++ b/prolog/any.li
@@ -0,0 +1,106 @@
+
+Section Header
+
+ + name := ANY;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+
+ - parent_env:ENVIRONMENT := CONSOLE; // default
+
+Section Public
+
+ - set_environment env:ENVIRONMENT <- (parent_env := env;);
+
+ //
+ // global constants
+ //
+
+ - max_binary_op_level:INTEGER := 3;
+ - max_op_level:INTEGER := 4;
+
+
+ //
+ // global prolog environment
+ //
+
+ - debug_mode:BOOLEAN;
+
+ - current_context:CONTEXT <- CONTEXT.top;
+
+ - main_query:QUERY;
+ - current_query:QUERY;
+
+ - predicates:HASHED_DICTIONARY(RULE,ABSTRACT_STRING);
+
+ - builtins:HASHED_DICTIONARY(BUILT_IN,ABSTRACT_STRING);
+
+
+ - str_tmp:STRING := STRING.create 50;
+
+
+ - add_predicate rule:RULE <-
+ (
+ + ref:RULE;
+ + predname:ABSTRACT_STRING;
+
+ rule.head.get_full_name str_tmp;
+ predname := ALIAS_PL.get str_tmp;
+
+ predicates.fast_has predname.if {
+ ref := predicates.at predname;
+ ref.add_rule rule;
+ } else {
+ predicates.add rule to predname;
+ };
+ );
+
+ - find rules:LINKED_LIST(RULE) matching pred:PRED :INTEGER <-
+ // return number of rules matching 'pred'
+ (
+ + rule:RULE;
+
+ rules.clear;
+
+ // pred.get_full_name str_tmp;
+ predicates.has str_tmp.if {
+ // predicate(s) found
+
+ rule := predicates.at str_tmp;
+ } else {
+ error ("Predicate "+str_tmp+" not found!");
+ };
+ // select only rules unifiable with pred
+ {rule = NULL}.until_do {
+ pred.is_unifiable_with (rule.head).if {
+ rules.add_last rule;
+ };
+ rule := rule.next;
+ };
+ rules.count
+ );
+
+ - consult filename:ABSTRACT_STRING :PL_FILE <-
+ (
+ + file:PL_FILE;
+ + parser:PARSER;
+
+ print_m ("\nconsulting "+filename+"...");
+ file := PL_FILE.create filename;
+ ((file != NULL) && {file.is_loaded}).if {
+ parser := PARSER.create (file.buffer);
+
+ {parser.read_rule_or_fact}.while_do {
+ print_m "\n-> ";
+ parser.last_predicate.print_value;
+
+ add_predicate (parser.last_predicate);
+ };
+ print_m "\ntrue.\n";
+ } else {
+ error "false: Can't find file";
+ };
+ file
+ );
diff --git a/prolog/context/context.li b/prolog/context/context.li
new file mode 100644
index 0000000..e557d07
--- /dev/null
+++ b/prolog/context/context.li
@@ -0,0 +1,215 @@
+
+Section Header
+
+ + name := CONTEXT;
+
+ - author := "Damien Bouvarel";
+ - comment := "Ensemble de variable evaluées, chaque contexte empilé correspond a une etape de l'execution et contient les valeurs des variables courantes";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ + vars:HASHED_DICTIONARY(VAR_VALUE,ABSTRACT_STRING);
+
+ - create r:RULE :SELF <-
+ ( + result:SELF;
+ result := SELF.clone;
+ result.make r;
+ result
+ );
+
+ - make r:RULE <-
+ (
+ rule := r;
+ vars := HASHED_DICTIONARY(VAR_VALUE,ABSTRACT_STRING).create;
+ );
+
+ - set_upper ctxt:CONTEXT <- (upper := ctxt;);
+ - set_lower ctxt:CONTEXT <- (lower := ctxt;);
+
+Section Public
+
+ + rule:RULE;
+ + is_locked:BOOLEAN; // locked <=> can't be poped from stack
+
+ + allow_backtrack:BOOLEAN;
+
+
+ + upper:CONTEXT;// next context in stack
+ + lower:CONTEXT;// previous context
+
+
+ - top:CONTEXT;
+ - bottom:CONTEXT;
+
+ - push_new r:RULE :CONTEXT <-
+ (
+ + result:CONTEXT;
+ result := create r;
+
+ (top = NULL).if {
+ bottom := top := result;
+ } else {
+ // link first
+
+ result.set_lower top;
+ top.set_upper result;
+ top := result;
+ };
+ result
+ );
+
+ - pop <-
+ (
+ ? {! top.is_locked};
+ top := top.lower;
+ top.set_upper NULL;
+ );
+
+ - set_backtrack on:BOOLEAN <-
+ (
+ allow_backtrack := on;
+ );
+
+ - lock <-
+ (
+ is_locked := TRUE;
+ );
+
+ - unlock <-
+ (
+ is_locked := FALSE;
+ );
+
+ - remove_lock <-
+ (
+ ? {is_locked};
+ upper.set_lower lower;
+ lower.set_upper upper;
+ );
+
+ - register_variable var:VAR <-
+ (
+ + val:VAR_VALUE;
+
+ ? {! is_locked};
+
+ (! vars.has (var.name)).if {
+ val := VAR_VALUE.create var;
+ vars.add val to (var.name);
+ };
+ );
+
+ - get term:TERM :TERM <-
+ (
+ + var:VAR;
+ + result:TERM;
+
+ ? {! is_locked};
+
+ var ?= term;
+ (var != NULL).if {
+ vars.has (var.name).if {
+ result := vars.at (var.name).value;
+ } else {
+ error ("Variable "+var.name+" not found in context");
+ };
+ } else {
+ result := term;
+ };
+ result
+ );
+
+ - get_value term:TERM :VAR_VALUE <-
+ ( + var:VAR;
+ + result:VAR_VALUE;
+
+ ? {! is_locked};
+
+ var ?= term;
+ (var != NULL).if {
+ vars.has (var.name).if {
+ result := vars.at (var.name);
+ };
+ };
+ result
+ );
+
+ - push_copy:CONTEXT <-
+ // heavy & slow copy / push copy on top of stack
+ (
+ + result:CONTEXT;
+
+ result := create rule;
+ vars.lower.to (vars.upper) do { i:INTEGER;
+ result.put (vars.item i.copy) to (vars.key i);
+ };
+ // push new context
+ top := result;
+ result.set_lower Self;
+ upper := result;
+
+ result
+ );
+
+ - print_solution <-
+ // print_m current solution
+ ( + solution:TERM;
+
+ vars.lower.to (vars.upper) do { i:INTEGER;
+ ((vars.item i.bind != NULL) && {upper != NULL}).if {
+ solution := vars.item i.bind.get_solution upper;
+ } else {
+ solution := vars.item i;
+ };
+ print_m "\n - ";
+ vars.key i.print;
+ print_m " = ";
+ solution.print_value;
+ };
+ );
+
+ - display <-
+ (
+ print_m "\n=== CONTEXT ";
+ (rule != NULL).if {
+ rule.head.print_value;
+ };
+ is_locked.if {
+ print_m " <locked>";
+ };
+ allow_backtrack.if {
+ print_m " <backtrack>";
+ };
+ print_m " ===\n";
+ vars.lower.to (vars.upper) do { i:INTEGER;
+ print_m "\n- ";
+ vars.key i.print;
+ print_m " = ";
+ vars.item i.print_value;
+ };
+ print_m "\n===============\n";
+ );
+
+ - display_all <-
+ (
+ + context:CONTEXT;
+
+ "\n**** TOP *****".print;
+ context := top;
+ {context = NULL}.until_do {
+ context.display;
+ context := context.lower;
+ };
+ "\n**** BOTTOM *****".print;
+ );
+
+Section CONTEXT
+
+ - put val:VAR_VALUE to key:ABSTRACT_STRING <-
+ (
+ vars.add val to key;
+ );
\ No newline at end of file
diff --git a/prolog/context/var_value.li b/prolog/context/var_value.li
new file mode 100644
index 0000000..a52ea7e
--- /dev/null
+++ b/prolog/context/var_value.li
@@ -0,0 +1,63 @@
+
+Section Header
+
+ + name := VAR_VALUE;
+ - export := TERM;
+
+ - author := "Damien Bouvarel";
+ - comment := "Variable value";
+
+Section Inherit
+
+ - parent_object:OBJECT := OBJECT;
+
+Section Public
+
+ + value:TERM;
+ + bind:TERM;
+
+
+ - create val:TERM :SELF <-
+ ( + result:SELF;
+ result := SELF.clone;
+ result.make val;
+ result
+ );
+
+ - make val:TERM <-
+ (
+ value := val;
+ );
+
+ - bind_to term:TERM <-
+ (
+ bind := term;
+ // "\n==> BIND ".print; print_value; " TO ".print; val.index.print;
+ );
+
+ - copy:VAR_VALUE <-
+ (
+ + result:VAR_VALUE;
+ + val:TERM;
+
+ val := value.copy;
+ result := create val;
+ bind := val; // self is bound to its copy
+ result
+ );
+
+ - print_value <-
+ (
+ (value != NULL).if {
+ value.print_value;
+ } else {
+ "\nNo value".print;
+ };
+ );
+
+
+
+ - to_term:TERM <-
+ (
+ value
+ );
diff --git a/prolog/gui/console.li b/prolog/gui/console.li
new file mode 100644
index 0000000..3adc2cf
--- /dev/null
+++ b/prolog/gui/console.li
@@ -0,0 +1,75 @@
+
+Section Header
+
+ + name := CONSOLE;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_env:ENVIRONMENT := ENVIRONMENT;
+
+Section Private
+
+
+Section Public
+
+ - mainloop <-
+ (
+ /* + exit:BOOLEAN;
+ + query:STRING;
+ + parser:PARSER;
+
+ query := STRING.create 256;
+
+ "\n*** D at mZ' PrOloG CoMpiLeR ***\nConsole Mode\n\n".print;
+
+ {
+ query.clear;
+ "\n >> ".print;
+
+ IO.read_line_in query;
+ query.is_empty.if_false {
+ exit := (query == "quit") || {query == "bye"};
+ (!exit).if {
+
+ //parser := PARSER.create query;
+
+
+ solver.run query.if {
+ "\ntrue.".print;
+ } else {
+ "\nfalse.".print;
+ };
+ };
+ } else {
+ exit := TRUE;
+ };
+ }.do_until {exit};
+ */
+ );
+
+
+ - write msg:ABSTRACT_STRING <-
+ (
+ msg.print; // default output
+ "\n".print;
+ );
+
+ - print_m msg:ABSTRACT_STRING <-
+ (
+ msg.print;
+ );
+
+ - emit n:INTEGER <-
+ (
+ n.to_string.print;
+ );
+
+ - error msg:ABSTRACT_STRING <-
+ (
+ "\n---------------\n".print;
+ "Error: ".print; msg.print;
+ "\n---------------\n".print;
+ );
+
diff --git a/prolog/gui/environment.li b/prolog/gui/environment.li
new file mode 100644
index 0000000..9120f48
--- /dev/null
+++ b/prolog/gui/environment.li
@@ -0,0 +1,25 @@
+
+Section Header
+
+ + name := ENVIRONMENT;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_obj:OBJECT := OBJECT;
+
+Section Public
+
+ // virtual calls
+ - mainloop <- deferred;
+
+
+ - new_line <- print_m "\n";
+
+ - write msg:ABSTRACT_STRING <- deferred;
+ - print_m msg:ABSTRACT_STRING <- deferred;
+ - emit n:INTEGER <- deferred;
+
+ - error msg:ABSTRACT_STRING <- deferred;
+ - error msg:ABSTRACT_STRING type errtype:INTEGER <- deferred;
diff --git a/examples/standard/make.lip b/prolog/make.lip
similarity index 82%
copy from examples/standard/make.lip
copy to prolog/make.lip
index 7e2b4ad..dc13652 100644
--- a/examples/standard/make.lip
+++ b/prolog/make.lip
@@ -1,5 +1,5 @@
///////////////////////////////////////////////////////////////////////////////
-// Lisaac Installer //
+// Lisaac Compiler //
// //
// LSIIT - ULP - CNRS - INRIA - FRANCE //
// //
@@ -18,28 +18,44 @@
// //
// http://isaacproject.u-strasbg.fr/ //
///////////////////////////////////////////////////////////////////////////////
-
-// Lisaac Path Directory System (by Benoit Sonntag).
-
Section Inherit
-
- + parent:STRING; // by default, inherite from main `make.lip'
+
+ + parent:STRING;
Section Private
-
- - example_path <-
- // Example path.
- (
- path "*";
- );
+
+
+
+ - src_path <-
+ (
+
+ path "./";
+ path "context/";
+ path "gui/";
+ path "tools/";
+ path "tree/";
+ path "tree/base";
+ path "tree/builtins";
+ path "tree/expr";
+ );
+
+
//
// Execute function.
//
-
+
- front_end <-
(
+ src_path;
general_front_end;
- example_path;
);
-
+
+ - back_end <-
+ (
+ src_path;
+ general_back_end;
+ );
+
+Section Public
+
diff --git a/prolog/parser.li b/prolog/parser.li
new file mode 100644
index 0000000..6021cbf
--- /dev/null
+++ b/prolog/parser.li
@@ -0,0 +1,591 @@
+
+Section Header
+
+ + name := PARSER;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ + source:FAST_ARRAY(CHARACTER);
+ + position:INTEGER;
+
+ - string_tmp:STRING := STRING.create 250;
+
+Section Public
+
+ //
+ // Constructor
+ //
+
+ - create s:FAST_ARRAY(CHARACTER) :SELF <-
+ ( + result:SELF;
+ result := PARSER.clone;
+ result.make s;
+ result
+ );
+
+ - make s:FAST_ARRAY(CHARACTER) <-
+ (
+ source := s;
+ position := s.lower;
+ );
+
+ //
+ // General Parser
+ //
+
+ - last_integer:INTEGER <- last_string.to_integer;
+ - last_string:STRING;
+
+ - last_character:CHARACTER <-
+ ( + result:CHARACTER;
+ (position > source.upper).if {
+ result := 0.to_character;
+ } else {
+ result := source.item position;
+ };
+ result
+ );
+
+ - end_source:BOOLEAN <-
+ (
+ last_character = 0.to_character
+ );
+
+ - get_position:INTEGER <- position;
+ - set_position ofs:INTEGER <- (position := ofs;);
+
+Section Private
+
+ - is_new_line:BOOLEAN;
+
+ - is_space:BOOLEAN <-
+ (
+ { last_character = ' ' } || { last_character = '\n' } ||
+ { last_character = '\t' } || { last_character = '\f' } ||
+ { last_character = '\a' } || { last_character = '\r' } ||
+ { last_character = '\b' } || { last_character = '\v' }
+ );
+
+ - read_space:BOOLEAN <-
+ ( + old_pos:INTEGER;
+
+ old_pos := position;
+ { end_source || { ! is_space }}.until_do {
+ ( last_character = '\n' ).if {
+ is_new_line := TRUE;
+ };
+ position := position + 1;
+ };
+ (position < source.upper).if {
+ (last_character = '%').if {
+ {
+ position := position + 1;
+ }.do_until { end_source || { last_character = '\n' }};
+ };
+ };
+ ((position != old_pos) | (! end_source ))
+ );
+
+ - read_identifier:BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ string_tmp.clear;
+ read_space;
+
+ { (!end_source) && {last_character.is_letter || {last_character.is_digit} || {last_character = '_'}}}.while_do {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ };
+ (! string_tmp.is_empty).if {
+ last_string := string_tmp;
+ result := TRUE;
+ };
+ result
+ );
+
+ - read_operator:BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ read_space;
+ string_tmp.clear;
+
+ {(last_character = 0.to_character) ||
+ {! "!@#$%^&<|*-+=~/?\\>is:".has last_character}}.until_do {
+ string_tmp.add_last last_character;
+ position := position+1;
+ };
+ (! string_tmp.is_empty).if {
+ last_string := string_tmp;
+ result := TRUE;
+ };
+ result
+ );
+
+ - read_string:BOOLEAN <-
+ ( + result:BOOLEAN;
+
+ read_space;
+ string_tmp.clear;
+
+ (last_character = '\"').if {
+ position := position+1;
+ {end_source || {last_character = '\"'}}.until_do {
+ string_tmp.add_last last_character;
+ position := position + 1;
+ };
+ (! string_tmp.is_empty).if {
+ last_string := string_tmp;
+ result := TRUE;
+ };
+ };
+ result
+ );
+
+Section Public
+
+ //
+ // Prolog Parser - Public Part
+ //
+
+ - last_predicate:RULE;
+
+
+ //++ E <- Predicate Procedure | MainQuery E
+ - read_rule_or_fact:BOOLEAN <-
+ (
+ + pred:PRED;
+ + proc:PROCEDURE;
+ + result:BOOLEAN;
+
+ read_main_query.if {
+ result := read_rule_or_fact;
+ } else {
+ read_identifier.if {
+ pred := read_predicate; // rule head
+ (pred != NULL).if {
+ last_predicate := RULE.create pred body NULL;// hack for ITM_CUT
+ proc := read_procedure; // rule body
+ last_predicate.set_body proc;
+
+ result := TRUE;
+ };
+ };
+ };
+ result
+ );
+
+Section Private
+
+ //
+ // Internal Prolog Parser
+ //
+
+ //++ MainQuery <- '?-' Query
+ - read_main_query:BOOLEAN <-
+ (
+ + req:QUERY;
+ + result:BOOLEAN;
+
+ read_space;
+ (last_character = '?').if {
+ ((position+1 <= source.upper) && {source.item (position+1) = '-'}).if {
+ // read '?-' main query
+
+ position := position + 2; // skip ?- symbol
+ req := read_query;
+ (req != NULL).if {
+
+ (main_query = NULL).if {
+ main_query := req;
+ } else {
+ error "Warning: multiple query";
+ };
+ result := TRUE;
+ } else {
+ error "Syntax: bad request";
+ print_line;
+ };
+ } else {
+ error "Token error";
+ print_line;
+ };
+ };
+ result
+ );
+
+ //++ Procedure <- ':-' { Clause ',' } '.' | '.'
+ - read_procedure:PROCEDURE <-
+ (
+ + result:PROCEDURE;
+ + clause:TERM;
+
+ read_space;
+
+ result := PROCEDURE.create;
+ (last_character = '.').if {
+ // predicate is always true (fact)
+
+ position := position + 1;
+ }.elseif {(last_character = ':') && {source.item(position+1) = '-'}} then { // read procedure
+
+ position := position + 1; // skip ':-' symbol
+ {end_source || {last_character = '.'}}.until_do {
+ position := position + 1; // '-' | ',' | '.'
+
+ clause := read_clause;
+ result.add_child clause;
+
+ ((last_character != ',') && {last_character != '.'}).if {
+ error "Syntax: parse error";
+ print_line;
+ };
+ };
+ end_source.if {
+ error "Missing '.'";
+ print_line;
+ } else {
+ position := position+1; // skip final '.'
+ };
+ } else {
+ error "Token Error";
+ print_line;
+ };
+ result
+ );
+
+ //++ Clause <- Predicate | Expr | '!'
+ - read_clause:TERM <-
+ (
+ + result:TERM;
+ + old_pos:INTEGER;
+
+ read_space;
+ (last_character = '!').if {
+ result := ITM_CUT.create last_predicate;
+ position := position + 1;
+ } else {
+ old_pos := position;
+
+ read_identifier.if {
+ result := read_predicate;
+ };
+ ((result = NULL) || {(last_character != ',') && {last_character != '.'}}).if {
+ position := old_pos;
+
+ result := read_expression;
+ (result = NULL).if {
+ error "Syntax: Incorrect expression";
+ print_line;
+ };
+ };
+ };
+ result
+ );
+
+ //++ Request <- { Clause ',' } '.'
+ - read_query:QUERY <-
+ (
+ + result:QUERY;
+ + clause:TERM;
+
+ result := QUERY.create;
+ {
+ clause := read_clause;
+ result.add_child clause;
+
+ (last_character = ',').if {
+ position := position + 1;
+ };
+ }.do_until {end_source || {last_character = '.'}};
+
+ (last_character != '.').if {
+ error "Missing '.'";
+ print_line;
+ } else {
+ position := position+1;
+ };
+ result
+ );
+
+ //
+ // Term Parser
+ //
+
+ //++ Predicate <- atom'(' { Term ',' } ')'
+ - read_predicate:PRED <-
+ (
+ + term:TERM;
+ + result:PRED;
+
+ ((last_character = '(') && {source.item (position-1).is_alpha || {source.item (position-1).is_digit}}).if { // ambigu fix -> no space between functor & '('
+ result := PRED.create last_string;
+ {
+ position := position+1; // skip '(' or ','
+
+ term := read_term;
+ result.add_child term;
+
+ read_space;
+ }.do_while {(term != NULL) && {last_character = ','}};
+
+ (last_character = ')').if {
+ position := position+1;
+ } else {
+ error "\nSyntax: Expecting ')'";
+ print_line;
+ };
+ };
+ result
+ );
+
+ //++ Var <- ('_' | 'Maj'){ alpha | digit } | atom
+ - read_var:TERM <-
+ (
+ + result:TERM;
+ (last_string.first.is_letter).if {
+ (last_string.first.is_upper).if {
+ // variable
+ result := VAR.create last_string mute FALSE;
+ } else {
+ // Constant (0-arg predicate)
+ result := PRED.create last_string;
+ };
+ }.elseif {last_string.first = '_'} then {
+ // anonymous variable
+ result := VAR.create last_string mute TRUE;
+ };
+ result
+ );
+
+ //++ Atom <- atom | '\"' {alpha | digit | op} '\"' | number
+ - read_atom:TERM <-
+ (
+ + result:TERM;
+
+ (last_string.first.is_digit).if {
+ // Numeric Constant
+ result := NUMBER.create last_string;
+ } else {
+ (last_character = '\"').if {
+ // handle quoted strings as constants
+ read_string.if {
+ result := PRED.create last_string;
+ position := position+1;
+ };
+ };
+ };
+ result
+ );
+
+ //++ List <- '[' Term { ',' Term | '|' List | '|' Var } ']'
+ - read_list:LIST <-
+ (
+ + separator:BOOLEAN;
+ + result,list:LIST;
+ + term:TERM;
+
+ (last_character = '[').if {
+ position := position+1;// skip '['
+
+ result := LIST.create;
+ term := read_term;
+ result.add_child term;
+
+ {(term != NULL) && {(last_character = '|') || {last_character = ','}}}.while_do {
+ (last_character = '|').if {
+ separator.if {
+ error "Syntax: Only one separator allowed";
+ print_line;
+ };
+ result.last.set_separator;
+ separator := TRUE;
+
+ position := position+1; // skip '|'
+ term := read_term;
+ list ?= term;
+ (list != NULL).if {
+ result.last.set_next list;
+
+ }.elseif {term.same_dynamic_type VAR} then {
+ error "Syntax: variable-list not yet implemented";
+ print_line;
+ } else {
+ error "Syntax: Expecting list after '|' symbol";
+ print_line;
+ };
+ } else {
+ position := position+1; // skip ','
+
+ term := read_term;
+ result.add_child term;
+ };
+ read_space;
+ };
+
+ (last_character = ']').if {
+ position := position+1;
+ } else {
+ error "Syntax: Expecting ']'";
+ print_line;
+ };
+ };
+ result
+ );
+
+ //++ Term <- Predicate | Var | Atom | List
+ - read_term:TERM <-
+ (
+ + result:TERM;// ex: f(7,g(X,toto)),[77,[]])
+
+ read_identifier.if {
+ read_space;
+
+ result := read_predicate;
+ (result = NULL).if {
+ result := read_var;
+ (result = NULL).if {
+ result := read_atom;
+ };
+ };
+ } else {
+ result := read_list;
+ };
+ result
+ );
+
+
+ //
+ // Arithmetic Expression Parser
+ //
+
+ //++ Expr <- Binary
+ - read_expression:EXPR <-
+ (
+ read_expr_binary 1
+ );
+
+ //++ Binary <- Unary [operator Unary]
+ - read_expr_binary level:INTEGER :EXPR <-
+ (
+ + result,right:EXPR;
+ + op_type:EXPR_BINARY;
+ + old_pos:INTEGER;
+
+ (level <= max_binary_op_level).if {
+ result := read_expr_binary (level+1);
+
+ (result != NULL).if {
+ {
+ old_pos := position;
+ read_operator.if_false {
+ last_string.clear;// bug fix...
+ };
+
+ op_type ?= ALIAS_PL.get_operator last_string level level;
+ (op_type != NULL).if {
+
+ right := read_expr_binary (level+1);
+ (right = NULL).if {
+ error "Syntax: Incorrect expression.";
+ print_line;
+ };
+ result := op_type.create result and right;
+ } else {
+ position := old_pos;// a voir si utile
+ };
+ }.do_until {op_type = NULL};
+ };
+ } else {
+ result := read_expr_unary level;
+ };
+ result
+ );
+
+ //++ Unary <- [operator] Base
+ - read_expr_unary level:INTEGER :EXPR <-
+ (
+ + op_type:EXPR_UNARY;
+ + result:EXPR;
+ + op:CHARACTER;
+ + old_pos:INTEGER;
+
+ old_pos := position;
+ ((level <= max_op_level) && {read_operator}).if {
+ op_type ?= ALIAS_PL.get_operator last_string level level;
+ (op_type != NULL).if {
+ op := last_character;
+
+ result := read_expr_unary level;
+ (result = NULL).if {
+ error "Syntax: Incorrect expression.";
+ print_line;
+ };
+ (op != '+').if {
+ result := op_type.create result;
+ };
+ } else {
+ position := old_pos;
+ result := read_expr_unary (level+1);
+ };
+ } else {
+ result := read_expr_base;
+ };
+ result
+ );
+
+ //++ Base <- '(' Expr ')' | Term
+ - read_expr_base:EXPR <-
+ (
+ + result:EXPR;
+ + base:TERM;
+
+ (last_character = '(').if {
+ position := position+1;
+
+ result := read_expression;
+ (result = NULL).if {
+ error "Warning: Empty expression.";
+ print_line;
+ };
+ (last_character = ')').if_false {
+ error "Missing ')'.";
+ print_line;
+ };
+ position := position+1;
+ } else {
+ base := read_term;
+ (base = NULL).if {
+ error "Syntax: Incorrect expression.";
+ print_line;
+ };
+ result := EXPR_CST.create base;
+ };
+ result
+ );
+
+ - print_line <-
+ (
+ print_m " At line ";
+ emit get_line;
+ );
+
+ - get_line:INTEGER <-
+ ( + pos:INTEGER;
+ + line:INTEGER;
+ pos := source.lower;
+ line := 1;
+ {pos = position}.until_do {
+ (source.item pos = '\n').if {
+ line := line + 1;
+ };
+ pos := pos + 1;
+ };
+ line
+ );
+
\ No newline at end of file
diff --git a/prolog/prolog.li b/prolog/prolog.li
new file mode 100644
index 0000000..3d65b9a
--- /dev/null
+++ b/prolog/prolog.li
@@ -0,0 +1,119 @@
+
+Section Header
+
+ + name := PROLOG;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_object:ANY := ANY;
+
+Section Private
+
+ - input_path:STRING := STRING.create 64;
+ - output_path:STRING := STRING.create 64;
+
+Section Public
+
+ - main <-
+ (
+ ALIAS_PL.make;
+ predicates := HASHED_DICTIONARY(RULE,ABSTRACT_STRING).create;
+
+ read_options;
+
+ (! input_path.is_empty).if {
+ consult input_path;
+ };
+
+ (main_query != NULL).if {
+
+ "\n?- ".print; main_query.print_value; "\n".print;
+
+ // run prolog engine
+ main_query.execute.if {
+ "\nyes.".print;
+ } else {
+ "\nno.".print;
+ };
+ };
+ //mainloop
+ "\n".print;
+ );
+
+Section Private
+
+ - usage:STRING_CONSTANT :=
+ "\n========================\n\
+ \=== Prolog Compiler ====\n\
+ \========================\n\n\
+ \Usage: prolog -i <input> [-o <output>] [Options]\n\n\
+ \Options:\n\
+ \ -d : debugger mode active\n\
+ \ -g <gui> : <gui> is whether CONSOLE or WINDOW\n\
+ \ [default = CONSOLE]\n";
+
+ - display_usage <-
+ (
+ usage.printline;
+ die_with_code exit_success_code;
+ );
+
+ - read_options <-
+ (
+ + cmd:STRING;
+ + j:INTEGER;
+ + gui:BOOLEAN;
+
+ j := 1;
+ {j > COMMAND_LINE.upper}.until_do {
+ cmd := COMMAND_LINE.item j;
+ (cmd.item 1='-').if {
+ //
+ // Parametres:
+ //
+ (cmd.item 2 = 'i').if {
+ // lecture de l'entree
+ j := j+1;
+ (j > COMMAND_LINE.count).if {
+ display_usage;
+ };
+ input_path.copy (COMMAND_LINE.item j);
+ }.elseif {cmd.item 2 = 'o'} then {
+ // lecture du chemin de sortie
+ j := j+1;
+ (j > COMMAND_LINE.count).if {
+ display_usage;
+ };
+ output_path.copy (COMMAND_LINE.item j);
+ }.elseif {cmd.item 2 = 'g'} then {
+ j := j+1;
+ (j > COMMAND_LINE.count).if {
+ display_usage;
+ };
+ cmd := COMMAND_LINE.item j;
+ (cmd == "WINDOW").if {
+ gui := TRUE;
+ };
+ // else default: CONSOLE
+ }.elseif {cmd.item 2 = 'd'} then {
+
+ } else {
+ display_usage;
+ };
+ };
+ j := j+1;
+ };
+ gui.if_false {
+ (input_path.is_empty).if {
+ display_usage;
+ };
+ (output_path.is_empty).if {
+ output_path.copy "code.li";
+ };
+ } else {
+ // set_environment WINDOW;
+ };
+ );
+
diff --git a/prolog/test.pl b/prolog/test.pl
new file mode 100644
index 0000000..d953d69
--- /dev/null
+++ b/prolog/test.pl
@@ -0,0 +1,33 @@
+
+ultime([Y,xxx]) :- Y = [7,toto].
+
+yoyo(Y) :- Y = 1.
+
+inc(X,Y) :- Y is X + 1, ultime(W).
+
+fact(0,1) :- !.
+fact(N,R) :-
+ N2 is N - 1,
+ fact(N2,R2),
+ R is N * R2.
+
+fib(0, 1).
+fib(1, 1).
+fib(N,F):- N1 is N-1, N2 is N-2, fib(N1,F1), fib(N2,F2), F is F1+F2.
+
+diff(X,Y) :- X = Y, !, fail.
+diff(X,Y).
+
+p(X) :- a(X).
+p(X) :- b(X),c(X),!,d(X),e(X).
+p(X) :- f(X).
+a(1).
+b(1).
+b(2).
+c(1).
+c(2).
+d(2).
+e(2).
+f(3).
+
+?- inc(2,Res).
diff --git a/prolog/test2.pl b/prolog/test2.pl
new file mode 100644
index 0000000..9d3e0f9
--- /dev/null
+++ b/prolog/test2.pl
@@ -0,0 +1,8 @@
+
+
+pere(a,b).
+pere(b,c)
+grandpere(X,Z) -: pere(X,Y),pere(Y,Z).
+
+
+?- grandpere(a,O).
diff --git a/prolog/tools/alias_pl.li b/prolog/tools/alias_pl.li
new file mode 100644
index 0000000..f621cad
--- /dev/null
+++ b/prolog/tools/alias_pl.li
@@ -0,0 +1,111 @@
+
+Section Header
+
+ + name := ALIAS_PL;
+ - comment := "Alias syntaxe prolog";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ - list:HASHED_SET(ABSTRACT_STRING);
+
+ - ops:FAST_ARRAY(HASHED_DICTIONARY(EXPR,ABSTRACT_STRING));
+
+Section Public
+
+ - write_m:ABSTRACT_STRING := "write/1";
+ - fail:ABSTRACT_STRING := "fail/0";
+
+ - atom:ABSTRACT_STRING := "atom/1";
+ - var:ABSTRACT_STRING := "var/1";
+ - bip_list:ABSTRACT_STRING := "list/1";
+
+
+ - get str:ABSTRACT_STRING :ABSTRACT_STRING <-
+ ( + result:ABSTRACT_STRING;
+ + tmp:ABSTRACT_STRING;
+ ? {str != NULL};
+ ? {list != NULL};
+
+ tmp := list.reference_at str;
+ (tmp = NULL).if {
+ result := STRING_CONSTANT.create_copy str;
+ list.fast_add result;
+ } else {
+ result ?= tmp;
+ };
+ ? {result == str};
+ result
+ );
+
+ - get_operator k:ABSTRACT_STRING level lvl:INTEGER :EXPR <-
+ (
+ + oper:HASHED_DICTIONARY(EXPR,ABSTRACT_STRING);
+ + result:EXPR;
+ ? {lvl > 0};
+ ? {lvl <= max_op_level};
+
+ oper := ops.item (lvl-1);
+ oper.has k.if {
+ result := oper.at k;
+ };
+ result
+ );
+
+ - make <-
+ (
+ + oper:HASHED_DICTIONARY(EXPR,ABSTRACT_STRING);
+
+ list := HASHED_SET(ABSTRACT_STRING).create;
+ ops := FAST_ARRAY(HASHED_DICTIONARY(EXPR,ABSTRACT_STRING)).create max_op_level;
+
+ //
+ // Prolog operators
+ //
+
+ // level 1
+ oper := HASHED_DICTIONARY(EXPR,ABSTRACT_STRING).create;
+ oper.add EXPR_UNIFY to "=";
+ oper.add EXPR_EVAL to "is";
+ oper.add EXPR_NOT_UNIFY to "/=";
+ oper.add EXPR_EQUAL to "=:=";
+ oper.add EXPR_NOT_EQUAL to "=/=";
+ oper.add EXPR_INF_STRICT to "<";
+ oper.add EXPR_INF to "=<";
+ oper.add EXPR_SUP_STRICT to ">";
+ oper.add EXPR_SUP to ">=";
+ ops.put oper to 0;
+
+ // level 2
+ oper := HASHED_DICTIONARY(EXPR,ABSTRACT_STRING).create;
+ oper.add EXPR_ADD to "+";
+ oper.add EXPR_SUB to "-";
+ ops.put oper to 1;
+
+ // level 3
+ oper := HASHED_DICTIONARY(EXPR,ABSTRACT_STRING).create;
+ oper.add EXPR_MUL to "*";
+ oper.add EXPR_DIV to "/";
+ ops.put oper to 2;
+
+ // level 4
+ oper := HASHED_DICTIONARY(EXPR,ABSTRACT_STRING).create;
+ oper.add EXPR_NEG to "-";
+ ops.put oper to 3;
+
+ //
+ // Built-in predicates
+ //
+
+ builtins := HASHED_DICTIONARY(BUILT_IN,ABSTRACT_STRING).create;
+
+ builtins.add BIP_WRITE to write_m;
+ builtins.add BIP_FAIL to fail;
+
+ builtins.add BIP_ATOM to atom;
+ builtins.add BIP_VAR to var;
+ builtins.add BIP_LIST to bip_list;
+ );
diff --git a/prolog/tools/pl_file.li b/prolog/tools/pl_file.li
new file mode 100644
index 0000000..9db750f
--- /dev/null
+++ b/prolog/tools/pl_file.li
@@ -0,0 +1,80 @@
+
+Section Header
+
+ + name := PL_FILE;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ + buffer:FAST_ARRAY(CHARACTER);
+ + cursor:INTEGER;
+
+ + is_loaded:BOOLEAN;
+
+ + filename:STRING;
+
+
+ - create str:ABSTRACT_STRING :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make str;
+ result
+ );
+
+ - make str:ABSTRACT_STRING <-
+ (
+ filename := STRING.create_from_string str;
+
+ load_file;
+ );
+
+
+ - end_of_file:BOOLEAN <- cursor >= buffer.upper;
+
+ - get_char:CHARACTER <-
+ ( + result:CHARACTER;
+ ? {!end_of_file};
+
+ result := buffer.item cursor;
+ cursor := cursor+1;
+ result
+ );
+
+Section Private
+
+ - load_file <-
+ ( + tmp : STRING;
+
+ buffer := FAST_ARRAY(CHARACTER).create 8192;
+
+
+ tmp := FS_MIN.open_as_string filename;
+ is_loaded := TRUE;
+
+ 1.to (tmp.count) do { i : INTEGER ;
+ //i.print;
+ buffer.add_last (tmp.item i);
+ };
+
+ /*+ e:ENTRY;
+ + file:STD_FILE;
+
+ e := FILE_SYSTEM.get filename;
+ (e != NULL).if {
+ file ?= e.open;
+ buffer := FAST_ARRAY(CHARACTER).create_with_capacity (file.size);
+
+ (file.read buffer size (file.size) > 0).if {
+ is_loaded := TRUE;
+ };
+ file.close;
+ };*/
+ );
+
diff --git a/prolog/tree/base/itm_cut.li b/prolog/tree/base/itm_cut.li
new file mode 100644
index 0000000..9715adb
--- /dev/null
+++ b/prolog/tree/base/itm_cut.li
@@ -0,0 +1,84 @@
+
+Section Header
+
+ + name := ITM_CUT;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_term:TERM := TERM;
+
+Section Public
+
+ + target:RULE; // target rule ex: target(X) :- A1,..,!,Aj,..,An.
+
+
+ - create r:RULE :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make r;
+ result
+ );
+
+ - make r:RULE <-
+ (
+ target := r;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_elt num:INTEGER of proc:PROCEDURE :BOOLEAN <-
+ (
+ + context:CONTEXT;
+
+ // cut backtracking from current context's lower to target
+ context := current_context.lower;
+ {(context = NULL) || {context.rule = target}}.until_do {
+ context.set_backtrack FALSE;
+ context := context.lower;
+ };
+ (context != NULL).if {
+ context.set_backtrack FALSE;
+ };
+ proc.execute_elt (num+1)
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ // rien
+ );
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ FALSE // erreur
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ // rien
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <-
+ (
+ Self
+ );
+
+ - bind other:TERM to context:CONTEXT <-
+ (
+ // rien
+ );
+
+ - copy:TERM <-
+ (
+ SELF.create target
+ );
+
+ - print_value <-
+ (
+ print_m "!";
+ );
\ No newline at end of file
diff --git a/prolog/tree/base/list.li b/prolog/tree/base/list.li
new file mode 100644
index 0000000..6854ec4
--- /dev/null
+++ b/prolog/tree/base/list.li
@@ -0,0 +1,262 @@
+
+Section Header
+
+ + name := LIST;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_term:TERM := TERM;
+
+Section Public
+
+ + first:TERM;
+ + next:LIST;
+
+
+ - is_empty:BOOLEAN <- first = NULL;
+
+ - is_last:BOOLEAN <-
+ (
+ ? {!is_empty};
+ (next != NULL) && {next.is_empty}
+ );
+
+ + has_separator:BOOLEAN; // '|' item
+
+
+
+ - create :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make;
+ result
+ );
+
+ - make <-
+ (
+ next := LIST; // LIST <=> []
+ );
+
+ - set_separator <-
+ (
+ has_separator := TRUE;
+ );
+
+ - set_next list:LIST <-
+ (
+ next := list;
+ );
+
+ - last:LIST <-
+ (
+ + result:LIST;
+
+ result := Self;
+ {result.is_last}.until_do {
+ result := result.next;
+ };
+ result
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ is_empty.if_false {
+ first.register_in context;
+
+ is_last.if_false {
+ next.register_in context;
+ };
+ };
+ );
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ + result:BOOLEAN;
+ + list:LIST;
+
+ list ?= term;
+ (list != NULL).if {
+ is_empty.if_false {
+ result := first.is_unifiable_with (list.first);
+
+ (result && {! is_last}).if {
+ result := next.is_unifiable_with (list.next);
+ };
+ } else {
+ result := list.is_empty;
+ };
+ }.elseif {term.is_unbound} then {
+ result := TRUE;
+ };
+ result
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ + list:LIST;
+ + term:TERM;
+
+ (! is_empty).if {
+ (other_ctxt != NULL).if {
+ term := other_ctxt.get other;
+ } else {
+ term := other;
+ };
+ (! term.is_unbound).if {
+ list ?= term;
+
+ first.unify_with (list.first,other_ctxt);
+ (! is_last).if {
+ next.unify_with (list.next,other_ctxt);
+ };
+ };
+ };
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <-
+ (
+ + list:LIST;
+
+ (! is_empty).if {
+ list ?= other;
+ (list != NULL).if {
+ first.is_unbound.if {
+ (! list.first.is_unbound).if {
+ first := list.first.copy;
+ };
+ } else {
+ first := first.complete_with (list.first) and_expand_within context;
+ };
+ (! is_last).if {
+ ? {! list.is_last};
+
+ next ?= next.complete_with (list.next) and_expand_within context;
+ };
+ };
+ };
+ Self
+ );
+
+ - bind other:TERM to context:CONTEXT <-
+ (
+ + list:LIST;
+
+ (! is_empty).if {
+ list ?= other;
+ (list = NULL).if {
+ "\n==> WHAT???".print;
+ };
+ first.bind (list.first) to context;
+ (! is_last).if {
+ next.bind (list.next) to context;
+ };
+ };
+ );
+
+ - get_solution context:CONTEXT :TERM <-
+ (
+ + result,sub:LIST;
+
+ result := create;
+ (! is_empty).if {
+ result.add_child (first.get_solution context);
+
+ sub ?= next.get_solution context;
+ result.set_next sub;
+
+ has_separator.if {
+ result.set_separator;
+ };
+ };
+ result
+ /*
+ (! is_empty).if {
+ first := first.get_solution context;
+ (! is_last).if {
+ next ?= next.get_solution context;
+ };
+ };
+ Self*/
+ );
+
+ // link term in the list
+ - add_child term:TERM <-
+ (
+ + sublist:LIST;
+
+ (term != NULL).if {
+ is_empty.if {
+ first := term;
+ } else {
+ (! is_last).if {
+ next.add_child term;
+ } else {
+ sublist := LIST.create;
+ sublist.add_child term;
+ next := sublist;
+ };
+ };
+ };
+ );
+
+ - copy:TERM <-
+ (
+ + term:TERM;
+ + result,sub:LIST;
+
+ result := create;
+ (! is_empty).if {
+ term := first.copy;
+ sub ?= next.copy;
+ result.add_child term;
+ result.set_next sub;
+
+ has_separator.if {
+ result.set_separator;
+ };
+ };
+ result
+ );
+
+ - expanded_copy context:CONTEXT :TERM <-
+ (
+ + term:TERM;
+ + result,sub:LIST;
+
+ result := create;
+ (! is_empty).if {
+ term := first.expanded_copy context;
+ sub ?= next.expanded_copy context;
+ result.add_child term;
+ result.set_next sub;
+
+ has_separator.if {
+ result.set_separator;
+ };
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ print_m "[";
+
+ (! is_empty).if {
+ first.print_value;
+
+ (! is_last).if {
+ has_separator.if {
+ print_m " | ";
+ } else {
+ print_m ", ";
+ };
+ next.print_value;
+ };
+ };
+ print_m "]";
+ );
+
\ No newline at end of file
diff --git a/prolog/tree/base/number.li b/prolog/tree/base/number.li
new file mode 100644
index 0000000..fed164b
--- /dev/null
+++ b/prolog/tree/base/number.li
@@ -0,0 +1,95 @@
+
+Section Header
+
+ + name := NUMBER;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ + parent_atom:Expanded TERM;
+
+Section Public
+
+ + value:INTEGER_32;
+
+
+ - create val:ABSTRACT_STRING :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make val;
+ result
+ );
+
+ - create_from val:INTEGER_32 :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make_from val;
+ result
+ );
+
+ - make val:ABSTRACT_STRING <-
+ (
+ // identifier := STRING.create_from_string val;
+ value := val.to_integer;
+ );
+
+ - make_from val:INTEGER_32 <-
+ (
+ //identifier := STRING.create_from_string "VAL";// fixme
+ value := val;
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ // rien
+ );
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ + n:NUMBER;
+ + result:BOOLEAN;
+
+ n ?= term;
+ (n != NULL).if {
+ result := value = n.value;
+ }.elseif {term.is_unbound} then {
+ result := TRUE;
+ };
+ result
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ // rien
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <-
+ (
+ Self
+ );
+
+ - bind other:TERM to context:CONTEXT <-
+ (
+ // rien
+ );
+
+ - get_solution context:CONTEXT :TERM <-
+ (
+ Self
+ );
+
+ - copy:TERM <-
+ (
+ create_from value
+ );
+
+ - print_value <-
+ (
+ value.print;
+ );
+
diff --git a/prolog/tree/base/pred.li b/prolog/tree/base/pred.li
new file mode 100644
index 0000000..b8da812
--- /dev/null
+++ b/prolog/tree/base/pred.li
@@ -0,0 +1,290 @@
+
+Section Header
+
+ + name := PRED;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ + parent_term:Expanded TERM;
+
+Section Private
+
+ + args:LINKED_LIST(TERM);
+
+Section Public
+
+ - name:STRING <- identifier;
+ - arity:INTEGER <- args.count;
+
+ - is_atom:BOOLEAN <- arity = 0;
+
+
+ - create pred_name:ABSTRACT_STRING :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make pred_name;
+ result
+ );
+
+ - make pred_name:ABSTRACT_STRING <-
+ (
+ identifier := STRING.create_from_string pred_name;
+ args := LINKED_LIST(TERM).create;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute_elt num:INTEGER of proc:PROCEDURE :BOOLEAN <-
+ (
+ + builtin:BUILT_IN;
+ + nb_match,k:INTEGER;
+ + result,choice_point:BOOLEAN;
+ + rules:LINKED_LIST(RULE);
+ + rule:RULE;
+
+ // first register new variables
+ register_in current_context;
+
+ get_full_name str_tmp;
+ builtins.has str_tmp.if {
+ // built-in predicate
+
+ builtin := builtins.at str_tmp;
+ result := builtin.call Self && {proc.execute_elt (num+1)};
+ } else {
+ // user-written predicate
+
+ rules := LINKED_LIST(RULE).create;
+
+ nb_match := find rules matching Self;
+ (nb_match > 0).if {
+ // found match!
+
+ debug_mode.if {
+
+ };
+
+ (nb_match > 1).if {
+ // save context for backtracking
+
+ current_context.lock;
+ current_context.set_backtrack TRUE;
+ };
+
+ // for each predicate found
+ k := rules.lower;
+ {
+ rule := rules.item k;
+
+ (current_context.is_locked && {k < rules.upper}).if {
+ // copy context
+
+ current_context.push_copy;
+ choice_point := TRUE;
+ };
+
+ rule.is_fact.if {
+ // simple unification
+
+ unify_with (rule.head,NULL);
+ result := TRUE; // always true predicate
+
+ } else {
+ // execute rule
+ result := rule.execute Self within current_context;
+ };
+
+ // execute next clause
+ result := result && {proc.execute_elt (num+1)};
+
+ choice_point.if {
+ // restore choice point
+
+ // current_context.allow_backtrack.if_false {
+ // remove choice point
+
+ // current_context.lower.remove_lock;
+ // } else {
+ CONTEXT.pop;
+ // };
+
+ choice_point := FALSE;
+
+ };
+
+ // loop to next rule
+ k := k + 1;
+ }.do_while {current_context.allow_backtrack && {k <= rules.upper}};
+ };
+ };
+ result
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ args.lower.to (args.upper) do { i:INTEGER;
+ args.item i.register_in context;
+ };
+ );
+
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ + result:BOOLEAN;
+ + pred:PRED;
+ + i:INTEGER;
+
+ pred ?= term;
+ (pred != NULL).if {
+ ((identifier == pred.identifier) && {arity = pred.arity}).if {
+ i := args.lower;
+ {
+ result := args.item i.is_unifiable_with (pred.get_arg i);
+ i := i+1;
+ }.do_while {result && {i <= args.upper}};
+ };
+ }.elseif {term.is_unbound} then {
+ result := TRUE;
+ };
+ result
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ + term:TERM;
+ + pred:PRED;
+
+ (other_ctxt != NULL).if {
+ term := other_ctxt.get other;
+ } else {
+ term := other;
+ };
+ (! term.is_unbound).if {
+ pred ?= term;
+
+ args.lower.to (args.upper) do { i:INTEGER;
+ // unify arguments
+
+ args.item i.unify_with (pred.get_arg i,other_ctxt);
+ };
+ };
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT:TERM <-
+ (
+ + pred:PRED;
+ + new_arg:TERM;
+
+ pred ?= other;
+ (pred != NULL).if {
+ args.lower.to (args.upper) do { i:INTEGER;
+ (args.item i.is_unbound).if {
+ // copy subtree
+
+ (! pred.get_arg i.is_unbound).if {
+ new_arg := pred.get_arg i.copy;
+ args.put new_arg to i;
+ };
+ } else {
+ // complete deeper
+
+ new_arg := args.item i.complete_with (pred.get_arg i) and_expand_within context;
+ args.put new_arg to i;
+ };
+ };
+ };
+ Self
+ );
+
+ - bind other:TERM to context:CONTEXT <-
+ (
+ + pred:PRED;
+
+ pred ?= other;
+ args.lower.to (args.upper) do { i:INTEGER;
+ // bind arguments
+
+ args.item i.bind (pred.get_arg i) to context;
+ };
+ );
+
+ - get_solution context:CONTEXT :TERM <-
+ (
+ + result,term:TERM;
+
+ result := create name;
+ args.lower.to (args.upper) do { i:INTEGER;
+ term := args.item i.get_solution context;
+ result.add_child term;
+ };
+ result
+ );
+
+ // link term in the tree
+ - add_child term:TERM <-
+ (
+ (term != NULL).if {
+ args.add_last term;
+ };
+ );
+
+ - copy:TERM <-
+ (
+ + result,term:TERM;
+
+ result := create name;
+ args.lower.to (args.upper) do { i:INTEGER;
+ term := args.item i.copy;
+ result.add_child term;
+ };
+ result
+ );
+
+ - expanded_copy context:CONTEXT :TERM <-
+ (
+ + result,term:TERM;
+
+ result := create name;
+ args.lower.to (args.upper) do { i:INTEGER;
+ term := args.item i.expanded_copy context;
+ result.add_child term;
+ };
+ result
+ );
+
+ - get_full_name str:STRING <-
+ (
+ str.clear;
+ str.copy name;
+ str.add_last '/';
+ str.append (arity.to_string);
+ );
+
+ - print_value <-
+ (
+ print_m name;
+
+ (!is_atom).if {
+ print_m "(";
+ args.lower.to (args.upper) do { i:INTEGER;
+ args.item i.print_value;
+ (i != args.upper).if {
+ print_m ", ";
+ };
+ };
+ print_m ")";
+ };
+ );
+
+Section PRED, BUILT_IN
+
+ - get_arg num:INTEGER :TERM <-
+ (
+ args.item num
+ );
\ No newline at end of file
diff --git a/prolog/tree/base/procedure.li b/prolog/tree/base/procedure.li
new file mode 100644
index 0000000..75be372
--- /dev/null
+++ b/prolog/tree/base/procedure.li
@@ -0,0 +1,108 @@
+
+Section Header
+
+ + name := PROCEDURE;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Private
+
+ + clauses:LINKED_LIST(TERM);
+
+Section Public
+
+
+ - is_empty:BOOLEAN <- clauses.is_empty;
+
+ - create:SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make;
+ result
+ );
+
+ - make <-
+ (
+ clauses := LINKED_LIST(TERM).create;
+ );
+
+ //
+ // Execute
+ //
+
+ - execute:BOOLEAN <-
+ (
+ execute_elt 1
+ );
+
+ - execute_elt num:INTEGER :BOOLEAN <-
+ (
+ + result:BOOLEAN;
+ (num <= clauses.upper).if {
+ result := clauses.item num.execute_elt num of Self;
+ } else {
+ //
+ // Leaf of execution tree (last elt of proc)
+ //
+
+ // (Self = current_query).if {
+ // print_m current solution
+ // CONTEXT.display_all;
+
+ CONTEXT.bottom.print_solution;
+ //current_context.print_solution;
+ // };
+ result := TRUE;
+ };
+ result
+ );
+
+ // link clause in the tree
+ - add_child term:TERM <-
+ (
+ (term != NULL).if {
+ clauses.add_last term;
+ };
+ );
+
+ // self copying
+ - copy:TERM <-
+ (
+ + result,term:TERM;
+
+ result := create;
+ clauses.lower.to (clauses.upper) do { i:INTEGER;
+ term := clauses.item i.copy;
+ result.add_child term;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ clauses.lower.to (clauses.upper) do { i:INTEGER;
+ clauses.item i.print_value;
+ (i != clauses.upper).if {
+ print_m ", ";
+ };
+ };
+ print_m ".";
+ );
+
+Section PL_ENGINE
+
+ - get_clause num:INTEGER :TERM <-
+ (
+ + result:TERM;
+
+ (num <= clauses.upper).if {
+ result := clauses.item num;
+ };
+ result
+ );
\ No newline at end of file
diff --git a/prolog/tree/base/term.li b/prolog/tree/base/term.li
new file mode 100644
index 0000000..3372f57
--- /dev/null
+++ b/prolog/tree/base/term.li
@@ -0,0 +1,51 @@
+
+Section Header
+
+ + name := TERM;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+ - comment := "Node for predicate tree";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ + identifier:STRING;
+
+ - hash_code:INTEGER <- identifier.hash_code;
+
+
+ - add_child term:TERM <- deferred;
+
+ - print_value <- (print_m "?!";); //deferred;
+
+
+ - execute_elt num:INTEGER of proc:PROCEDURE :BOOLEAN <-
+ (
+ error "Semantic: TERM.execute call";
+ FALSE
+ );
+
+ - copy:TERM <- (deferred;NULL);
+ - expanded_copy context:CONTEXT :TERM <- copy; // default
+
+ - register_in context:CONTEXT <- deferred;
+
+ - is_unifiable_with term:TERM :BOOLEAN <- (deferred;FALSE);
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <- deferred;
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <- (deferred;NULL);
+
+ - bind other:TERM to context:CONTEXT <- deferred;
+
+ - get_solution context:CONTEXT :TERM <- (deferred;NULL);
+
+ - is_unbound:BOOLEAN <-
+ (
+ same_dynamic_type VAR
+ );
+
\ No newline at end of file
diff --git a/prolog/tree/base/var.li b/prolog/tree/base/var.li
new file mode 100644
index 0000000..8f60e2e
--- /dev/null
+++ b/prolog/tree/base/var.li
@@ -0,0 +1,153 @@
+
+Section Header
+
+ + name := VAR;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ + parent_term:Expanded TERM;
+
+Section Public
+
+ - name:STRING <- identifier;
+ + stat:UINTEGER_8;
+
+ - is_anonymous:BOOLEAN <- stat = 1; // FIXME
+
+ //
+ // This prototype doesn't hold the variable value, see VAR_VALUE
+ //
+
+
+ - create varname:ABSTRACT_STRING mute b:BOOLEAN :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make (varname,b);
+
+ result
+ );
+
+ - make (varname:ABSTRACT_STRING, mute:BOOLEAN) <-
+ (
+ identifier := STRING.create_from_string varname;
+ mute.if {
+ stat := 1;
+ };
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ context.register_variable Self;
+ //CONTEXT.current.register_variable Self;
+ );
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ + self:TERM;
+ + result:BOOLEAN;
+
+ self := current_context.get Self;
+ (self != Self).if {
+ result := self.is_unifiable_with term;
+ } else {
+ // unbounded var: match everything
+ result := TRUE;
+ };
+ result
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ + val:VAR_VALUE;
+ + term,new_term:TERM;
+
+ (other_ctxt != NULL).if {
+ term := other_ctxt.get other;
+ } else {
+ term := other;
+ };
+ (! term.is_unbound).if {
+ val := current_context.get_value Self;
+
+ // raffinement de la variable: copie partielle/totale de l'arbre 'other'
+ new_term := val.value.complete_with term and_expand_within other_ctxt;
+ val.make new_term;
+ };
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <-
+ (
+ + result,term:TERM;
+
+ (context != NULL).if {////////////////// ???
+ // expand tree with context value
+ term := context.get other;
+ } else {
+ term := other;
+ };////////////////////////////////////// ???
+
+ (! term.is_unbound).if {
+ result := term.expanded_copy context;
+ } else {
+ result := Self;
+ };
+ result
+ );
+
+ - bind other:TERM to context:CONTEXT <-
+ // 'self' is defined in 'context' and 'other' in current context
+ (
+ + val:VAR_VALUE;
+
+ val := context.get_value Self;
+ val.bind_to other;
+ );
+
+ - get_solution context:CONTEXT :TERM <-
+ (
+ + val:VAR_VALUE;
+ + result:TERM;
+
+ val := context.get_value Self;
+ ((val.bind != NULL) && {context.upper != NULL}).if {
+ result := val.bind.get_solution (context.upper);
+ } else {
+ result := val;
+ };
+ result
+ );
+
+ - copy:TERM <-
+ (
+ create name mute is_anonymous // Self ??
+ );
+
+ - expanded_copy context:CONTEXT :TERM <-
+ (
+ + val:VAR_VALUE;
+ + result:TERM;
+
+ val := context.get_value Self;
+ (val != NULL).if {
+ result := val.value.expanded_copy context;
+ } else {
+ result := copy;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ is_anonymous.if {
+ print_m "_";
+ } else {
+ print_m "VAR";
+ };
+ );
+
+
+
\ No newline at end of file
diff --git a/prolog/tree/base/var_list.li b/prolog/tree/base/var_list.li
new file mode 100644
index 0000000..c1c2d4f
--- /dev/null
+++ b/prolog/tree/base/var_list.li
@@ -0,0 +1,219 @@
+
+Section Header
+
+ + name := VAR_LIST;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+ - comment := "ex: [a,b,c | Reste] -> Rest = VAR_LIST";
+
+Section Inherit
+
+ + parent_list:Expanded LIST;
+
+Section Public
+
+ - is_empty:BOOLEAN <- first = NULL;
+
+ - is_last:BOOLEAN <-
+ (
+ ? {!is_empty};
+ (next != NULL) && {next.is_empty}
+ );
+
+ + has_separator:BOOLEAN; // '|' item
+
+
+
+ - create :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make;
+ result
+ );
+
+ - make <-
+ (
+ next := LIST; // LIST <=> []
+ );
+
+ - set_separator <-
+ (
+ has_separator := TRUE;
+ );
+
+ - set_next list:LIST <-
+ (
+ next := list;
+ );
+
+ - last:LIST <-
+ (
+ + result:LIST;
+
+ result := Self;
+ {result.is_last}.until_do {
+ result := result.next;
+ };
+ result
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ is_empty.if_false {
+ first.register_in context;
+
+ is_last.if_false {
+ next.register_in context;
+ };
+ };
+ );
+
+ - is_unifiable_with term:TERM within self_context:CONTEXT :BOOLEAN <-
+ (
+ + result:BOOLEAN;
+ + list:LIST;
+
+ list ?= term;
+ (list != NULL).if {
+ is_empty.if_false {
+ result := first.is_unifiable_with (list.first) within self_context;
+
+ (result && {! is_last}).if {
+ result := next.is_unifiable_with (list.next) within self_context;
+ };
+ } else {
+ result := list.is_empty;
+ };
+ }.elseif {term.is_unbound} then {
+ result := TRUE;
+ };
+ result
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) within context:CONTEXT <-
+ (
+ + list:LIST;
+ + term:TERM;
+
+ (! is_empty).if {
+ (other_ctxt != NULL).if {
+ term := other_ctxt.get other;
+ } else {
+ term := other;
+ };
+ (! term.is_unbound).if {
+ list ?= term;
+
+ first.unify_with (list.first,other_ctxt) within context;
+ (! is_last).if {
+ next.unify_with (list.next,other_ctxt) within context;
+ };
+ };
+ };
+ );
+
+ - complete_with other:TERM :TERM <-
+ (
+ + list:LIST;
+
+ (! is_empty).if {
+ list ?= other;
+ (list != NULL).if {
+ first.is_unbound.if {
+ (! list.first.is_unbound).if {
+ first := list.first.copy;
+ };
+ } else {
+ first := first.complete_with (list.first);
+ };
+ (! is_last).if {
+ ? {! list.is_last};
+
+ next ?= next.complete_with (list.next);
+ };
+ };
+ };
+ Self
+ );
+
+ // link term in the list
+ - add_child term:TERM <-
+ (
+ + sublist:LIST;
+
+ (term != NULL).if {
+ is_empty.if {
+ first := term;
+ } else {
+ (! is_last).if {
+ next.add_child term;
+ } else {
+ sublist := LIST.create;
+ sublist.add_child term;
+ next := sublist;
+ };
+ };
+ };
+ );
+
+ - copy:TERM <-
+ (
+ + term:TERM;
+ + result,sub:LIST;
+
+ result := create;
+ (! is_empty).if {
+ term := first.copy;
+ sub ?= next.copy;
+ result.add_child term;
+ result.set_next sub;
+
+ has_separator.if {
+ result.set_separator;
+ };
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ print_m "[";
+
+ (! is_empty).if {
+ first.print_value;
+
+ (! is_last).if {
+ has_separator.if {
+ print_m " | ";
+ } else {
+ print_m ", ";
+ };
+ next.print_value;
+ };
+ };
+ print_m "]";
+ );
+
+ - debug <-
+ (
+ indent.print;
+ print_m "[LIST] ";
+
+ has_separator.if {
+ print_m " <separator> ";
+ };
+ indent.append " ";
+
+ is_empty.if {
+ print_m "[]";
+ } else {
+ first.debug;
+ };
+ (! is_last).if {
+ next.debug;
+ };
+ indent.remove_last 2;
+ );
+
\ No newline at end of file
diff --git a/prolog/tree/builtins/bip_atom.li b/prolog/tree/builtins/bip_atom.li
new file mode 100644
index 0000000..b39d140
--- /dev/null
+++ b/prolog/tree/builtins/bip_atom.li
@@ -0,0 +1,20 @@
+
+Section Header
+
+ + name := BIP_ATOM;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_built_in:BUILT_IN := BUILT_IN;
+
+Section Public
+
+ - call pred:PRED :BOOLEAN <-
+ (
+ + p:PRED;
+
+ p ?= pred.get_arg 1;
+ (p != NULL) && {p.is_atom}
+ );
\ No newline at end of file
diff --git a/prolog/tree/builtins/bip_fail.li b/prolog/tree/builtins/bip_fail.li
new file mode 100644
index 0000000..79c8386
--- /dev/null
+++ b/prolog/tree/builtins/bip_fail.li
@@ -0,0 +1,17 @@
+
+Section Header
+
+ + name := BIP_FAIL;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_built_in:BUILT_IN := BUILT_IN;
+
+Section Public
+
+ - call pred:PRED :BOOLEAN <-
+ (
+ FALSE
+ );
\ No newline at end of file
diff --git a/prolog/tree/builtins/bip_list.li b/prolog/tree/builtins/bip_list.li
new file mode 100644
index 0000000..0b27edb
--- /dev/null
+++ b/prolog/tree/builtins/bip_list.li
@@ -0,0 +1,20 @@
+
+Section Header
+
+ + name := BIP_LIST;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_built_in:BUILT_IN := BUILT_IN;
+
+Section Public
+
+ - call pred:PRED :BOOLEAN <-
+ (
+ + list:LIST;
+
+ list ?= current_context.get (pred.get_arg 1);
+ list != NULL
+ );
\ No newline at end of file
diff --git a/prolog/tree/builtins/bip_var.li b/prolog/tree/builtins/bip_var.li
new file mode 100644
index 0000000..53b55a9
--- /dev/null
+++ b/prolog/tree/builtins/bip_var.li
@@ -0,0 +1,20 @@
+
+Section Header
+
+ + name := BIP_VAR;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_built_in:BUILT_IN := BUILT_IN;
+
+Section Public
+
+ - call pred:PRED :BOOLEAN <-
+ (
+ + var:VAR;
+
+ var ?= pred.get_arg 1;
+ var != NULL
+ );
\ No newline at end of file
diff --git a/prolog/tree/builtins/bip_write.li b/prolog/tree/builtins/bip_write.li
new file mode 100644
index 0000000..cb94dd4
--- /dev/null
+++ b/prolog/tree/builtins/bip_write.li
@@ -0,0 +1,20 @@
+
+Section Header
+
+ + name := BIP_WRITE;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_built_in:BUILT_IN := BUILT_IN;
+
+Section Public
+
+ - call pred:PRED :BOOLEAN <-
+ (
+ "\n--------WRITE-----------\n".print;
+ current_context.get (pred.get_arg 1).print_value;
+ "\n------------------------\n".print;
+ TRUE
+ );
\ No newline at end of file
diff --git a/prolog/tree/builtins/built_in.li b/prolog/tree/builtins/built_in.li
new file mode 100644
index 0000000..48cdce7
--- /dev/null
+++ b/prolog/tree/builtins/built_in.li
@@ -0,0 +1,18 @@
+
+Section Header
+
+ + name := BUILT_IN;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ - call pred:PRED :BOOLEAN <-
+ (
+ deferred;
+ FALSE
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr.li b/prolog/tree/expr/expr.li
new file mode 100644
index 0000000..4c682a0
--- /dev/null
+++ b/prolog/tree/expr/expr.li
@@ -0,0 +1,47 @@
+
+Section Header
+
+ + name := EXPR;
+
+ - author := "Damien Bouvarel";
+ - comment := "Computable expression";
+
+Section Inherit
+
+ - parent_term:TERM := TERM;
+
+Section Public
+
+ //
+ // Execute
+ //
+
+ - execute_elt num:INTEGER of proc:PROCEDURE :BOOLEAN <-
+ (
+ register_in current_context;
+ execute && {proc.execute_elt (num+1)}
+ );
+
+ - evaluate:TERM <-
+ (
+ error "Semantic: Can't evaluate expression";
+ NULL
+ );
+
+ - execute:BOOLEAN <-
+ (
+ error "Semantic: Incorrect expression predicate";
+ FALSE
+ );
+
+
+ - bind other:TERM to context:CONTEXT <-
+ (
+ error "Semantic: Can't bind expression";
+ );
+
+
+Section EXPR
+
+ - infix:BOOLEAN;
+
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_add.li b/prolog/tree/expr/expr_add.li
new file mode 100644
index 0000000..5b61419
--- /dev/null
+++ b/prolog/tree/expr/expr_add.li
@@ -0,0 +1,41 @@
+
+Section Header
+
+ + name := EXPR_ADD;
+
+ - comment := "Add Expression.";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+ - evaluate:TERM <-
+ (
+ + l,r:NUMBER;
+ + result:TERM;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := NUMBER.create_from (l.value + r.value);
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ infix.if {
+ left.print_value;
+ print_m " + ";
+ right.print_value;
+ } else {
+ print_m " +(";
+ left.print_value;
+ print_m ", ";
+ right.print_value;
+ print_m ")";
+ };
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_binary.li b/prolog/tree/expr/expr_binary.li
new file mode 100644
index 0000000..d344063
--- /dev/null
+++ b/prolog/tree/expr/expr_binary.li
@@ -0,0 +1,102 @@
+
+Section Header
+
+ + name := EXPR_BINARY;
+
+ - author := "Damien Bouvarel";
+ - comment := "Binary expression";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ + left:EXPR;
+ + right:EXPR;
+
+
+ - create l:EXPR and r:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := SELF.clone;
+ result.make l and r;
+ result
+ );
+
+ - make l:EXPR and r:EXPR <-
+ (
+ left := l;
+ right := r;
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ left.register_in context;
+ right.register_in context;
+ );
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ + self_type:SELF;
+ + result:BOOLEAN;
+
+ self_type ?= term;
+ (self_type != NULL).if {
+ result := (left.is_unifiable_with (self_type.left))
+ && {right.is_unifiable_with (self_type.right)};
+ };
+ result
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ + e:EXPR_BINARY;
+ + term:TERM;
+
+ (other_ctxt != NULL).if {
+ term := other_ctxt.get other;
+ } else {
+ term := other;
+ };
+ (! term.is_unbound).if {
+ e ?= term;
+ left.unify_with (e.left,other_ctxt);
+ right.unify_with (e.right,other_ctxt);
+ };
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <-
+ (
+ + e:EXPR_BINARY;
+
+ e ?= other;
+ (e != NULL).if {
+ left ?= left.complete_with (e.left) and_expand_within context;
+ right ?= right.complete_with (e.right) and_expand_within context;
+ };
+ Self
+ );
+
+ - copy:TERM <-
+ (
+ + e1,e2:EXPR;
+
+ e1 ?= left.copy;
+ e2 ?= right.copy;
+ create e1 and e2
+ );
+
+ - expanded_copy context:CONTEXT :TERM <-
+ (
+ + e1,e2:EXPR;
+
+ e1 ?= left.expanded_copy context;
+ e2 ?= right.expanded_copy context;
+ create e1 and e2
+ );
+
+
+
+
+
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_cst.li b/prolog/tree/expr/expr_cst.li
new file mode 100644
index 0000000..09a76d2
--- /dev/null
+++ b/prolog/tree/expr/expr_cst.li
@@ -0,0 +1,106 @@
+
+Section Header
+
+ + name := EXPR_CST;
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ + value:TERM;
+
+
+ - create val:TERM :SELF <-
+ (
+ + result:SELF;
+ result := SELF.clone;
+ result.make val;
+ result
+ );
+
+ - make val:TERM <-
+ (
+ value := val;
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ value.register_in context;
+ );
+
+ - evaluate:TERM <-
+ (
+ current_context.get value
+ );
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ + cst:EXPR_CST;
+ + other:TERM;
+
+ cst ?= term;
+ (cst != NULL).if {
+ other := cst.value;
+ } else {
+ other := term;
+ };
+ value.is_unifiable_with other
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ + cst:EXPR_CST;
+ + term:TERM;
+
+ (other_ctxt != NULL).if {
+ term := other_ctxt.get other;
+ } else {
+ term := other;
+ };
+ (! term.is_unbound).if {
+ cst ?= term;
+ (cst != NULL).if {
+ term := cst.value;
+ };
+ value.unify_with (term,other_ctxt);
+ };
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <-
+ (
+ + cst:EXPR_CST;
+ + term:TERM;
+
+ cst ?= other;
+ (cst != NULL).if {
+ term := cst.value;
+ } else {
+ term := other;
+ };
+ value := value.complete_with term and_expand_within context;
+ Self
+ );
+
+ - copy:TERM <-
+ (
+ + val:TERM;
+
+ val := value.copy;
+ create val
+ );
+
+ - expanded_copy context:CONTEXT :TERM <-
+ (
+ + val:TERM;
+
+ val := value.expanded_copy context;
+ create val
+ );
+
+ - print_value <-
+ (
+ value.print_value;
+ );
+
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_div.li b/prolog/tree/expr/expr_div.li
new file mode 100644
index 0000000..bd9d58b
--- /dev/null
+++ b/prolog/tree/expr/expr_div.li
@@ -0,0 +1,42 @@
+
+Section Header
+
+ + name := EXPR_DIV;
+
+ - comment := "Division.";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+ - evaluate:TERM <-
+ (
+ + l,r:NUMBER;
+ + result:TERM;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := NUMBER.create_from (l.value / r.value);
+ };
+ result
+ );
+
+
+ - print_value <-
+ (
+ infix.if {
+ left.print_value;
+ print_m " / ";
+ right.print_value;
+ } else {
+ print_m " div(";
+ left.print_value;
+ print_m ", ";
+ right.print_value;
+ print_m ")";
+ };
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_equal.li b/prolog/tree/expr/expr_equal.li
new file mode 100644
index 0000000..9351035
--- /dev/null
+++ b/prolog/tree/expr/expr_equal.li
@@ -0,0 +1,33 @@
+
+Section Header
+
+ + name := EXPR_EQUAL;
+
+ - comment := "Evaluation operator '=:='";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ ( + l,r:NUMBER;
+ + result:BOOLEAN;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := l.value = r.value;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " =:= ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_eval.li b/prolog/tree/expr/expr_eval.li
new file mode 100644
index 0000000..7bbe583
--- /dev/null
+++ b/prolog/tree/expr/expr_eval.li
@@ -0,0 +1,40 @@
+
+Section Header
+
+ + name := EXPR_EVAL;
+
+ - comment := "Evaluation operator 'is'";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ (
+ + result:BOOLEAN;
+ + eval:TERM;
+ "\n======================>> YO_EVAL\n".print;
+ CONTEXT.display_all;
+ eval := right.evaluate;
+ "\n)))> ".print; right.print_value;
+ (eval = NULL).if {
+ error "operator 'is': Can't evaluate right part";
+ };
+ left.is_unifiable_with eval.if {
+
+ current_context.display;
+ left.unify_with (eval,current_context);
+ result := TRUE;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " is ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_inf.li b/prolog/tree/expr/expr_inf.li
new file mode 100644
index 0000000..73f7eac
--- /dev/null
+++ b/prolog/tree/expr/expr_inf.li
@@ -0,0 +1,33 @@
+
+Section Header
+
+ + name := EXPR_INF;
+
+ - comment := "Evaluation operator '=<'";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ ( + l,r:NUMBER;
+ + result:BOOLEAN;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := l.value <= r.value;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " =< ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_inf_strict.li b/prolog/tree/expr/expr_inf_strict.li
new file mode 100644
index 0000000..b521c80
--- /dev/null
+++ b/prolog/tree/expr/expr_inf_strict.li
@@ -0,0 +1,33 @@
+
+Section Header
+
+ + name := EXPR_INF_STRICT;
+
+ - comment := "Evaluation operator '<'";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ ( + l,r:NUMBER;
+ + result:BOOLEAN;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := l.value < r.value;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " < ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_mul.li b/prolog/tree/expr/expr_mul.li
new file mode 100644
index 0000000..e9f5502
--- /dev/null
+++ b/prolog/tree/expr/expr_mul.li
@@ -0,0 +1,41 @@
+
+Section Header
+
+ + name := EXPR_MUL;
+
+ - comment := "Multiplication operation.";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+ - evaluate:TERM <-
+ (
+ + l,r:NUMBER;
+ + result:TERM;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := NUMBER.create_from (l.value * r.value);
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ infix.if {
+ left.print_value;
+ print_m " * ";
+ right.print_value;
+ } else {
+ print_m " *(";
+ left.print_value;
+ print_m ", ";
+ right.print_value;
+ print_m ")";
+ };
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_neg.li b/prolog/tree/expr/expr_neg.li
new file mode 100644
index 0000000..bc8c9b3
--- /dev/null
+++ b/prolog/tree/expr/expr_neg.li
@@ -0,0 +1,37 @@
+
+Section Header
+
+ + name := EXPR_NEG;
+
+ - comment := "Neg Expression.";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_UNARY;
+
+Section Public
+
+
+ - evaluate:TERM <-
+ (
+ + n:NUMBER;
+ + result:TERM;
+
+ n ?= expr.evaluate;
+ (n != NULL).if {
+ result := NUMBER.create_from (- n.value);
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ infix.if {
+ print_m " - ";
+ expr.print_value;
+ } else {
+ print_m " -(";
+ expr.print_value;
+ print_m ")";
+ };
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_not_equal.li b/prolog/tree/expr/expr_not_equal.li
new file mode 100644
index 0000000..619ee70
--- /dev/null
+++ b/prolog/tree/expr/expr_not_equal.li
@@ -0,0 +1,33 @@
+
+Section Header
+
+ + name := EXPR_NOT_EQUAL;
+
+ - comment := "Evaluation operator '=/='";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ ( + l,r:NUMBER;
+ + result:BOOLEAN;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := l.value != r.value;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " =/= ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_not_unify.li b/prolog/tree/expr/expr_not_unify.li
new file mode 100644
index 0000000..75b03f2
--- /dev/null
+++ b/prolog/tree/expr/expr_not_unify.li
@@ -0,0 +1,26 @@
+
+Section Header
+
+ + name := EXPR_NOT_UNIFY;
+
+ - comment := "operator '/='";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ (
+ ! left.is_unifiable_with right
+ );
+
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " /= ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_sub.li b/prolog/tree/expr/expr_sub.li
new file mode 100644
index 0000000..c38b327
--- /dev/null
+++ b/prolog/tree/expr/expr_sub.li
@@ -0,0 +1,42 @@
+
+Section Header
+
+ + name := EXPR_SUB;
+
+ - comment := "Sub Operation.";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+ - evaluate:TERM <-
+ (
+ + l,r:NUMBER;
+ + result:TERM;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := NUMBER.create_from (l.value - r.value);
+ };
+ result
+ );
+
+
+ - print_value <-
+ (
+ infix.if {
+ left.print_value;
+ print_m " - ";
+ right.print_value;
+ } else {
+ print_m " -(";
+ left.print_value;
+ print_m ", ";
+ right.print_value;
+ print_m ")";
+ };
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_sup.li b/prolog/tree/expr/expr_sup.li
new file mode 100644
index 0000000..3b783f0
--- /dev/null
+++ b/prolog/tree/expr/expr_sup.li
@@ -0,0 +1,33 @@
+
+Section Header
+
+ + name := EXPR_SUP;
+
+ - comment := "Evaluation operator '>='";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ ( + l,r:NUMBER;
+ + result:BOOLEAN;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := l.value >= r.value;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " >= ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_sup_strict.li b/prolog/tree/expr/expr_sup_strict.li
new file mode 100644
index 0000000..a6e6f66
--- /dev/null
+++ b/prolog/tree/expr/expr_sup_strict.li
@@ -0,0 +1,33 @@
+
+Section Header
+
+ + name := EXPR_SUP_STRICT;
+
+ - comment := "Evaluation operator '>'";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ ( + l,r:NUMBER;
+ + result:BOOLEAN;
+
+ l ?= left.evaluate;
+ r ?= right.evaluate;
+
+ ((l != NULL) && {r != NULL}).if {
+ result := l.value > r.value;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " > ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_unary.li b/prolog/tree/expr/expr_unary.li
new file mode 100644
index 0000000..88467ed
--- /dev/null
+++ b/prolog/tree/expr/expr_unary.li
@@ -0,0 +1,89 @@
+
+Section Header
+
+ + name := EXPR_UNARY;
+
+ - comment := "Unary Expression.";
+
+Section Inherit
+
+ + parent_expr:Expanded EXPR;
+
+Section Public
+
+ + expr:EXPR;
+
+
+ - create e:EXPR :SELF <-
+ ( + result:SELF;
+
+ result := clone;
+ result.make e;
+ result
+ );
+
+ - register_in context:CONTEXT <-
+ (
+ expr.register_in context;
+ );
+
+ - is_unifiable_with term:TERM :BOOLEAN <-
+ (
+ + self_type:SELF;
+ + result:BOOLEAN;
+
+ self_type ?= term;
+ (self_type != NULL).if {
+ result := expr.is_unifiable_with (self_type.expr);
+ };
+ result
+ );
+
+ - unify_with (other:TERM,other_ctxt:CONTEXT) <-
+ (
+ + e:EXPR_UNARY;
+ + term:TERM;
+
+ (other_ctxt != NULL).if {
+ term := other_ctxt.get other;
+ } else {
+ term := other;
+ };
+ (! term.is_unbound).if {
+ e ?= term;
+ expr.unify_with (e.expr,other_ctxt);
+ };
+ );
+
+ - complete_with other:TERM and_expand_within context:CONTEXT :TERM <-
+ (
+ + e:EXPR_UNARY;
+
+ e ?= other;
+ (e != NULL).if {
+ expr ?= expr.complete_with (e.expr) and_expand_within context;
+ };
+ Self
+ );
+
+ - copy:TERM <-
+ (
+ + e:EXPR;
+
+ e ?= expr.copy;
+ create e
+ );
+
+ - expanded_copy context:CONTEXT :TERM <-
+ (
+ + e:EXPR;
+
+ e ?= expr.expanded_copy context;
+ create e
+ );
+
+ - make e:EXPR <-
+ (
+ expr := e;
+ );
+
\ No newline at end of file
diff --git a/prolog/tree/expr/expr_unify.li b/prolog/tree/expr/expr_unify.li
new file mode 100644
index 0000000..6314d49
--- /dev/null
+++ b/prolog/tree/expr/expr_unify.li
@@ -0,0 +1,38 @@
+
+Section Header
+
+ + name := EXPR_UNIFY;
+
+ - comment := "Unification operator '='";
+
+Section Inherit
+
+ + parent_expr_binary:Expanded EXPR_BINARY;
+
+Section Public
+
+
+ - execute:BOOLEAN <-
+ (
+ + result:BOOLEAN;
+
+ left.is_unifiable_with right.if {
+ // do unify left & rigth operands
+
+ left.unify_with (right, current_context);
+
+ // !!!! X = f(X) infinite loop !!!
+ right.unify_with (left, current_context);
+
+ result := TRUE;
+ };
+ result
+ );
+
+
+ - print_value <-
+ (
+ left.print_value;
+ print_m " = ";
+ right.print_value;
+ );
\ No newline at end of file
diff --git a/prolog/tree/query.li b/prolog/tree/query.li
new file mode 100644
index 0000000..e8ed004
--- /dev/null
+++ b/prolog/tree/query.li
@@ -0,0 +1,23 @@
+
+Section Header
+
+ + name := QUERY;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+ - comment := "Prolog Request";
+
+Section Inherit
+
+ + parent_procedure:Expanded PROCEDURE;
+
+Section Public
+
+ - execute:BOOLEAN <-
+ (
+ current_query := Self;
+
+ CONTEXT.push_new NULL;
+ parent_procedure.execute
+ );
+
+
diff --git a/prolog/tree/rule.li b/prolog/tree/rule.li
new file mode 100644
index 0000000..7094c04
--- /dev/null
+++ b/prolog/tree/rule.li
@@ -0,0 +1,106 @@
+
+Section Header
+
+ + name := RULE;
+
+ - author := "Damien Bouvarel (dams.bouvarel at wanadoo.fr)";
+
+Section Inherit
+
+ - parent_any:ANY := ANY;
+
+Section Public
+
+ - name:STRING <- head.name;
+ - arity:INTEGER <- head.arity;
+
+ + head:PRED;
+ + body:PROCEDURE;
+
+ + next:RULE;// next rule with same profil
+
+ - is_fact:BOOLEAN <- body.is_empty;
+ - is_single:BOOLEAN <- next = NULL;
+
+
+ - create h:PRED body p:PROCEDURE :SELF <-
+ (
+ + result:SELF;
+
+ result := SELF.clone;
+ result.make (h,p);
+ result
+ );
+
+ - make (h:PRED, p:PROCEDURE)<-
+ (
+ head := h;
+ body := p;
+ );
+
+ - add_rule rule:RULE <-
+ (
+ (next = NULL).if {
+ next := rule;
+ } else {
+ next.add_rule rule;
+ };
+ );
+
+ //
+ // Execute rule
+ //
+
+ - execute call:PRED within call_context:CONTEXT :BOOLEAN <-
+ (
+ + context:CONTEXT;
+ + result:BOOLEAN;
+
+ // create & push new context
+ context := CONTEXT.push_new Self;
+
+ // register argument & variables
+ head.register_in context;
+
+ // unify head with the arguments of the call
+ head.unify_with (call,call_context);
+
+ // bind rule variables to call context variables
+ call.bind head to call_context;
+
+ // do the call
+ result := body.execute;
+
+ // restore context
+ CONTEXT.pop;
+
+ // get call result
+ call.unify_with (head,context);
+
+ result
+ );
+
+ - nb_match:INTEGER <-
+ (
+ + result:INTEGER;
+
+ (next != NULL).if {
+ result := 1 + next.nb_match;
+ } else {
+ result := 1;
+ };
+ result
+ );
+
+ - print_value <-
+ (
+ head.print_value;
+ is_fact.if_false {
+ print_m " :- ";
+ body.print_value;
+ } else {
+ print_m ".";
+ };
+ );
+
+ - set_body p:PROCEDURE <- (body := p;);
\ No newline at end of file
--
applications.git
More information about the Lisaac-commits
mailing list