/* File: flrparser.P -- The Flora Parser ** ** Author(s): Guizhen Yang ** ** Contact: flora-users@lists.sourceforge.net ** ** Copyright (C) The Research Foundation of SUNY, 1999-2001 ** ** FLORA-2 is free software; you can redistribute it and/or modify it under the ** terms of the GNU Library General Public License as published by the Free ** Software Foundation; either version 2 of the License, or (at your option) ** any later version. ** ** FLORA-2 is distributed in the hope that it will be useful, but WITHOUT ANY ** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS ** FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for ** more details. ** ** You should have received a copy of the GNU Library General Public License ** along with FLORA-2; if not, write to the Free Software Foundation, ** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ** ** */ :- compiler_options([xpp_on]). #define CANOTERM canoterm #define CANOLIST canolist #define CANOBRACE canobrace #define FLINS flins #define FLDEL fldel %% @flora(...) #define FLORASYSMOD florasysmod %% @prolog(), @prolog(...) #define PROLOGMODULE prologmodule %% @prologall(), @proologall(...) #define PROLOGALLMODULE prologallmodule #define FLORAUSERMOD florausermod #define FLSK_DEPTH 2 #include "flora_errors.flh" #include "flora_terms.flh" /**************************************************************************** AN INFORMAL BNF GRAMMAR %% To avoid confusion between some language elements and meta-syntax %% (e.g., parentheses and brackets are part of BNF and also of the language %% being described), we enclose some symbols in single quotes to make it %% clear that they are part of the language syntax, not of the grammar. %% However, FLORA these symbols can be used with or without the quotes. Rule := Head (':-' Body)? . Head := HeadLiteral Head := Head ',' Head HeadLiteral := BinaryRelationship | ObjectSpecification | Term Body := BodyLiteral Body := BodyConjunt | BodyDisjunct | BodyNegative | ControlFlowStatement Body := Body '@' ModuleName Body := BodyConstraint ModuleName := 'prolog()' | 'prolog(' atom ')' | atom | 'flora(' atom ') ' BodyConjuct := Body ',' Body BodyDisjunct := Body ';' Body BodyNegative := ('tnot' | '\+') Body BodyConstraint := '{' CLPR-style constraint '}' ControlFlowStatement := IfThenElse | UnlessDo | WhileDo | WhileLoop | DoUntil | LoopUntil IfThenElse := if Body then Body (else Body)? UnlessDo := unless Body do Body WhileDo := while Body do Body WhileLoop := while Body loop Body DoUntil := do Body until Body LoopUntil := loop Body until Body BodyLiteral := BinaryRelationship | ObjectSpecification | Term | DBUpdate | Refresh | Builtin | Loading Builtin := Arithmetic Comparison, etc. Loading := '[' LoadingCommand (',' LoadingCommand)* ']' LoadingCommand := filename ('>>' atom) BinaryRelationship := PathExpression ':' PathExpression BinaryRelationship := PathExpression '::' PathExpression ObjectSpecification := PathExpression '[' SpecBody ']' SpecBody := 'tnot' MethodSpecification SpecBody := SpecBody ',' SpecBody SpecBody := SpecBody ';' SpecBody MethodSpecification := ('#' | '*')? Term MethodSpecification := PathExpression ValueReferenceConnective PathExpression ValueReferenceConnective := '->' | '->>' | '*->' | '*->>' | '=>' | '=>>' PathExpression := atom | number | string | variable | specialOidToken PathExpression := Term | List | ReifiedFormula PathExpression := PathExpression PathExpressionConnective PathExpression PathExpression := BinaryRelationship PathExpression := ObjectSpecification PathExpression := Aggregate PathExpressionConnective := '.' | '..' | '!' | '!!' specialOidToken := anonymousOid | numberedOid | thisModuleName ReifiedFormula := ${Body} %% No quotes are allowed in the following special tokens! %% No space alowed between _# and integer %% anonymousOid & numberedOid can occur only in rule head anonymousOid := _# numberedOid := _#integer thisModuleName := _@ List := '[' PathExpression (',' PathExpression)* ('|' PathExpression)? ']' Term := Functor '(' Arguments ')' Functor := PathExpression Arguments := PathExpression (',' PathExpression)* Aggregate := AggregateOperator '{' TargetVariable (GroupingVariables)? '|' Body '}' AggregateOperator := 'max' | 'min' | 'avg' | 'sum' | 'collectset' | 'collectbag' %% Note: only one TargetVariable is permitted. %% It must be a variable, not a term. If you need to aggregate over terms, %% as for example, in collectset/collectbag, use the following idiom: %% S = collectset{ V | ... , V=Term } TargetVariable := variable GroupingVariables := '[' variable, (',' variable)* ']' DBUpdate := DBOp '{' UpdateList ('|' Body)? '}' DBOp := insert | insertall | delete | deleteall | erase | eraseall UpdateList := HeadLiteral ('@' atom)? UpdateList := UpdateList ',' UpdateList Refresh := refresh '{' UpdateList '}' ****************************************************************************/ /**************************************************************************** canonical_form(+ComposerTerm,-CanoniTerm) canonical_form(+ComposerTerm,-CanoniTerm,-PrimaryIndex) translates a structure constructed by the composer into an intermediate canonical form. That is to make the functor/arguments syntax compatible with the operator syntax. CANOTERM(CANOTERM, % can be any CANOTERM Arity, % is known at compile time ParenthesisType, % can be '(', '[', or '{' ListOfArguments, % are CANOTERMs separated by ',' at top level FunctorIndex, % primary index of the functor (error message) ParenthesisIndex % index of the parenthesis (error message) ) CANOLIST(ListOfElements, % are CANOTERMs separated by ',' at top level Tail, % is separated by '|' NumberOfElements, % separated by ',' at the top level excluding tail ParenthesisIndex % index of the bracket '[' (error message) BarIndex % index of the bar '|' if any ) CANOBRACE(ListOfElements, % are CANOTERMs separated by ',' at top level NumberOfElements, % number of terms between {...} ParenthesisIndex % index of the brace '{' (error message) ) OBJECT(PrimitiveType, % primary type as returned by the composer Index % index (error message) ) Primitive Types: IDENTIFIER VARIABLE NUMBER QUOTED_ATOM ASCII_STRING SYMBOL_TOKEN SPECIAL_TOKEN ****************************************************************************/ canonical_form(ComposerTerm,CanoniTerm) :- canonical_form(ComposerTerm,CanoniTerm,_Index). %% This is to handle arguments enclosed by brackets. canonical_form(INFIX(S,Left,Right,Index),CanoniTerm,Index) :- %% Need to break associativity of these F-logic path operators. %% For example, a.b[f->g] is sent in like (a).(b[f->g]). %% But the real semantics should be ((a).(b))[f->g]. is_pathop(S), !, %% Separate the arguments of the right operator. functor_and_arguments(Right,RightFunct,Args), canonical_form(Left,LL,_Ileft), canonical_form(RightFunct,RR,Iright), arrange_arguments(Args,S,Index,LL,RR,Iright,CanoniTerm). canonical_form(INFIX(S,Left,Right,Index),CanoniTerm,Index) :- !, Funct=OBJECT(QUOTED_ATOM(S),Index), CanoniTerm=CANOTERM(Funct,2,FL_PARENTHESIS,[LL,RR],Index,NO_INDEX), canonical_form(Left,LL,_Ileft), canonical_form(Right,RR,_Iright). canonical_form(PREFIX(S,O,Index),CanoniTerm,Index) :- !, Funct=OBJECT(QUOTED_ATOM(S),Index), %% Ambiguity arises when a prefix operator is written as a functor. %% E.g., table(p,2). In such a case, it is transformed to a term. ( O=ARGUMENT(FL_PARENTHESIS,A,I1,_I2) -> CanoniTerm=CANOTERM(Funct,N,FL_PARENTHESIS,Args,Index,I1), comma_separated_list(A,Args,N) ; CanoniTerm=CANOTERM(Funct,1,FL_PARENTHESIS,[OO],Index,NO_INDEX), canonical_form(O,OO,_I) ). canonical_form(SUFFIX(S,O,Index),CanoniTerm,Index) :- !, Funct=OBJECT(QUOTED_ATOM(S),Index), CanoniTerm=CANOTERM(Funct,1,FL_PARENTHESIS,[OO],Index,NO_INDEX), canonical_form(O,OO,_I). canonical_form(FUNCTION(Funct,Arg),CanoniTerm,Index) :- !, canonical_form(Funct,F,Index), ( Arg = ARGUMENT(B,A,I1,_I2) -> CanoniTerm=CANOTERM(F,N,B,AList,Index,I1), ( B == FL_BRACKET -> N=1, AList=[T], canonical_form(A,T,_I) ; comma_separated_list(A,AList,N) ) ; Arg=ARGUMENT(B,I1,_I2) -> CanoniTerm=CANOTERM(F,0,B,[],Index,I1) ). %% Peel off pairs of `(' and `)'. canonical_form(ARGUMENT(FL_PARENTHESIS,Arg,_I1,_I2),A,Index) :- !, canonical_form(Arg,A,Index). canonical_form(ARGUMENT(FL_BRACKET,Arg,I1,_I2),CANOLIST(AList,T,N,I1,Ib),I1) :- !, %% a list ( Arg = INFIX(FL_BAR,Left,Right,Ib) -> comma_separated_list(Left,AList,N), canonical_form(Right,T,_Ir) ; T=[], Ib=NO_INDEX, comma_separated_list(Arg,AList,N) ). canonical_form(ARGUMENT(FL_BRACKET,I1,_I2),CANOLIST([],[],0,I1,NO_INDEX),I1) :- !. canonical_form(ARGUMENT(FL_BRACE,Arg,I1,_I2),CANOBRACE(AList,N,I1),I1) :- !, comma_separated_list(Arg,AList,N). canonical_form(ARGUMENT(FL_BRACE,I1,_I2),CANOBRACE([],0,I1),I1) :- !. canonical_form(OBJECT(T,I),OBJECT(T,I),I) :- !. /**************************************************************************** comma_separated_list(+ComposerTerm,-ListOfCommaSeparatedArguemnts,-Arity) This procedure is to produce a list of comma separated terms. Note that `,' is defined as right associative. Only the top level commas are considered as separating the list. ****************************************************************************/ comma_separated_list(INFIX(FL_COMMA,Left,Right,_I),[LL|RList],N) :- !, canonical_form(Left,LL,_Ileft), comma_separated_list(Right,RList,M), N is M+1. comma_separated_list(ComposerTerm,[CanoniTerm],1) :- !, canonical_form(ComposerTerm,CanoniTerm,_Index). /**************************************************************************** functor_and_arguments(+ComposerTerm,-Functor,-ArgumentsList) Flatten HiLog terms like this: F(A,B)(C,D,E) into F and [(A,B),(C,D,E)]. Each argument is separated out as a single entity. Another example is F(a,b)[f->g], which is broken into F and [(a,b), [f->g]]. ****************************************************************************/ functor_and_arguments(FUNCTION(Funct,Arg),F,AList) :- !, functor_and_arguments(Funct,F,L), append(L,[Arg],AList). functor_and_arguments(T,T,[]). /**************************************************************************** arrange_arguments(+Args,+Sym,+IndSym,+Left,+Right,+IndRight,-CanoniTerm) Args is a list of arguments, e.g., [(a,b), [f->g]]. Sym is the infix operator and IndSym is its index number. Left is the left operand. Right is the right operand and IndRight is its index. Need to break associativity of these F-logic path operators. For example, a.b[f->g] is sent in like (a).(b[f->g]). But the real semantics should be ((a).(b))[f->g]. Note that a.b[f->g] from the top level will call: arrange_arguments([[f->g]],'.',some_index,a,b,some_index,CanoniTerm). When this procedure returns, CanoniTerm should be ((a).(b))[f->g]. ****************************************************************************/ arrange_arguments([],S,Index,Left,Right,_Iright,CanoniTerm) :- !, Funct=OBJECT(QUOTED_ATOM(S),Index), CanoniTerm=CANOTERM(Funct,2,FL_PARENTHESIS,[Left,Right],Index,NO_INDEX). arrange_arguments([A|L],S,Index,Left,Right,_Iright,CanoniTerm) :- %% [f->g] is a special case. Note that a.b[f->g] should be read %% as (a.b)[f->g]. ( A = ARGUMENT(FL_BRACKET,Arg,I1,_I2) -> canonical_form(Arg,ArgTerm,_Ia), N=1, ArgList=[ArgTerm] ; A=ARGUMENT(FL_BRACKET,I1,_I2), N=0, ArgList=[] ), !, Funct=OBJECT(QUOTED_ATOM(S),Index), FunctTerm=CANOTERM(Funct,2,FL_PARENTHESIS,[Left,Right],Index,NO_INDEX), T=CANOTERM(FunctTerm,N,FL_BRACKET,ArgList,Index,I1), arrange_arguments(L,T,Index,CanoniTerm). arrange_arguments([A|L],S,Index,Left,Right,Iright,CanoniTerm) :- ( A = ARGUMENT(B,Arg,I1,_I2) -> comma_separated_list(Arg,ArgList,N) ; A=ARGUMENT(B,I1,_I2), N=0, ArgList=[] ), !, %% If the argument is not enclose by [...], then associate %% it with the right operand. RR=CANOTERM(Right,N,B,ArgList,Iright,I1), arrange_arguments(L,S,Index,Left,RR,Iright,CanoniTerm). /**************************************************************************** arrange_arguments(+Args,+CanoniTerm,+Index,-CanoniTerm) This procedure is called when the associativity of the path operator has been resolved. ****************************************************************************/ arrange_arguments([],CanoniTerm,_Index,CanoniTerm) :- !. arrange_arguments([A|L],Funct,Index,CanoniTerm) :- ( A = ARGUMENT(B,Arg,I1,_I2) -> ( B == FL_BRACKET -> canonical_form(Arg,ArgTerm,_Ia), N=1, ArgList=[ArgTerm] ; comma_separated_list(Arg,ArgList,N) ) ; A=ARGUMENT(B,I1,_I2), N=0, ArgList=[] ), !, T=CANOTERM(Funct,N,B,ArgList,Index,I1), arrange_arguments(L,T,Index,CanoniTerm). /**************************************************************************** is_pathop(+Operator) ****************************************************************************/ is_pathop(FL_ISA) :- !. is_pathop(FL_SUB) :- !. is_pathop(FL_FD) :- !. is_pathop(FL_MVD) :- !. is_pathop(FL_INHERIFD) :- !. is_pathop(FL_INHERIMVD) :- !. /**************************************************************************** utilities ****************************************************************************/ get_name(OBJECT(IDENTIFIER(Name),_I),Name) :- !. get_name(OBJECT(QUOTED_ATOM(Name),_I),Name) :- !. get_flname_struct(OBJECT(IDENTIFIER(Name),I),FLATOM(Name,I)) :- !. get_flname_struct(OBJECT(QUOTED_ATOM(Name),I),FLATOM(Name,I)) :- !. get_atom(OBJECT(SYMBOL_TOKEN(Atom),_I),Atom) :- !. get_atom(OBJECT(IDENTIFIER(Atom),_I),Atom) :- !. get_atom(OBJECT(QUOTED_ATOM(Atom),_I),Atom) :- !. get_integer(OBJECT(NUMBER(N),_I),N) :- integer(N). get_index(CANOTERM(_F,_N,B,_L,Ifunct,Ibrace),Index) :- !, ((B == FL_BRACKET; B == FL_BRACE) -> Index=Ibrace; Index=Ifunct). get_index(CANOLIST(_L,_T,_N,Index,_Ib),Index) :- !. get_index(CANOBRACE(_L,_N,Index),Index) :- !. get_index(OBJECT(_PrimitiveType,Index),Index) :- !. get_spectoken(OBJECT(SPECIAL_TOKEN(Atom),_I),Atom) :- !. /************************************************************* support for numbered anon oids *************************************************************/ get_spectoken(OBJECT(SPECIAL_TOKEN(Atom,_Num),_I),Atom) :- !. is_rule(CANOTERM(Funct,2,FL_PARENTHESIS,[Head,Body],_If,_Ip),Head,Body) :- get_name(Funct,FL_IMPLYOP). is_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[Directive],_If,_Ip),Directive) :- get_name(Funct,FL_IMPLYOP). is_query(CANOTERM(Funct,1,FL_PARENTHESIS,[Query],_If,_Ip),Query) :- get_name(Funct,FL_QUERYOP). %% Binary relationship, like : or :: is_birelop(FL_ISA) :- !. is_birelop(FL_SUB) :- !. is_objrefop(A) :- is_fdobjrefop(A), !. is_objrefop(A) :- is_mvdobjrefop(A), !. is_fdobjrefop(FL_FD) :- !. is_fdobjrefop(FL_INHERIFD) :- !. is_mvdobjrefop(FL_MVD) :- !. is_mvdobjrefop(FL_INHERIMVD) :- !. is_fdattspecop(FL_FDARROW) :- !. is_fdattspecop(FL_INFDARROW) :- !. %% Note: => and *=> are multivatued attribute specifications, because %% a[b=>{c,d}] and a[b*=>{c,d}] are legal (semantics is intersection) is_mvdattspecop(FL_FDSIGARROW) :- !. is_mvdattspecop(FL_INFDSIGARR) :- !. is_mvdattspecop(FL_MVDSIGARROW) :- !. is_mvdattspecop(FL_INMVDSIGARR) :- !. is_mvdattspecop(FL_MVDARROW) :- !. is_mvdattspecop(FL_INMVDARROW) :- !. %% +>>, *+>> is_incattspecop(FL_ALLINARROW) :- !. is_incattspecop(FL_INALLINARROW) :- !. %% ->->, *->-> is_tolistattspecop(FL_TOLISTARROW) :- !. is_tolistattspecop(FL_INTOLISTARROW) :- !. is_aggregtop(FL_MIN) :- !. is_aggregtop(FL_MAX) :- !. is_aggregtop(FL_SUM) :- !. is_aggregtop(FL_AVG) :- !. is_aggregtop(FL_COUNT) :- !. is_aggregtop(FL_COLLECTSET) :- !. is_aggregtop(FL_COLLECTBAG) :- !. is_notop(FL_NEG) :- !. is_tnotop(FL_TNOT) :- !. flrule_struct(Head,Body,FLRULE(Head,Body)). flfact_struct(Head,FLFACT(Head)). flquery_struct(Body,FLQUERY(Body)). fldirective_struct(Direct,FLDIRECTIVE(Direct)). fldynrule_struct(Head,Body,FLDYNRULE(Head,Body)). flcmddirect_struct(C,FLCOMMAND(C)). fltbldirect_struct(F,A,FLTABLE(F,A)). fltbldirect_struct(M,F,A,FLTABLE(M,F,A)). %%flargumentsdirect_struct(F,N,Args,FLARGUMENTS(F,N,Args)). %%flprlgdirect_struct(F,A,FLPROLOG(F,A)). flopdef_struct(P,A,O,FLOPDEF(P,A,O)). flindxdirect_struct(A,P,FLINDEX(A,P)). fleqldirect_struct(A,FLEQUALITY(A)). fleqldirect_struct(A,M,FLEQUALITY(A,M)). flcmpoptdirect_struct(OptList,FLCMPOPT(OptList)). %% primitive structures with index for textual information flobject_struct(OBJECT(IDENTIFIER(Atom),I),FLATOM(Atom,I)) :- !. flobject_struct(OBJECT(QUOTED_ATOM(Atom),I),FLATOM(Atom,I)) :- !. flobject_struct(OBJECT(SYMBOL_TOKEN(Atom),I),FLATOM(Atom,I)) :- !. flobject_struct(OBJECT(VARIABLE(Name),I),FLVAR(Name,I)) :- !. flobject_struct(OBJECT(NUMBER(Num),I),FLNUMBER(Num,I)) :- !. flobject_struct(OBJECT(ASCII_STRING(Str),I),FLSTRING(Str,I)) :- !. flobject_struct(OBJECT(SPECIAL_TOKEN(Atom),I),FLTOKEN(Atom,I)) :- !. %% support for numbered anon oids flobject_struct(OBJECT(SPECIAL_TOKEN(Atom,Num),I),FLTOKEN(Atom,Num,I)) :- !. is_flatom_struct(FLATOM(Atom,_I),Atom). is_flnumber_struct(FLNUMBER(_Num,_I)). is_flstring_struct(FLSTRING(_Str,_I)). get_flvar_struct(OBJECT(VARIABLE(Name),I),FLVAR(Name,I)). is_flvar_struct(FLVAR(_Name,_I)). is_anonymous_flvar_struct(FLVAR(FL_UNDERSCORE,_I)). fllist_struct(L,T,Index,FLLIST(L,T,Index)). is_fllist_struct(FLLIST(_L,_T,_I)). flcut_struct(Index,FLCUT(Index)). %% primitive structures with index for textual information flbirelate_struct(Subject,R,Object,FLBIRELATE(Subject,R,Object)). flobjref_struct(Object,M,Attribute,FLOBJREF(Object,M,Attribute)). %% Composes PARSED Funct with PARSED args to compose a parsed term %% Use flobject_struct/2 to parse Funct flterm_struct(Funct,Arity,Args,FLTERM(Funct,Arity,Args)). flaggregt_struct(Op,Var,GroupVars,Conds,FLAGGREGATE(Op,Var,GroupVars,Conds)). is_flaggregt_struct(FLAGGREGATE(_Op,_Var,_GroupVars,_Conds)). flobjspec_struct(Object,Spec,FLOBJSPEC(Object,Spec)). %% Spec represents the arrow type: ->, *->, ->, =>>, ... flfdattspec_struct(Attribute,Spec,Value,FLFDATTSPEC(Attribute,Spec,Value)). flmvdattspec_struct(Attribute,Spec,Value,FLMVDATTSPEC(Attribute,Spec,Value)). flincattspec_struct(Attribute,Spec,Value,FLINCATTSPEC(Attribute,Spec,Value)). fltolistattspec_struct(Attribute,Spec,Value,FLTOLISTATTSPEC(Attribute,Spec,Value)). is_flattspec_struct(FLFDATTSPEC(_A,_S,_V)) :- !. is_flattspec_struct(FLMVDATTSPEC(_A,_S,_V)) :- !. is_flattspec_struct(FLINCATTSPEC(_A,_S,_V)) :- !. is_flattspec_struct(FLTOLISTATTSPEC(_A,_S,_V)) :- !. flmethspec_struct(Method,FLMETHSPEC(Method)). flimethspec_struct(IMethod,FLIMETHSPEC(IMethod)). is_flimethspec_struct(FLIMETHSPEC(_IMethod)). fltranspec_struct(Tran,FLTRANSPEC(Tran)). is_fltranspec_struct(FLTRANSPEC(_Tran)). flobjeql_struct(O1,O2,FLOBJEQL(O1,O2)). flconjunct_struct(Cond1,Cond2,FLCONJUNCT(Cond1,Cond2)). fldisjunct_struct(Cond1,Cond2,FLDISJUNCT(Cond1,Cond2)). flnot_struct(Goal,FLNOT(Goal)). fltnot_struct(Goal,FLTNOT(Goal)). flload_struct(List,FLLOAD(List)). flconstraint_struct(Constr,FLCONSTRAINT(Constr)). is_flworkspace_struct(FLWORKSPACE(_G,_N)). %% Encoding these module specs: @mod @flora(mod) @prolog(mod) @prologall(mod) flmodule_struct(Literal,WSName,FLORAUSERMOD,FLWORKSPACE(Literal,WSName)) :- !. flmodule_struct(Literal,Module,FLORASYSMOD,FLFLORALIB(Literal,Module)). :- !. flmodule_struct(Goal,Name,PROLOGMODULE,FLPLIB(Goal,Name)). :- !. flmodule_struct(Goal,Name,PROLOGALLMODULE,FLPLIBALL(Goal,Name)). :- !. %% Encoding module specs of the form @prolog() and @prologall() %% Takes a goal and protects it against hilog conversion flplib_struct(Goal,FLPLIB(Goal)) :- !. flpliball_struct(Goal,FLPLIBALL(Goal)) :- !. %% Given module spec, get back module type and module name get_module_from_spec(FLORAUSERMOD(Mod),FLORAUSERMOD,Mod) :- !. get_module_from_spec(FLORASYSMOD(Mod),FLORASYSMOD,Mod) :- !. get_module_from_spec(PROLOGMODULE(Mod),PROLOGMODULE,Mod) :- !. get_module_from_spec(PROLOGMODULE,NULL) :- !. get_module_from_spec(PROLOGALLMODULE(Mod),PROLOGALLMODULE,Mod) :- !. get_module_from_spec(PROLOGALLMODULE,NULL) :- !. is_flmodulespec_struct(FLWORKSPACE(_G,_N)) :- !. is_flmodulespec_struct(FLPLIB(_G)) :- !. is_flmodulespec_struct(FLPLIB(_G,_N)) :- !. is_flmodulespec_struct(FLFLORALIB(_L,_M)) :- !. is_flmodulespec_struct(FLPLIBALL(_G)) :- !. is_flmodulespec_struct(FLPLIBALL(_G,_N)) :- !. is_dbinsertop(FL_INSERT) :- !. is_dbinsertop(FL_INSERTALL) :- !. is_dbinsertop(FL_BTINSERT) :- !. is_dbinsertop(FL_BTINSERTALL) :- !. is_dbdeleteop(FL_DELETE) :- !. is_dbdeleteop(FL_DELETEALL) :- !. is_dbdeleteop(FL_ERASE) :- !. is_dbdeleteop(FL_ERASEALL) :- !. is_dbdeleteop(FL_BTDELETE) :- !. is_dbdeleteop(FL_BTDELETEALL) :- !. is_dbdeleteop(FL_BTERASE) :- !. is_dbdeleteop(FL_BTERASEALL) :- !. is_tablerefreshop(FL_REFRESH) :- !. is_catchop(FL_CATCH) :- !. is_throwop(FL_THROW) :- !. is_p2hop(FL_P2H) :- !. is_ruleupdateop(FL_INSERTRULE_A) :- !. is_ruleupdateop(FL_INSERTRULE_Z) :- !. is_ruleupdateop(FL_DELETERULE_A) :- !. is_ruleupdateop(FL_DELETERULE_Z) :- !. is_ruleupdateop(FL_DELETERULE) :- !. is_reifyop(FL_REIFYOP) :- !. flrefresh_struct(List,FLREFRESH(List)). flinsert_struct(Op,List,Cond,FLINSERT(Op,List,Cond)). flinsert_struct(Op,List,FLINSERT(Op,List)). fldelete_struct(Op,List,Cond,FLDELETE(Op,List,Cond)). fldelete_struct(Op,List,FLDELETE(Op,List)). flnewmodule_struct(Op,Mod,FLNEWMODULE(Op,Mod)). flupdaterule_struct(Op,RuleList,FLUPDATERULE(Op,RuleList)). flifthenelse_struct(Cond,Then,Else,FLIFTHENELSE(Cond,Then,Else)). flifthen_struct(Cond,Then,FLIFTHEN(Cond,Then)). %% struct for meta ~ fluniveqform_struct(Left,Right,FLUNIVEQFORM(Left,Right)). %% struct for =.. flmetauniv_struct(Left,Right,FLMETAUNIV(Left,Right)). %% struct for ~.. flmetaunivform_struct(Left,Right,FLMETAUNIVFORM(Left,Right)). %% struct for ${...} flreify_struct(Formula,FLREIFYOP(Formula)). is_flreify_struct(FLREIFYOP(_Formula)). flcatch_struct(Goal,Error,Handler,FLCATCH(Goal,Error,Handler)). flthrow_struct(Error,FLTHROW(Error)). flp2h_struct(Prolog,Hilog,FLP2H(Prolog,Hilog)). flcontrolconstruct_struct(Cond,Action,FLWHILEDO,FLWHILEDO(Cond,Action)). flcontrolconstruct_struct(Cond,Action,FLWHILELOOP,FLWHILELOOP(Cond,Action)). flcontrolconstruct_struct(Cond,Action,FLDOUNTIL,FLDOUNTIL(Cond,Action)). flcontrolconstruct_struct(Cond,Action,FLLOOPUNTIL,FLLOOPUNTIL(Cond,Action)). flcontrolconstruct_struct(Cond,Action,FLUNLESSDO,FLUNLESSDO(Cond,Action)). %% Arg 1: parser's wrapper for control construct %% Arg 2: top-level keyword of control construct %% Arg 3: second keyword of construct get_control_construct_definition(FLWHILEDO,FL_WHILE,FL_DO). get_control_construct_definition(FLWHILELOOP,FL_WHILE,FL_LOOP). get_control_construct_definition(FLDOUNTIL,FL_DO,FL_UNTIL). get_control_construct_definition(FLLOOPUNTIL,FL_LOOP,FL_UNTIL). get_control_construct_definition(FLUNLESSDO,FL_UNLESS,FL_DO). /**************************************************************************** parsing_error(+IndexOrTerm,+ErrorMessage,-Status) Note on handling the Status parameter in parsing predicates: If a call to a parsing predicate comes with non-empty Status, DO NOT call parsing_error/3, but rather pass the Status parameter up to the caller. Status must ALWAYS be unbound ****************************************************************************/ parsing_error(Index,ErrorMessage,Status) :- integer(Index), !, Status=[error(Index,ErrorMessage)]. parsing_error(CanoniTerm,ErrorMessage,Status) :- get_index(CanoniTerm,I), Status=[error(I,ErrorMessage)]. /**************************************************************************** flora_parse(+ComposerTerm,-Code,-Status) is the top level dispatcher. ****************************************************************************/ flora_parse(NULL,NULL,[]) :- !. flora_parse(ComposerTerm,Code,Status) :- canonical_form(ComposerTerm,CanoniTerm), ( is_rule(CanoniTerm,Head,Body) -> flora_parse_rule(Head,Body,Code,Status) ; is_directive(CanoniTerm,Directive) -> flora_parse_directive(Directive,Code,Status) ; is_query(CanoniTerm,Query) -> flora_parse_query(Query,Code,Status) ; %% flora_parse_fact must be the last one to call. flora_parse_fact(CanoniTerm,Code,Status) ), !. %% This rule is for debugging. flora_parse(_ComposerTerm,_Code,[error(UNKNOWN_ERROR)]). /**************************************************************************** flora_parse_directive(+CanoniTerm,-Code,-Status) is the dispatcher for directives. Code: FLDIRECTIVE([directives+]) Note: Textual information is not reserved for compiler directives. ****************************************************************************/ flora_parse_directive(CanoniTerm,Code,Status) :- ( flora_table_directive(CanoniTerm,CodeList,Status) %% ; flora_arguments_directive(CanoniTerm,CodeList,Status) ; flora_operator_directive(CanoniTerm,CodeList,Status) ; flora_index_directive(CanoniTerm,CodeList,Status) ; flora_command_directive(CanoniTerm,CodeList,Status) ; flora_equality_directive(CanoniTerm,CodeList,Status) ; flora_cmpopt_directive(CanoniTerm,CodeList,Status) ), fldirective_struct(CodeList,Code), !. flora_parse_directive(CanoniTerm,_Code,Status) :- parsing_error(CanoniTerm,UNKNOWN_DIRECT,Status). /**************************************************************************** flora_exec_directive(+CanoniTerm,-Code,-Status) Code: FLDIRECTIVE([directives]) Note: This is to parse those executable directives either from a shell or inside a program. Normal directives only affect how a single program is translated. Executable directives affect the translation of all subsequent command entered from the shell. ****************************************************************************/ flora_exec_directive(CanoniTerm,Code,Status) :- fldirective_struct(CodeList,Code), ( flora_exec_table_directive(CanoniTerm,CodeList,Status) %%; flora_arguments_directive(CanoniTerm,CodeList,Status) ; flora_operator_directive(CanoniTerm,CodeList,Status) ; flora_exec_index_directive(CanoniTerm,CodeList,Status) ; flora_exec_equality_directive(CanoniTerm,CodeList,Status) ), !. /**************************************************************************** flora_command_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_command_directive(CanoniTerm,[Code],[]) :- get_atom(CanoniTerm,D), flora_is_command_directive(D), flcmddirect_struct(D,Code). /**************************************************************************** Listed as follows are those parser directives that look like commands. ****************************************************************************/ flora_is_command_directive(spec_repr) :- !. flora_is_command_directive(spec_off) :- !. flora_is_command_directive(spec_dump) :- !. flora_is_command_directive(ti_dump) :- !. flora_is_command_directive(ti_long_names) :- !. flora_is_command_directive(ti_all) :- !. flora_is_command_directive(ti_off_all) :- !. /**************************************************************************** flora_comma_separated_list(+CanoniTerm,-CanoniTermList) ****************************************************************************/ flora_comma_separated_list(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),[L|RList]) :- %% Comma as an operator is right associative. get_atom(Funct,FL_COMMA), !, flora_comma_separated_list(R,RList). flora_comma_separated_list(CanoniTerm,[CanoniTerm]) :- !. /**************************************************************************** flora_table_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_table_directive(CANOTERM(Funct,N,FL_PARENTHESIS,[T|_Rest],_If,_Ip),CodeList,Status) :- get_name(Funct,FL_TABLE), ( N==1 -> flora_commasep_sklist(T,SkList,Status), (Status == [] -> flora_table_directlist(SkList,CodeList); true) ; parsing_error(T,ERROR_TABLE,Status) ). flora_table_directlist([],[]) :- !. flora_table_directlist([F/A|L],[Code|CL]) :- !, fltbldirect_struct(F,A,Code), flora_table_directlist(L,CL). flora_table_directlist([],_M,[]) :- !. flora_table_directlist([F/A|L],M,[Code|CL]) :- !, fltbldirect_struct(M,F,A,Code), flora_table_directlist(L,CL). flora_commasep_sklist(CanoniTerm,SkList,Status) :- flora_comma_separated_list(CanoniTerm,TermList), flora_sklist(TermList,SkList,Status). flora_sklist([],[],[]) :- !. flora_sklist([T|TList],[Funct/Aritys|SkList],Status) :- !, flora_sktuple(T,Funct,Aritys,S,0), (S == [] -> flora_sklist(TList,SkList,Status); Status=S). flora_sktuple(CANOTERM(T,2,FL_PARENTHESIS,[Funct,Arity],_If,_Ip),F,A,Status,Depth) :- Depth < FLSK_DEPTH, get_atom(T,FL_SLASH), !, ( get_integer(Arity,AT), AT>=0 -> flobject_struct(Arity,A1), ( flobject_struct(Funct,F), (is_flatom_struct(F,_);is_flvar_struct(F)) -> A=A1, Status=[] ; NewDepth is Depth+1, ( flora_sktuple(Funct,F,AH,Status,NewDepth) -> ( Status==[] -> flobject_struct(T, Slash), flterm_struct(Slash,2,[AH,A1],A) ; true ) ; parsing_error(Funct,EXP_VARORATOM,Status) ) ) ; parsing_error(Arity,EXP_POSINTEGER,Status) ). flora_sktuple(CanoniTerm,_F,_A,Status,Depth) :- (Depth > FLSK_DEPTH; Depth = FLSK_DEPTH), !, parsing_error(CanoniTerm,EXP_VARORATOM,Status). flora_sktuple(CanoniTerm,_F,_A,Status,_Depth) :- parsing_error(CanoniTerm,ERROR_SKELETON,Status). /**************************************************************************** flora_exec_table_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_exec_table_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[T],_If,_Ip),CodeList,Status) :- get_name(Funct,FL_TABLE), flora_commasep_sklist(T,SkList,Status), (Status == [] -> flora_table_directlist(SkList,CodeList); true). flora_exec_table_directive(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,Ip),CodeList,Status) :- get_name(Funct,FL_TABLE), ( flora_name_or_normvar(L,M) -> flora_commasep_sklist(R,SkList,Status), (Status == [] -> flora_table_directlist(SkList,M,CodeList); true) ; parsing_error(Ip,ERROR_TABLE,Status) ). flora_exec_table_directive(CANOTERM(Funct,_N,FL_PARENTHESIS,_T,_If,Ip),_CodeList,Status) :- get_name(Funct,FL_TABLE), parsing_error(Ip,ERROR_TABLE,Status). /**************************************************************************** flora_arguments_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ /** DEPRECATED flora_arguments_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[T],_If,_Ip),CodeList,Status) :- get_atom(Funct,FL_ARGUMENTS), flora_comma_separated_list(T,TList), flora_arglist(TList,CodeList,Status). **/ /**************************************************************************** flora_arglist(+CanoniTermList,-CodeList,-Status) ****************************************************************************/ /** DEPRECATED flora_arglist([],[],[]) :- !. flora_arglist([T|TList],[C|CList],Status) :- !, flora_functarg(T,Funct,Arity,Args,S), ( S == [] -> ( flora_conflict_arguments(Funct,Arity,Args) -> parsing_error(T,NO_REDEFARG,Status) ; flargumentsdirect_struct(Funct,Arity,Args,C), flora_arglist(TList,CList,Status) ) ; Status=S ). **/ /**************************************************************************** flora_functarg(+CanoniTerm,-Funct,-Arity,-Args,-Status) flora_argspec(+CanoniTermList,-SpecList,-Status) ****************************************************************************/ /** DEPRECATED flora_functarg(CANOTERM(Funct,N,FL_PARENTHESIS,Args,If,Ip),F,N,A,Status) :- !, ( N == 0 -> parsing_error(Ip,ERROR_ARGUMENTS,Status) ; get_atom(Funct,F) -> flora_argspec(Args,A,Status) ; parsing_error(If,EXP_ATOMICFUNCT,Status) ). flora_functarg(CanoniTerm,_F,_N,_A,Status) :- parsing_error(CanoniTerm,ERROR_ARGUMENTS,Status). flora_argspec([],[],[]) :- !. flora_argspec([CanoniTerm|CanoniTermList],[A|AL],Status) :- get_name(CanoniTerm,A), ( (A == FL_OID; A == FL_BODYFORMULA) -> flora_argspec(CanoniTermList,AL,Status) ; parsing_error(CanoniTerm,ERROR_ARGTYPE,Status) ). **/ /**************************************************************************** flora_operator_directive(CanoniTerm,CodeList,Status) flora_operator_definition(+Atom) operator_list(+Number,+Associativity,+OperatorList,-CodeList,-Status) ****************************************************************************/ flora_operator_directive(CANOTERM(Funct,3,FL_PARENTHESIS,L,_If,_Ip),CodeList,Status) :- get_name(Funct,FL_OP), L=[Number,Associativity,Operator], ( get_integer(Number,Precedence), Precedence > 0 -> ( get_name(Associativity,A), flora_operator_definition(A) -> ( get_atom(Operator,Op) -> ( flora_conflict_operator(Precedence,A,Op) -> parsing_error(Operator,NO_REDEFOP,Status) ; flopdef_struct(Precedence,A,Op,Code), CodeList=[Code], Status=[] ) ; Operator=CANOLIST(OpList,T,N,_I,Ib), N > 0 -> ( T == [] -> flora_operator_list(OpList,Precedence,A,CodeList,Status) ; parsing_error(Ib,NO_LISTTAIL,Status) ) ; parsing_error(Operator,ERROR_OPERATOR,Status) ) ; parsing_error(Associativity,ERROR_OPDEF,Status) ) ; parsing_error(Number,EXP_POSINTEGER,Status) ). flora_operator_definition(xfx) :- !. flora_operator_definition(yfx) :- !. flora_operator_definition(xfy) :- !. flora_operator_definition(fx) :- !. flora_operator_definition(fy) :- !. flora_operator_definition(yf) :- !. flora_operator_definition(xf) :- !. flora_operator_list([],_Number,_Associativity,[],[]) :- !. flora_operator_list([T|L],Number,Associativity,[Code|CodeList],Status) :- !, ( get_atom(T,Op) -> %% symbol tokens allowed as operators ( flora_conflict_operator(Number,Associativity,Op) -> parsing_error(T,NO_REDEFOP,Status) ; flopdef_struct(Number,Associativity,Op,Code), flora_operator_list(L,Number,Associativity,CodeList,Status) ) ; parsing_error(T,ERROR_OPERATOR,Status) ). /**************************************************************************** flora_index_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_index_directive(CANOTERM(Funct,N,FL_PARENTHESIS,[L|_Rest],_If,_Ip),[Code],Status) :- get_name(Funct,FL_INDEX), ( N==1 -> ( minus_pair(L,Arity,Pos) -> Status=[], flindxdirect_struct(Arity,Pos,Code) ; parsing_error(L,ERROR_INDXDIREC,Status) ) ; parsing_error(L,ERROR_INDXDIREC,Status) ). minus_pair(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),Arity,Pos) :- get_name(Funct,FL_MINUS), get_integer(L,Arity), get_integer(R,Pos), Pos>0, Arity>=Pos. /**************************************************************************** flora_exec_index_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_exec_index_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[L],_If,_Ip),[Code],Status) :- get_name(Funct,FL_INDEX), ( minus_var_pair(L,Arity,Pos) -> Status=[], flindxdirect_struct(Arity,Pos,Code) ; parsing_error(L,ERROR_INDXDIREC,Status) ). flora_exec_index_directive(CANOTERM(Funct,_N,FL_PARENTHESIS,_T,_If,Ip),[_Code],Status) :- get_name(Funct,FL_INDEX), parsing_error(Ip,ERROR_INDXDIREC,Status). minus_var_pair(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),Arity,Pos) :- get_name(Funct,FL_MINUS), ( get_integer(L,A) -> flobject_struct(L,Arity), ( get_integer(R,P) -> P>0, A>=P, flobject_struct(R,Pos) ; get_flvar_struct(R,Pos) ) ; get_flvar_struct(L,Arity), ( get_integer(R,P) -> flobject_struct(R,Pos) ; get_flvar_struct(R,Pos) ) ). /**************************************************************************** flora_equality_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_equality_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[T],_If,_Ip),[Code],Status) :- get_name(Funct,FL_EQUALITY), !, ( get_name(T,A), (A == NONE; A == BASIC; A == FLOGIC) -> fleqldirect_struct(A,Code), Status=[] ; parsing_error(T,ERROR_EQLSPEC,Status) ). /**************************************************************************** flora_exec_equality_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_exec_equality_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[T],_If,_Ip), [Code],Status) :- get_name(Funct,FL_EQUALITY), T=CANOTERM(F,2,FL_PARENTHESIS,[L,R],_IFf,_IFp), get_name(F,FL_IN), !, ( flora_name_or_normvar(R,M) -> ( (get_name(L,A), (A == NONE; A == BASIC; A == FLOGIC); get_flvar_struct(L,A)) -> fleqldirect_struct(A,M,Code), Status=[] ; parsing_error(L,ERROR_EQLSPEC,Status) ) ; parsing_error(R,ERROR_WSNAME,Status) ). flora_exec_equality_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[T],_If,_Ip), [Code],Status) :- get_name(Funct,FL_EQUALITY), !, ( (get_name(T,A), (A == NONE; A == BASIC; A == FLOGIC); get_flvar_struct(T,A)) -> fleqldirect_struct(A,Code), Status=[] ; parsing_error(T,ERROR_EQLSPEC,Status) ). /**************************************************************************** flora_cmpopt_directive(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_cmpopt_directive(CANOTERM(Funct,1,FL_PARENTHESIS,[T],_If,_Ip), [Code],Status) :- get_name(Funct,FL_CMPOPT), ( T=CANOLIST(List,[],_N,_I,_Ib) -> flora_cmpoptlist(List,TCode,Status), ( Status == [] -> flcmpoptdirect_struct(TCode,Code) ; true ) ; parsing_error(T,EXP_OPTLIST,Status) ). flora_cmpoptlist([],[],[]) :- !. flora_cmpoptlist([H|T],[HCode|TCode],Status) :- ( get_atom(H,HCode) -> flora_cmpoptlist(T,TCode,Status) ; parsing_error(H,ERROR_CMPOPT,Status) ). /**************************************************************************** flora_parse_fact(+CanoniTerm,-Code,-Status) ****************************************************************************/ flora_parse_fact(CanoniTerm,NULL,Status) :- %% Handle special markups for include files that are generated by gpp. flora_gpp_markup(CanoniTerm,Status), !. flora_parse_fact(CanoniTerm,Code,Status) :- flora_head(CanoniTerm,CodeList,Status), flfact_struct(CodeList,Code). /**************************************************************************** flora_parse_query(+CanoniTerm,-Code,-Status) ****************************************************************************/ flora_parse_query(CanoniTerm,Code,Status) :- flora_body(CanoniTerm,Goal,Status), flquery_struct(Goal,Code). /**************************************************************************** flora_parse_rule(+Head,+Body,-Code,-Status) ****************************************************************************/ flora_parse_rule(Head,Body,Code,Status) :- flora_head(Head,HeadCodeList,S), ( S == [] -> flora_body(Body,BodyCode,Status), flrule_struct(HeadCodeList,BodyCode,Code) ; Status=S ). /**************************************************************************** flora_gpp_markup(+CanoniTerm,+Status) ****************************************************************************/ flora_gpp_markup(CanoniTerm,[]) :- get_name(CanoniTerm,FLORA_GPP_MARKUP), %% This is just a delimeter for the purpose of fault tolerance. %% Skip it. !. flora_gpp_markup(CANOTERM(Funct,3,FL_PARENTHESIS,[Arg1,Arg2,Arg3],_If,_Ip),Status) :- get_name(Funct,FLORA_GPP_MARKUP), !, ( ( get_name(Arg3,'') -> %% This is the top level file name. Reset line number. flora_reset_charpos ; get_name(Arg3,'1') -> %% This is the beginning of a include file. get_name(Arg2,FileName), flora_begin_file(FileName) ; get_name(Arg3,'2') -> %% This is the end of a include file. get_integer(Arg1,LineNumber), flora_end_file(LineNumber) ), Status=[], ! ; Status=[error(ERROR_GPP)] ). /**************************************************************************** flora_head(+CanoniTerm,-CodeList,-Status) This predicate is called to parse the head of a rule, which is a canonical term. Since only conjunction is allowed in a rule head, the result of parsing it is a list of intermidiate terms. Note: Module name is not allowed in rule head. ****************************************************************************/ flora_head(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),CodeList,Status) :- get_atom(Funct,F), ( F == FL_COMMA -> flora_head(L,LCodeList,S), ( S == [] -> flora_head(R,RCodeList,Status), ( Status == [] -> append(LCodeList,RCodeList,CodeList) ; true ) ; Status=S ) ; F == FL_SEMICOLON -> % Disjunction is prohibited. parsing_error(If,NO_DISJUNCTION,Status) ; % Module name in rule head is prohibited. F == FL_AT, parsing_error(If,NO_WSINRULEHEAD,Status) ), !. flora_head(CANOTERM(Funct,1,FL_PARENTHESIS,[_G],If,_Ip),_CodeList,Status) :- get_atom(Funct,F), (is_notop(F); is_tnotop(F)), !, parsing_error(If,NO_NEGATION,Status). flora_head(CanoniTerm,[Code],Status) :- flora_head_literal(CanoniTerm,Code,Status). /**************************************************************************** flora_head_literal(+CanoniTerm,-HeadLiteral,-Status) parses a single literal in the head of a rule. Look for the grammar at the beginning to see what is allowed. ****************************************************************************/ flora_head_literal(CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,F), is_birelop(F), !, flora_head_pathexplist(Args,[LCode,RCode],Status), (Status == [] -> flbirelate_struct(LCode,F,RCode,Code); true). flora_head_literal(CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_Code,Status) :- get_atom(Funct,F), is_objrefop(F), !, parsing_error(If,ERROR_HDLITERAL,Status). flora_head_literal(CANOTERM(Funct,N,FL_PARENTHESIS,_Args,If,_Ip),_Code,Status) :- get_atom(Funct,F), flora_nodefp(F,N), !, parsing_error(If,NO_REDEFINITION,Status). flora_head_literal(CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,FL_OBJEQL), !, %% equality definition fact/rule flora_head_pathexplist(Args,[LCode,RCode],Status), (Status == [] -> flobjeql_struct(LCode,RCode,Code); true). flora_head_literal(CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- !, flora_head_term(Funct,N,Args,Code,Status). flora_head_literal(CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_head_objspec(Funct,N,Args,Code,Status). flora_head_literal(CanoniTerm,Code,Status) :- get_atom(CanoniTerm,A), !, ( flora_nodefp(A,0) -> parsing_error(CanoniTerm,ERROR_HDLITERAL,Status) ; flobject_struct(CanoniTerm,Code), Status=[] ). flora_head_literal(CanoniTerm,_Code,Status) :- !, parsing_error(CanoniTerm,ERROR_HDLITERAL,Status). /**************************************************************************** flora_body(+CanoniTerm,-Goal,-Status) This predicate is called to parse the *entire* body of a rule. It takes a canonical term as input and parses it into an intermediate term to be compiled further. "CanoniTerm" can represent any logical formula of conjunction, disjunction, and negation. "Goal" is parsed accordingly. If success, "Status" is bound to [], or some warning message; otherwise, it is a list containing some error message. flora_body(+CanoniTerm,+WorkSpace,-Goal,-Status) Note: Module name specification is distributive over negation, conjunction and disjunction in the rule body. It works like nesting of variable scope. Module name specification is also allowed in the position of predicate arguments, e.g., p(o[att -> val] @ ws). Moreover, module name specification is also distributive over if-then-else statement. For example, (if a then b else c)@mod has the same effect as (if a@mod then b@mod else c@mod). ****************************************************************************/ flora_body(CanoniTerm,Goal,Status) :- flora_body(CanoniTerm,NULL,Goal,Status). flora_body(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),WS,Code,Status) :- get_atom(Funct,F), (F == FL_COMMA; F == FL_SEMICOLON), !, % Module name is distributive over conjunction or disjunction. flora_body(L,WS,LCode,S), ( S == [] -> flora_body(R,WS,RCode,Status), ( Status == [] -> ( F == FL_COMMA -> flconjunct_struct(LCode,RCode,Code) ; fldisjunct_struct(LCode,RCode,Code) ) ; true ) ; Status=S ). flora_body(CANOTERM(Funct,1,FL_PARENTHESIS,[G],_If,_Ip),WS,Code,Status) :- get_atom(Funct,F), (is_notop(F); is_tnotop(F)), !, % Module name is distributive over negation. flora_body(G,WS,C,Status), ( Status == [] -> (is_notop(F) -> flnot_struct(C,Code); fltnot_struct(C,Code)) ; true ). flora_body(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),_WS,Code,Status) :- get_atom(Funct,FL_AT), !, % nesting of module name scope %% The module name needs to be parsed early; otherwise, some %% incorrect syntax may be overridden by nesting module specification. flora_workspace(R,RCode,S), (S == [] -> flora_body(L,RCode,Code,Status); Status=S). %% reify op ${...} that occurs as a formula flora_body(CANOTERM(Funct,1,FL_BRACE,[Arg],_If,_Ip),_WS,Code,Status) :- get_atom(Funct,Atom), is_reifyop(Atom), !, flora_body(Arg,Code,Status). %% At this point, CanoniTerm is not a logical formula. flora_body(CANOTERM(Funct,1,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status) :- get_name(Funct,FL_IF), !, %% Module name is distributive over if-then-else statement. flora_body_ifthenelse(CANOTERM(Funct,1,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status). flora_body(CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_WS,_Code,Status) :- get_name(Funct,FL_THEN), !, parsing_error(If,ERROR_THENBODY,Status). flora_body(CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_WS,_Code,Status) :- get_name(Funct,FL_ELSE), !, parsing_error(If,ERROR_ELSEBODY,Status). %% Parse the ~ meta predicate flora_body(CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status) :- get_name(Funct,FL_UNIVEQFORM), !, flora_body_univeqform(CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status). %% Parse the =.. meta predicate %% Workspace as in (A=..B)@foo is illegal. But (A@foo =.. B) is fine. flora_body(CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status) :- get_name(Funct,FL_METAUNIV), !, flora_body_metauniv(CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status). %% Parse the ~.. meta predicate %% Workspace as in (A~..B)@foo is illegal. But (A@foo =.. B) is fine. flora_body(CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status) :- get_name(Funct,FL_METAUNIVFORM), !, flora_body_metaunivform(CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,Ip),WS,Code,Status). %% Process the control constructs while-do/loop, loop/do-until, unless-do flora_body(CANOTERM(TopWrapper,1,FL_PARENTHESIS,Args,_If,_Ip), WS,Code,Status) :- get_name(TopWrapper,TopName), get_control_construct_definition(_CtlWrapper,TopName,_InnerName), !, %% Args should be [CanonTerm]. If not, will issue a syntax error flora_body_controlconstruct(Args,WS,TopName,Code,Status). %% If inner keyword of ctl construct occurs at the top level -- error flora_body(CANOTERM(TopWrapper,2,_Paren,_Args,If,_Ip), _WS,_Code,Status) :- get_name(TopWrapper,TopName), get_control_construct_definition(_,_,TopName), !, parsing_error(If,UNEXPECTED_CONTROL,Status). %% At this point, CanoniTerm is neither a logical formula nor a %% if-then-else statement, nor some other special builtin %% (like while-loops or meta operators) flora_body(CanoniTerm,NULL,Code,Status) :- !, %% no module name flora_body_literal(CanoniTerm,Code,Status). %% @prolog() flora_body(CanoniTerm,PROLOGMODULE,Code,Status) :- !, %% Prolog builtin flora_prlgterm(CanoniTerm,TCode,Status), (Status == [] -> flplib_struct(TCode,Code); true). %% @prolog(...) flora_body(CanoniTerm,PrologModuleSpec,Code,Status) :- get_module_from_spec(PrologModuleSpec,PROLOGMODULE,Mod), !, %% Prolog module flora_prlgterm(CanoniTerm,TCode,Status), (Status == [] -> flmodule_struct(TCode,Mod,PROLOGMODULE,Code); true). %% @prologall() flora_body(CanoniTerm,PROLOGALLMODULE,Code,Status) :- !, %% Prolog builtin flora_pure_term(CanoniTerm,TCode,Status1), ( is_flvar_struct(TCode) -> parsing_error(CanoniTerm,ERROR_PRLGLIT,Status2), Status=Status2 ; Status1 == [] -> flpliball_struct(TCode,Code), Status=Status1 ; Status=Status1 ). %% @prologall(...) flora_body(CanoniTerm,PrologModuleSpec,Code,Status) :- get_module_from_spec(PrologModuleSpec,PROLOGALLMODULE,Mod), !, %% Prolog module flora_pure_term(CanoniTerm,TCode,Status1), ( is_flvar_struct(TCode) -> parsing_error(CanoniTerm,ERROR_PRLGLIT,Status2), Status=Status2 ; Status1 == [] -> flmodule_struct(TCode,Mod,PROLOGALLMODULE,Code), Status=Status1 ; Status=Status1 ). %% @module or @flora(...) flora_body(CanoniTerm,FloraModSpec,Code,Status) :- get_module_from_spec(FloraModSpec,ModuleType,Module), !, %% Flora user or system module flora_body_wsliteral(CanoniTerm,TCode,Status), (Status == [] -> flmodule_struct(TCode,Module,ModuleType,Code) ; true ). /**************************************************************************** flora_workspace(+CanoniTerm,-WSCode,-Status) This predicate is called to parse the module name of a workspace specification. Three types of module names are allowed: (1) Prolog module, e.g., @prolog(basics), @prolog() @prologall(basics), @prologall() WSCode=PROLOGMODULE(name), or PROLOGMODULE WSCode=PROLOGALLMODULE(name), or PROLOGALLMODULE (2) Flora system module, e.g., @flora(io), @flora(pp). Unlike prolog module, @flora() is not allowed. WSCode=FLORASYSMOD(name) (3) Flora user module, which could be either an atom or a variable. WSCode=FLORAUSERMOD(name), or FLORAUSERMOD(var) Note: Textual information is reserved for module names. ****************************************************************************/ %% Handle Flora user module specification. (@ M) flora_workspace(CanoniTerm,FLORAUSERMOD(NVCode),[]) :- flora_name_or_normvar(CanoniTerm,NVCode), !. %% Handle THIS MODULE specification, e.g., a[b->c]@ _@. flora_workspace(CanoniTerm,FLORAUSERMOD(ThisModToken),[]) :- %% When _@ is specified as a module, we treat it %% syntactically as FLORAUSERMOD because it is an atom %% and not flora(...). However, this gets substituted with %% FLORA_THIS_MODULE_NAME, so at compile time we get the right %% module even if the current module was a system module get_spectoken(CanoniTerm,FL_THISMODULE), !, flobject_struct(CanoniTerm,ThisModToken). %% Handle a Prolog module. (@ prolog()) flora_workspace(CANOTERM(Mod,0,FL_PARENTHESIS,[],_Ifu,_Ipa),PROLOGMODULE,[]) :- get_name(Mod,FL_PLIB), !. flora_workspace(CANOTERM(Mod,1,FL_PARENTHESIS,[M],_Ifu,_Ipa),PROLOGMODULE(MCode),Status) :- %% Check if it is a Prolog module. (@prolog(xsbmod)) get_name(Mod,FL_PLIB), !, (get_flname_struct(M,MCode) -> Status=[] ; parsing_error(M,ERROR_WSNAME,Status)). %% @prologall() workspace flora_workspace(CANOTERM(Mod,0,FL_PARENTHESIS,[],_Ifu,_Ipa),PROLOGALLMODULE,[]) :- get_name(Mod,FL_PLIBALL), !. %% @prologall(module) workspace flora_workspace(CANOTERM(Mod,1,FL_PARENTHESIS,[M],_Ifu,_Ipa),PROLOGALLMODULE(MCode),Status) :- get_name(Mod,FL_PLIBALL), !, (get_flname_struct(M,MCode) -> Status=[] ; parsing_error(M,ERROR_WSNAME,Status) ). flora_workspace(CANOTERM(Mod,1,FL_PARENTHESIS,[M],_Ifu,_Ipa),FLORASYSMOD(MCode),Status) :- %% Check if it is a Flora system module specification. (@flora(mod)) get_name(Mod,FL_FLORALIB), !, ( get_name(M,MAtom) -> ( flora_system_module(MAtom) -> get_flname_struct(M,MCode), Status=[] ; parsing_error(M,UNREG_SYSMOD,Status) ) ; parsing_error(M,ERROR_WSNAME,Status) ). flora_workspace(CanoniTerm,_WSCode,Status) :- parsing_error(CanoniTerm,ERROR_WSNAME,Status). /**************************************************************************** flora_body_ifthenelse(+CanoniTerm,+Workspace,-Code,-Status) parses an if-then-else statement. "Workspace" is the module name specified for the entire statement and should be distributed over the substatements inside. ****************************************************************************/ flora_body_ifthenelse(CanoniTerm,WS,Code,Status) :- flora_body_ifthenelse(CanoniTerm,WS,NK,_NT,Code,S), ( S \== [] -> Status=S ; NK == [] -> Status=[] ; NK = then(Index) -> parsing_error(Index,UNEXPECTED_THEN,Status) ; NK = else(Index) -> parsing_error(Index,UNEXPECTED_ELSE,Status) ). /**************************************************************************** flora_body_ifthenelse(+CanoniTerm,+Workspace,-NextKeyword,-NextTerm,-Code,-Status). Takes a canonical term (which represents a stream of tokens) and parses a normal statement at the beginning of it. Moreover, it returns the next immediate keyword and the residual canonical term (which represents the rest of the token stream). If NextKeyword is [], then NextTerm is []. Otherwise, NextKeyword is either then(Index) or else(Index) (here Index is the index number of the keyword that can be used to generate an error message). Status denotes success/failure when the beginning of the token stream is parsed. This procedure complements flora_body/4 and handles the distribution of module name over if-then-else statements. ****************************************************************************/ flora_body_ifthenelse(CANOTERM(Funct,1,FL_PARENTHESIS,[CTerm],If,_Ip),WS, NextKeyword,NextTerm,Code,Status) :- get_name(Funct,FL_IF), !, flora_body_ifthenelse(CTerm,WS,NK1,NT1,CondStruct,S1), ( S1 == [] -> ( NK1 = then(_IThen) -> flora_body_ifthenelse(NT1,WS,NK2,NT2,ThenStruct,S2), ( S2 == [] -> ( NK2 = else(_IElse) -> flifthenelse_struct(CondStruct,ThenStruct,ElseStruct,Code), flora_body_ifthenelse(NT2,WS,NextKeyword,NextTerm,ElseStruct,Status) ; flifthen_struct(CondStruct,ThenStruct,Code), NextKeyword=NK2, NextTerm=NT2, Status=[] ) ; Status=S2 ) ; NK1 == [] -> parsing_error(If,MISSING_THEN,Status) ; NK1 = else(IElse) -> parsing_error(IElse,MISSING_THEN,Status) ) ; Status=S1 ). flora_body_ifthenelse(CANOTERM(Funct,2,FL_PARENTHESIS,[STerm,NextTerm],If,_Ip),WS, NextKeyword,NextTerm,Code,Status) :- ( get_name(Funct,FL_THEN) -> NextKeyword=then(If) ; get_name(Funct,FL_ELSE) -> NextKeyword=else(If) ), !, flora_body(STerm,WS,Code,Status). flora_body_ifthenelse(CanoniTerm,WS,[],[],Code,Status) :- flora_body(CanoniTerm,WS,Code,Status). /**************************************************************************** flora_body_univeqform(+CanoniTerm,+WS,-Code,-Status) Parse the meta op ~ ****************************************************************************/ flora_body_univeqform(CANOTERM(_Funct,2,FL_PARENTHESIS,Args,_If,_Ip),WS,Code,Status) :- flora_distribute_ws(Args,WS,[LCode,RCode],Status), (Status == [] -> fluniveqform_struct(LCode,RCode,Code) ; true). /**************************************************************************** flora_body_metauniv(+CanoniTerm,+WS,-Code,-Status) Parse the meta op =.. (_=.. _)@floramodule, (_ =.. _)@prolog(mod) and (_ =.. _)@prologall(mod) are illegal, but (_ =.. _)@prolog() and (_ =.. _)@prologall() are legal. ****************************************************************************/ flora_body_metauniv(CANOTERM(_Funct,2,FL_PARENTHESIS,_Args,If,_Ip),WS,_Code,Status) :- %% only @prolog() and @prologall() are allowed; %% they don't match get_module_from_spec/3 get_module_from_spec(WS,_,_), !, parsing_error(If,NO_WORKSPACE,Status). %% If (_ =.. _)@prolog() or (_ =.. _)@prologall(), then use Prolog =.. flora_body_metauniv(CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),WS,Code,Status) :- (WS == PROLOGMODULE; WS == PROLOGALLMODULE), !, Args = [LCode,RCode], (WS == PROLOGMODULE -> ( flora_prlgterm(LCode,LCodeParsed,S1), (S1 == [] -> flora_pathexp(RCode,RCodeParsed,Status) %% failed to parse the first term ; Status=S1 ) ) ; %% PROLOGALLMODULE ( flora_pure_term(LCode,LCodeParsed,S1), (S1 == [] -> flora_pure_term(RCode,RCodeParsed,Status) %% failed to parse the first term ; Status=S1 ) ) ), %% put together parsed terms using =.. (=Funct) (Status == [] -> %% FCode is parsed functor code flobject_struct(Funct,FCode), flterm_struct(FCode,2,[LCodeParsed,RCodeParsed],Code1), %% protect predicate code against hilog conversion ( WS == PROLOGMODULE -> flplib_struct(Code1,Code) %% WS == PROLOGALLMODULE ; flpliball_struct(Code1,Code) ) %% failed to parse the second term ; true ). flora_body_metauniv(CANOTERM(_Funct,2,FL_PARENTHESIS,Args,_If,_Ip),_WS,Code,Status) :- Args = [Left,Right], flora_pathexp(Left,LeftParsed,S1), (S1 == [] -> flora_pathexp(Right,RightParsed,Status) %% failed to parse the first term ; Status=S1 ), (Status == [] -> flmetauniv_struct(LeftParsed,RightParsed,Code) %% failed to parse the second term ; true ). /**************************************************************************** flora_body_metaunivform(+CanoniTerm,+WS,-Code,-Status) Parse the meta op ~.. This is like =.. but is compiled differently: the left arg is meta. Also, all module specs are illegal: (_~.. _)@floramodule, (_ ~.. _)@prolog(mod), (_ ~.. _)@prolog(), (_ ~.. _)@prologall(mod), (_ ~.. _)@prologall(), ****************************************************************************/ flora_body_metaunivform(CANOTERM(_Funct,2,FL_PARENTHESIS,_Args,If,_Ip),WS,_Code,Status) :- (get_module_from_spec(WS,_,_) ; get_module_from_spec(WS,null)), !, parsing_error(If,NO_WORKSPACE,Status). flora_body_metaunivform(CANOTERM(_Funct,2,FL_PARENTHESIS,Args,_If,_Ip),_WS,Code,Status) :- Args = [Left,Right], flora_body(Left,LeftParsed,S1), (S1 == [] -> flora_pathexp(Right,RightParsed,Status) %% failed to parse the first term ; Status=S1 ), (Status == [] -> flmetaunivform_struct(LeftParsed,RightParsed,Code) %% failed to parse the second term ; true ). /**************************************************************************** flora_body_controlconstruct(+CanoniTermList1,+WS,+TopWrapper,-Code,-Status). Process control constructs while-do/loop, loop/do-until, unless-do CanoniTermList1 represents the inner part of the control construct, e.g., the do-part in while(do(Cond,Action)). It should be a singleton list that contains a canonic term. TopWrapper is the unary wrapper (whole,do,loop,unless) for the construct ****************************************************************************/ flora_body_controlconstruct([CANOTERM(InnerFunct,2,FL_PARENTHESIS,Args,If,_Ip)],WS,TopWrapper,Code,Status) :- get_name(InnerFunct,InnerName), !, (get_control_construct_definition(StructType,TopWrapper,InnerName), ! ; flora_concat_atoms(['Illegal connective `', InnerName, ''' in `', TopWrapper, ''' construct'], ErrMsg), parsing_error(If,ErrMsg,Status) ), (var(Status) -> Args=[Cond,Action], flora_body(Cond,WS,CondCode,S1), (S1== [] -> flora_body(Action,WS,ActionCode,Status) ; Status = S1 ), (Status==[] -> flcontrolconstruct_struct(CondCode,ActionCode,StructType,Code) ; true ) ; true % error ). %% If wrong number of args or wrong parenthesis - issue an error flora_body_controlconstruct([CANOTERM(_InnerFunct,_Arity,_Parenthesis,_Args,If,_Ip)],_WS,TopWrapper,_Code,Status) :- flora_concat_atoms(['Illegal syntax in `', TopWrapper, ''' construct'], ErrMsg), parsing_error(If,ErrMsg,Status). flora_body_controlconstruct([SomethingElse],_WS,TopWrapper,_Code,Status) :- get_index(SomethingElse,Idx), flora_concat_atoms(['Illegal syntax in `', TopWrapper, ''' construct'], ErrMsg), parsing_error(Idx,ErrMsg,Status). /**************************************************************************** flora_distribute_ws(+List,+WS,-TransformedList,-Status) Distribute the workspace through a list of formulae ****************************************************************************/ flora_distribute_ws([],_WS,[],[]) :- !. flora_distribute_ws([A|Args],WS,[TA|TArgs],Status) :- (get_flvar_struct(A,TA), Status = [], ! ; flora_body(A,WS,TA,Status) ), (Status == [] -> flora_distribute_ws(Args,WS,TArgs,Status) ; true). /**************************************************************************** flora_body_literal(+CanoniTerm,-Code,-Status) This predicate is called to parse a literal in a rule body, which does not associate with any module name specification. ****************************************************************************/ flora_body_literal(CanoniTerm,Code,Status) :- flora_exec_directive(CanoniTerm,Code,Status), !. %% :(_,_), ::(_,_) flora_body_literal(CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,F), is_birelop(F), !, flora_pathexplist(Args,[LCode,RCode],Status), (Status == [] -> flbirelate_struct(LCode,F,RCode,Code); true). %% .(_,_), !(_,_), ..(_,_), !!(_,_) flora_body_literal(CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_Code,Status) :- get_atom(Funct,F), is_objrefop(F), !, parsing_error(If,ERROR_BDLITERAL,Status). %% catch{...} flora_body_literal(CANOTERM(Funct,3,FL_BRACE,[Goal,Error,Handler],_If,_Ip),Code,Status) :- get_name(Funct,Atom), is_catchop(Atom), !, flora_parse_catch(Goal,Error,Handler,Code,Status). %% throw{...} flora_body_literal(CANOTERM(Funct,1,FL_BRACE,[Error],_If,_Ip),Code,Status) :- get_name(Funct,Atom), is_throwop(Atom), !, flora_parse_throw(Error,Code,Status). %% p2h{...} flora_body_literal(CANOTERM(Funct,2,FL_BRACE,[Prolog,Hilog],_If,_Ip),Code,Status) :- get_name(Funct,Atom), is_p2hop(Atom), !, flora_parse_p2h(Prolog,Hilog,Code,Status). %% refresh{...} flora_body_literal(CANOTERM(Funct,N,FL_BRACE,Args,_If,Ip),Code,Status) :- get_name(Funct,Atom), is_tablerefreshop(Atom), !, (N == 0 -> parsing_error(Ip,EXP_ARGS,Status) ; flora_tablerefresh(Args,Code,Status) ). %% insert{...} flora_body_literal(CANOTERM(Funct,N,FL_BRACE,Args,_If,Ip),Code,Status) :- get_name(Funct,Atom), is_dbinsertop(Atom), !, ( N == 0 -> parsing_error(Ip,EXP_ARGS,Status) ; flobject_struct(Funct,FCode), flora_dbinsert(FCode,N,Args,Code,Status) ). %% delete{...} flora_body_literal(CANOTERM(Funct,N,FL_BRACE,Args,_If,Ip),Code,Status) :- get_name(Funct,Atom), is_dbdeleteop(Atom), !, ( N == 0 -> parsing_error(Ip,EXP_ARGS,Status) ; flobject_struct(Funct,FCode), flora_dbdelete(FCode,N,Args,Code,Status) ). %% newmodule{Module} or newmodule{Module,TrailerType} flora_body_literal(CANOTERM(Funct,N,FL_BRACE,Args,_If,Ip),Code,Status) :- get_name(Funct,FL_NEWMODULE), !, ( (N == 1; N == 2) -> flobject_struct(Funct,FCode), flatomvar_list(Args,MCode,Status), ( Status==[] -> flnewmodule_struct(FCode,MCode,Code); true) ; parsing_error(Ip,ERROR_NEWMODULE,Status) ). %% insertrule_a{...}, insertrule_z{...}, deleterule_a{...}, or %% deleterule_z{...} flora_body_literal(CANOTERM(Funct,N,FL_BRACE,Args,_If,Ip),Code,Status) :- get_name(Funct,Atom), is_ruleupdateop(Atom), !, ( N == 0 -> parsing_error(Ip,EXP_ARGS,Status) ; flobject_struct(Funct,FCode), flora_ruleupdate(FCode,N,Args,Code,Status) ). %% :=: flora_body_literal(CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,FL_OBJEQL), !, flora_pathexplist(Args,[LCode,RCode],Status), (Status == [] -> flobjeql_struct(LCode,RCode,Code); true). flora_body_literal(CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- !, flora_term(Funct,N,Args,Code,Status). %% ...[...] flora_body_literal(CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_objspec(Funct,N,Args,Code,Status). flora_body_literal(CANOLIST(L,T,_N,I,_Ib),Code,Status) :- !, ( L == [] -> parsing_error(I,ERROR_LOADLIST,Status) ; flora_loadlist(L,T,I,C,Status), (Status == [] -> flload_struct(C,Code); true) ). %% {...} at the top level -- constraint flora_body_literal(CANOBRACE(L,_N,_I),Code,Status) :- !, flora_constraint_list(L,Code,Status). flora_body_literal(CanoniTerm,Code,[]) :- get_atom(CanoniTerm,A), !, ( A == FL_CUT -> get_index(CanoniTerm,I), flcut_struct(I,Code) ; flobject_struct(CanoniTerm,Code) ). flora_body_literal(CanoniTerm,Code,[]) :- get_flvar_struct(CanoniTerm,Code), !. flora_body_literal(CanoniTerm,_Code,Status) :- parsing_error(CanoniTerm,ERROR_BDLITERAL,Status). /**************************************************************************** flora_body_wsliteral(+CanoniTerm,-WorkspaceLiteral,-Status) This predicate is called to parse a literal in a rule body, which is associated with some module name specification. Note: Most builtin FLORA operators are allowed to be associated with module name specification. ****************************************************************************/ flora_body_wsliteral(CanoniTerm,Code,Status) :- flora_exec_directive(CanoniTerm,Code,Status), !. flora_body_wsliteral(CANOTERM(Funct,N,FL_PARENTHESIS,Args,If,_Ip),Code,Status) :- get_atom(Funct,F), !, ( flora_nowsp(F,N) -> parsing_error(If,NO_WORKSPACE,Status) ; N == 2, is_birelop(F) -> flora_pathexplist(Args,[LCode,RCode],Status), (Status == [] -> flbirelate_struct(LCode,F,RCode,Code); true) ; N == 2, is_objrefop(F) -> parsing_error(If,ERROR_BDLITERAL,Status) ; N == 2, F == FL_OBJEQL -> flora_pathexplist(Args,[LCode,RCode],Status), (Status == [] -> flobjeql_struct(LCode,RCode,Code); true) ; flora_term(Funct,N,Args,Code,Status) ). flora_body_wsliteral(CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- !, flora_term(Funct,N,Args,Code,Status). flora_body_wsliteral(CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_objspec(Funct,N,Args,Code,Status). flora_body_wsliteral(CANOTERM(Funct,_N,FL_BRACE,_Args,_If,Ip),_Code,Status) :- get_atom(Funct,F), ((is_dbinsertop(F); is_dbdeleteop(F); is_ruleupdateop(F); is_tablerefreshop(F)) -> parsing_error(Ip,NO_WORKSPACE,Status) ). flora_body_wsliteral(CanoniTerm,Code,Status) :- get_atom(CanoniTerm,A), !, ( flora_nowsp(A,0) -> parsing_error(CanoniTerm,NO_WORKSPACE,Status) ; flobject_struct(CanoniTerm,Code), Status=[] ). flora_body_wsliteral(CANOLIST(_L,_T,_N,I,_Ib),_Code,Status) :- !, parsing_error(I,NO_WORKSPACE,Status). flora_body_wsliteral(CanoniTerm,Code,[]) :- get_flvar_struct(CanoniTerm,Code), !. flora_body_wsliteral(CanoniTerm,_Code,Status) :- parsing_error(CanoniTerm,ERROR_BDLITERAL,Status). /**************************************************************************** flora_loadlist(+ListPrefix,+ListTail,+Index,-FLLIST,-Status) ****************************************************************************/ flora_loadlist([],[],Index,T,[]) :- !, fllist_struct([],[],Index,T). flora_loadlist(L,T,Index,Code,Status) :- flora_loaditemlist(L,LCode,S), ( S == [] -> ( T == [] -> TCode=[], Status=[] ; T=CANOLIST(List,Tail,_N,I,_Ib) -> flora_loadlist(List,Tail,I,TCode,Status) ; get_flvar_struct(T,TCode) -> Status=[] ; parsing_error(T,ERROR_LOADLIST,Status) ), (Status == [] -> fllist_struct(LCode,TCode,Index,Code); true) ; Status=S ). flora_loaditemlist([],[],[]) :- !. flora_loaditemlist([T|L],[TCode|LCode],Status) :- flora_loaditem(T,TCode,S), (S == [] -> flora_loaditemlist(L,LCode,Status); Status=S). flora_loaditem(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),Code,Status) :- get_atom(Funct,FL_RIGHTTO), flobject_struct(Funct,FCode), !, ( flora_name_or_normvar(L,LCode) -> ( flora_name_or_normvar(R,RCode) -> flterm_struct(FCode,2,[LCode,RCode],Code), Status=[] ; parsing_error(R,ERROR_WSNAME,Status) ) ; parsing_error(L,ERROR_LOADFILE,Status) ). flora_loaditem(CanoniTerm,Code,[]) :- flora_name_or_normvar(CanoniTerm,Code), !. flora_loaditem(CanoniTerm,_Code,Status) :- !, parsing_error(CanoniTerm,ERROR_LOADITEM,Status). flora_name_or_normvar(CanoniTerm,Code) :- ( get_flname_struct(CanoniTerm,Code) ; get_flvar_struct(CanoniTerm,Code), not is_anonymous_flvar_struct(Code) ), !. thismodule_token(CanoniTerm,ThisModToken) :- get_spectoken(CanoniTerm,FL_THISMODULE), flobject_struct(CanoniTerm,ThisModToken). /**************************************************************************** flora_constraint_list(+L,-Code,-Status) Add brace to delineate constraints ****************************************************************************/ flora_constraint_list(L,Code,Status) :- flora_body_literal_list(L,Lcode,Status), flconstraint_struct(Lcode,Code). flora_body_literal_list([L],Code,Status) :- !, flora_body_literal(L,Code,Status). flora_body_literal_list([L|Lits],Code,Status) :- flora_body_literal(L,Lcode,S), (S == [] -> flora_body_literal_list(Lits,LitsCode,Status), (Status == [] -> flconjunct_struct(Lcode,LitsCode,Code); true) ; Status = S ). /**************************************************************************** flora_prlgterm(+CanoniTerm,-Code,-Status) This predicate is called to parse a Prolog predicate or prolog term. Its arguments can be F-logic molecules and path expressions, so they are not parsed as Prolog terms. ****************************************************************************/ flora_prlgterm(CANOTERM(Funct,N,FL_PARENTHESIS,Args,If,_Ip),Code,Status) :- !, ( get_atom(Funct,FAtom) -> ( FAtom == FL_AT, N == 2 -> parsing_error(If,NO_WSNESTING,Status) ; flora_term(Funct,N,Args,Code,Status) ) ; parsing_error(If,ERROR_PRLGLIT,Status) ). flora_prlgterm(CanoniTerm,Code,[]) :- get_flname_struct(CanoniTerm,Code), !. flora_prlgterm(CanoniTerm,_Code,Status) :- parsing_error(CanoniTerm,ERROR_PRLGLIT,Status). /**************************************************************************** flora_term(+Funct,+Arity,+Args,-Code,-Status) Parse a term Funct-spec(Args). Arguments are parsed according to the argument spec in flora_argdef. The final parsed term is composed using flterm_struct ****************************************************************************/ flora_term(Funct,N,Args,Code,Status) :- get_atom(Funct,FAtom), flora_argdef(FAtom,N,ArgTypes), !, flobject_struct(Funct,F), flora_argpathexplist(Args,ArgTypes,AList,Status), (Status == [] -> flterm_struct(F,N,AList,Code); true). flora_term(Funct,N,Args,Code,Status) :- flora_pathexp(Funct,F,S), ( S == [] -> flora_pathexplist(Args,AList,Status), (Status == [] -> flterm_struct(F,N,AList,Code); true) ; Status=S ). /**************************************************************************** flora_pure_term(+Funct,+Arity,+Args,-Code,-Status) Parse a term Funct-spec(Args). Arguments are parsed as terms as well. No molecules are allowed, except reified molecules under ${...} and those apearing in meta-arguments. ****************************************************************************/ flora_pure_term(CANOTERM(Funct,1,FL_BRACE,[Arg],_If,_Ip),Code,Status) :- get_atom(Funct,Atom), is_reifyop(Atom), !, flora_reify(Arg,Code,Status). flora_pure_term(CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,FAtom), flora_argdef(FAtom,N,ArgTypes), !, flobject_struct(Funct,F), flora_pure_term_list_with_argdefs(Args,ArgTypes,AList,Status), (Status == [] -> flterm_struct(F,N,AList,Code); true). flora_pure_term(CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- !, flobject_struct(Funct,F), flora_pure_term_list(Args,AList,Status), (Status == [] -> flterm_struct(F,N,AList,Code); true). flora_pure_term(CANOLIST(L,T,_N,Index,_Ib),Code,Status) :- !, flora_pure_term_list(L,LCode,LStatus), (LStatus == [] -> ( T==[] -> TCode = [], Status = [] ; flora_pure_term(T,TCode,Status) ), (Status == [] -> fllist_struct(LCode,TCode,Index,Code) ; true ) ; Status=LStatus ). flora_pure_term(CanoniTerm,Code,[]) :- ( get_flname_struct(CanoniTerm,Code), ! ; get_flvar_struct(CanoniTerm,Code) ), !. flora_pure_term(CanoniTerm,_Code,Status) :- parsing_error(CanoniTerm,ERROR_HILGTERM,Status). %% parse list of pure terms flora_pure_term_list([],[],[]) :- !. flora_pure_term_list([Arg|Args], [ArgCode|ArgCodeList], Status) :- flora_pure_term(Arg,ArgCode,Status1), (Status1 == [] -> flora_pure_term_list(Args,ArgCodeList,Status) ; Status = Status1 ). %% parse list of pure terms taking into account argument definitions %% in which these terms occur (FL_OID or FL_BODYFORMULA) flora_pure_term_list_with_argdefs([],_,[],[]) :- !. flora_pure_term_list_with_argdefs([Arg|Args],[FL_OID|ArgsDefs],[ArgCode|ArgCodeList], Status) :- flora_pure_term(Arg,ArgCode,Status1), (Status1 == [] -> flora_pure_term_list_with_argdefs(Args,ArgsDefs,ArgCodeList,Status) ; Status = Status1 ). flora_pure_term_list_with_argdefs([Arg|Args],[FL_BODYFORMULA|ArgsDefs],[ArgCode|ArgCodeList], Status) :- flora_body(Arg,ArgCode,Status1), (Status1 == [] -> flora_pure_term_list_with_argdefs(Args,ArgsDefs,ArgCodeList,Status) ; Status = Status1 ). /**************************************************************************** flora_list(+ListPrefix,+ListTail,+Index,-FLLIST,-Status) Index is for '['. ****************************************************************************/ flora_list([],[],Index,T,[]) :- !, fllist_struct([],[],Index,T). flora_list(L,T,Index,Code,Status) :- flora_pathexplist(L,LCode,S), ( S == [] -> ( T == [] -> TCode=[], Status=[] ; flora_pathexp(T,TCode,Status) ), (Status == [] -> fllist_struct(LCode,TCode,Index,Code); true) ; Status=S ). /**************************************************************************** flora_pathexplist(+ListOfCanoniTerms,-ListOfPathExpressions,-Status) parses a list of path expressions that are supposed to represent oids. ****************************************************************************/ flora_pathexplist([],[],[]) :- !. flora_pathexplist([T|L],[TCode|LCode],Status) :- flora_pathexp(T,TCode,S), ( S == [] -> flora_pathexplist(L,LCode,Status) ; Status=S ). /**************************************************************************** flora_argpathexplist(+Terms,+ArgumentTypes,-PathExpressions,-Status) parses a list of path expressions according to a list of argument specification directives. FL_OID means the oid represented by a path expression while FL_BODYFORMULA means the formula represented by a path expression. ****************************************************************************/ flora_argpathexplist([],[],[],[]) :- !. flora_argpathexplist([T|L],[FL_OID|Arguments],[TCode|LCode],Status) :- flora_pathexp(T,TCode,S), ( S == [] -> flora_argpathexplist(L,Arguments,LCode,Status) ; Status=S ). flora_argpathexplist([T|L],[FL_BODYFORMULA|Arguments],[TCode|LCode],Status) :- flora_body(T,TCode,S), ( S == [] -> flora_argpathexplist(L,Arguments,LCode,Status) ; Status=S ). /**************************************************************************** flora_pathexp(+CanoniTerm,-PathExpression,-Status) Parse path expression represented by CanoniTerm. A path expression is oid[molecule].oid[molecule]. ... .oid[molecule] (molecules are optional) ****************************************************************************/ flora_pathexp(CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,F), (is_birelop(F); is_objrefop(F)), !, flora_pathexplist(Args,[LCode,RCode],Status), ( Status == [] -> ( is_birelop(F) -> flbirelate_struct(LCode,F,RCode,Code) ; flobjref_struct(LCode,F,RCode,Code) ) ; true ). %% This procedure is to handle module specification in the argument position. %% It might be useful to support meta-programming feature. The distribution %% and nesting rule for literals in rule body does not apply to arguments. For %% instance, f((a[b],c[d])@mod) is not allowed. flora_pathexp(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),Code,Status) :- get_atom(Funct,FL_AT), !, flora_workspace(R,WSCode,S1), ( S1 == [] -> ( (WSCode = PROLOGMODULE; WSCode = PROLOGMODULE(Mod)) -> flora_prlgterm(L,LCode,S2) ; (WSCode = PROLOGALLMODULE; WSCode = PROLOGALLMODULE(Mod)) -> flora_pure_term(L,LCode,S2) ; (WSCode = FLORAUSERMOD(Mod); WSCode = FLORASYSMOD(Mod)) -> flora_pathexp(L,LCode,S2) ), %% Check if the module specification is valid. ( S2 == [] -> ( nowspathexp(LCode) -> parsing_error(L,NO_WORKSPACE,Status) ; is_flmodulespec_struct(LCode) -> parsing_error(If,NO_WSNESTING,Status) ; Status=[], ( WSCode = PROLOGMODULE -> %% Covers: @prolog() flplib_struct(LCode,Code) ; WSCode = PROLOGALLMODULE -> %% Covers: @prologall() flpliball_struct(LCode,Code) %% Covers: @mod, @flora(mod), @prolog(mod), @prologall(mod) ; get_module_from_spec(WSCode,ModuleType,Mod) -> flmodule_struct(LCode,Mod,ModuleType,Code) ) ) ; Status=S2 ) ; Status=S1 ). flora_pathexp(CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- !, flora_term(Funct,N,Args,Code,Status). flora_pathexp(CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_objspec(Funct,N,Args,Code,Status). flora_pathexp(CANOLIST(L,T,_N,I,_Ib),Code,Status) :- !, flora_list(L,T,I,Code,Status). %% ${...} - reification flora_pathexp(CANOTERM(Funct,N,FL_BRACE,[Arg|_],_If,Ip),Code,Status) :- get_atom(Funct,Atom), is_reifyop(Atom), !, (N > 1 -> parsing_error(Ip,REIFY_WRONG_ARGNUM,Status) ; flora_reify(Arg,Code,Status) ). flora_pathexp(CANOTERM(Funct,N,FL_BRACE,Args,If,Ip),Code,Status) :- !, flora_aggregt(Funct,N,Args,If,Ip,Code,Status). flora_pathexp(ObjectTerm,_Code,Status) :- %% New oid directive is only allowed in rule head. get_spectoken(ObjectTerm,FL_NEWOID), !, parsing_error(ObjectTerm,ERROR_NEWOID,Status). flora_pathexp(ObjectTerm,Code,[]) :- flobject_struct(ObjectTerm,Code), !. flora_pathexp(CANOBRACE(_L,_N,I),_Code,Status) :- !, parsing_error(I,ERROR_SETNOTE,Status). flora_pathexp(CanoniTerm,_Code,Status) :- parsing_error(CanoniTerm,ERROR_PATHEXP,Status). %% Define which type of arguments should not have module specification. nowspathexp(S) :- is_fllist_struct(S), !. nowspathexp(S) :- is_flaggregt_struct(S), !. nowspathexp(S) :- is_flreify_struct(S), !. nowspathexp(S) :- is_flnumber_struct(S), !. nowspathexp(S) :- is_flstring_struct(S), !. nowspathexp(S) :- is_flatom_struct(S,FAtom), flora_nowsp(FAtom,0), !. nowspathexp(S) :- flterm_struct(Funct,N,_Args,S), is_flatom_struct(Funct,FAtom), flora_nowsp(FAtom,N), !. /**************************************************************************** flora_objspec(+Obj,+Arity,+Args,-Code,-Status) flora_objspec(+CanoniTerm,-Code,-Status) parses ObjectSpecificatoin as described in the informal grammar at the beginning of this file. ****************************************************************************/ flora_objspec(Obj,N,Args,Code,Status) :- flora_pathexp(Obj,O,S), ( S == [] -> ( N == 0 -> Spec=[], Status=[] ; Args=[Body], flora_objspec(Body,Spec,Status) ), (Status == [] -> flobjspec_struct(O,Spec,Code); true) ; Status=S ). flora_objspec(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),Code,Status) :- get_atom(Funct,F), (F == FL_COMMA; F == FL_SEMICOLON), !, %% conjunction or disjunction flora_objspec(L,LCode,S), ( S == [] -> flora_objspec(R,RCode,Status), ( Status == [] -> ( F == FL_COMMA -> flconjunct_struct(LCode,RCode,Code) ; fldisjunct_struct(LCode,RCode,Code) ) ; true ) ; Status=S ). flora_objspec(CANOTERM(Funct,1,FL_PARENTHESIS,[G],_If,_Ip),Code,Status) :- get_atom(Funct,F), (is_notop(F); is_tnotop(F)), !, %% negation flora_objspec(G,C,Status), ( Status == [] -> (is_notop(F) -> flnot_struct(C,Code); fltnot_struct(C,Code)) ; true ). flora_objspec(CanoniTerm,Code,Status) :- flora_attmethspec(CanoniTerm,Code,Status). /**************************************************************************** flora_attmethspec(+CanoniTerm,-Goal,-Status) flora_setexp(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_attmethspec(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),Code,Status) :- get_atom(Funct,F), ( is_fdattspecop(F) -> flora_pathexplist([L,R],[LCode,RCode],Status), (Status == [] -> flfdattspec_struct(LCode,F,RCode,Code); true) ; is_mvdattspecop(F) -> flora_pathexp(L,LCode,S), (S == [] -> flora_setexp(R,RCode,Status); Status=S), (Status == [] -> flmvdattspec_struct(LCode,F,RCode,Code); true) ; is_incattspecop(F) -> flora_pathexplist([L,R],[LCode,RCode],Status), (Status == [] -> flincattspec_struct(LCode,F,RCode,Code); true) ; is_tolistattspecop(F) -> flora_pathexplist([L,R],[LCode,RCode],Status), (Status == [] -> fltolistattspec_struct(LCode,F,RCode,Code); true) ), !. flora_attmethspec(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),Code,Status) :- get_atom(Funct,FL_AT), !, ( flora_name_or_normvar(R,RCode) -> flora_attmethspec(L,LCode,S), ( S == [] -> ( ( is_flattspec_struct(LCode); is_flimethspec_struct(LCode); is_fltranspec_struct(LCode) ) -> parsing_error(L,NO_WORKSPACE,Status) ; flmethspec_struct(C,LCode), ( is_flworkspace_struct(C) -> parsing_error(If,NO_WSNESTING,Status) ; flmodule_struct(C,RCode,FLORAUSERMOD,W), flmethspec_struct(W,Code), Status=[] ) ) ; Status=S ) ; parsing_error(R,ERROR_WSNAME,Status) ). flora_attmethspec(CANOTERM(Funct,1,FL_PARENTHESIS,[A],_If,_Ip),Code,Status) :- get_atom(Funct,FL_INMETH), !, flora_pathexp(A,C,Status), (Status == [] -> flimethspec_struct(C,Code); true). flora_attmethspec(CANOTERM(Funct,1,FL_PARENTHESIS,[A],_If,_Ip),Code,Status) :- get_atom(Funct,FL_TRAN), !, flora_pathexp(A,C,Status), (Status == [] -> fltranspec_struct(C,Code); true). flora_attmethspec(CanoniTerm,Code,Status) :- flora_pathexp(CanoniTerm,C,Status), (Status == [] -> flmethspec_struct(C,Code); true). flora_setexp(CANOBRACE(L,_N,_I),Code,Status) :- !, flora_pathexplist(L,Code,Status). flora_setexp(CanoniTerm,[Code],Status) :- flora_pathexp(CanoniTerm,Code,Status). /**************************************************************************** flora_aggregt(+Funct,+Arity,+Args,+IndxFunct,+IndxBrace,-Code,-Status) aggregt_vars(+CanoniTerm,-Var,-GroupVars,-Status) var_list(+List,-GroupVars,-Status) ****************************************************************************/ flora_aggregt(Funct,N,Args,If,Ip,Code,Status) :- ( get_name(Funct,FAtom), is_aggregtop(FAtom) -> flobject_struct(Funct,F), ( N == 1, Args=[CANOTERM(Bar,2,FL_PARENTHESIS,[L,R],_Il,_Ir)], get_atom(Bar,FL_BAR) -> aggregt_vars(L,Var,GroupVars,S), ( S == [] -> flora_body(R,Conds,Status), ( Status == [] -> flaggregt_struct(F,Var,GroupVars,Conds,Code) ; true ) ; Status=S ) ; parsing_error(Ip,ERROR_AGGREGT,Status) ) ; get_name(Funct,FAtom), (is_dbinsertop(FAtom); is_dbdeleteop(FAtom); is_ruleupdateop(FAtom)) -> parsing_error(If,ERROR_UPDATEOP,Status) ; parsing_error(If,UNKNOWN_AGGREGT,Status) ). aggregt_vars(Term,Var,[],[]) :- get_flvar_struct(Term,Var), !. aggregt_vars(CANOTERM(Funct,N,FL_BRACKET,L,If,_Ip),Var,GroupVars,Status) :- !, ( get_flvar_struct(Funct,Var) -> ( N == 0 -> GroupVars=[], Status=[] ; L=[T], var_list(T,GroupVars,Status) ) ; parsing_error(If,EXP_AGGREGVAR,Status) ). aggregt_vars(CanoniTerm,_V,_GV,Status) :- parsing_error(CanoniTerm,EXP_AGGRGRPVAR,Status). var_list(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),[Var|GV],Status) :- get_atom(Funct,F), !, ( F == FL_COMMA -> ( get_flvar_struct(L,Var) -> var_list(R,GV,Status) ; parsing_error(L,EXP_VARIABLE,Status) ) ; F == FL_BAR -> parsing_error(If,NO_LISTTAIL,Status) ; parsing_error(If,EXP_VARIABLE,Status) ). var_list(CanoniTerm,[Var],Status) :- ( get_flvar_struct(CanoniTerm,Var) -> Status=[] ; parsing_error(CanoniTerm,EXP_VARIABLE,Status) ). /**************************************************************************** flora_head_term(+Funct,+Arity,+Args,-Code,-Status) This predicate is called to parse a term in a rule head. Parsing of its arguments should be adjusted according to its arguments mode definition. ****************************************************************************/ flora_head_term(Funct,N,Args,Code,Status) :- get_atom(Funct,FAtom), flora_argdef(FAtom,N,ArgTypes), !, flobject_struct(Funct,F), flora_head_argpathexplist(Args,ArgTypes,AList,Status), (Status == [] -> flterm_struct(F,N,AList,Code); true). flora_head_term(Funct,N,Args,Code,Status) :- flora_head_pathexp(Funct,F,S), ( S == [] -> flora_head_pathexplist(Args,AList,Status), (Status == [] -> flterm_struct(F,N,AList,Code); true) ; Status=S ). /**************.*******************************.***************************** flora_head_list(+ListPrefix,+ListTail,+Index,-FLLIST,-Status) ****************************************************************************/ flora_head_list([],[],Index,T,[]) :- !, fllist_struct([],[],Index,T). flora_head_list(L,T,Index,Code,Status) :- flora_head_pathexplist(L,LCode,S), ( S == [] -> ( T == [] -> TCode=[], Status=[] ; flora_head_pathexp(T,TCode,Status) ), (Status == [] -> fllist_struct(LCode,TCode,Index,Code); true) ; Status=S ). /**************************************************************************** flora_head_argpathexplist(+Terms,+ArgumentTypes,-PathExpressions,-Status) ****************************************************************************/ flora_head_argpathexplist([],[],[],[]) :- !. flora_head_argpathexplist([T|L],[FL_OID|Arguments],[TCode|LCode],Status) :- flora_head_pathexp(T,TCode,S), ( S == [] -> flora_head_argpathexplist(L,Arguments,LCode,Status) ; Status=S ). flora_head_argpathexplist([T|L],[FL_BODYFORMULA|Arguments],[TCode|LCode],Status) :- flora_body(T,TCode,S), ( S == [] -> flora_head_argpathexplist(L,Arguments,LCode,Status) ; Status=S ). /**************************************************************************** flora_head_pathexplist(+ListOfCanoniTerms,-ListOfPathExpressions,-Status) ****************************************************************************/ flora_head_pathexplist([],[],[]) :- !. flora_head_pathexplist([T|L],[TCode|LCode],Status) :- flora_head_pathexp(T,TCode,S), ( S == [] -> flora_head_pathexplist(L,LCode,Status) ; Status=S ). /**************************************************************************** flora_head_pathexp(+CanoniTerm,-HeadPathExpression,-Status) ****************************************************************************/ flora_head_pathexp(CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,_Ip),Code,Status) :- get_atom(Funct,F), !, ( (is_birelop(F); is_fdobjrefop(F)) -> flora_head_pathexplist(Args,[LCode,RCode],Status), ( Status == [] -> ( is_birelop(F) -> flbirelate_struct(LCode,F,RCode,Code) ; flobjref_struct(LCode,F,RCode,Code) ) ; true ) ; is_mvdobjrefop(F) -> parsing_error(If,NO_MULTIATT,Status) ; F == FL_AT -> %% Module specs for F-logic molecules in the head are not allowed. %% However, module name specs for a term should be OK, since it %% might be a useful meta-programming feature. %% But this requires more checking. parsing_error(If,NO_WSINRULEHEAD,Status) ; flora_head_term(Funct,2,Args,Code,Status) ). flora_head_pathexp(CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- !, flora_head_term(Funct,N,Args,Code,Status). flora_head_pathexp(CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_head_objspec(Funct,N,Args,Code,Status). flora_head_pathexp(CANOLIST(L,T,_N,I,_Ib),Code,Status) :- !, flora_head_list(L,T,I,Code,Status). flora_head_pathexp(ObjectTerm,Code,[]) :- flobject_struct(ObjectTerm,Code), !. %% ${...} - reification flora_head_pathexp(CANOTERM(Funct,1,FL_BRACE,[Arg],_If,_Ip),Code,Status) :- get_atom(Funct,Atom), is_reifyop(Atom), !, flora_reify(Arg,Code,Status). flora_head_pathexp(CANOTERM(_Funct,_N,FL_BRACE,_Args,_If,Ip),_Code,Status) :- !, parsing_error(Ip,NO_AGGINHEAD,Status). flora_head_pathexp(CANOBRACE(_L,_N,I),_Code,Status) :- !, parsing_error(I,ERROR_SETNOTE,Status). flora_head_pathexp(CanoniTerm,_Code,Status) :- parsing_error(CanoniTerm,ERROR_EXPINHEAD,Status). /**************************************************************************** flora_head_objspec(+Obj,+Arity,+Args,-Code,-Status) flora_head_objspec(+CanoniTerm,-Code,-Status) ****************************************************************************/ flora_head_objspec(Obj,N,Args,Code,Status) :- flora_head_pathexp(Obj,O,S), ( S == [] -> ( N == 0 -> Spec=[], Status=[] ; Args=[Body], flora_head_objspec(Body,Spec,Status) ), (Status == [] -> flobjspec_struct(O,Spec,Code); true) ; Status=S ). flora_head_objspec(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),Code,Status) :- get_atom(Funct,F), ( F == FL_COMMA -> flora_head_objspec(L,LCode,S), ( S == [] -> flora_head_objspec(R,RCode,Status), (Status == [] -> flconjunct_struct(LCode,RCode,Code); true) ; Status=S ) ; F == FL_SEMICOLON, parsing_error(If,NO_DISJUNCTION,Status) ), !. flora_head_objspec(CANOTERM(Funct,1,FL_PARENTHESIS,[_G],If,_Ip),_Code,Status) :- get_atom(Funct,F), (is_notop(F); is_tnotop(F)), !, parsing_error(If,NO_NEGATION,Status). flora_head_objspec(CanoniTerm,Code,Status) :- flora_head_attmethspec(CanoniTerm,Code,Status). /**************************************************************************** flora_head_attmethspec(+CanoniTerm,-Goal,-Status) flora_head_setexp(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_head_attmethspec(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),Code,Status) :- get_atom(Funct,F), ( is_fdattspecop(F) -> flora_head_pathexplist([L,R],[LCode,RCode],Status), (Status == [] -> flfdattspec_struct(LCode,F,RCode,Code); true) ; is_mvdattspecop(F) -> flora_head_pathexp(L,LCode,S), (S == [] -> flora_head_setexp(R,RCode,Status); Status=S), (Status == [] -> flmvdattspec_struct(LCode,F,RCode,Code); true) ; (is_incattspecop(F); is_tolistattspecop(F)) -> parsing_error(If,ERROR_HDLITERAL,Status) ; F == FL_AT, parsing_error(If,NO_WSINRULEHEAD,Status) ), !. flora_head_attmethspec(CANOTERM(Funct,1,FL_PARENTHESIS,[A],_If,_Ip),Code,Status) :- get_atom(Funct,FL_INMETH), !, flora_head_pathexp(A,C,Status), (Status == [] -> flimethspec_struct(C,Code); true). flora_head_attmethspec(CANOTERM(Funct,1,FL_PARENTHESIS,[A],_If,_Ip),Code,Status) :- get_atom(Funct,FL_TRAN), !, flora_head_pathexp(A,C,Status), (Status == [] -> fltranspec_struct(C,Code); true). flora_head_attmethspec(CanoniTerm,Code,Status) :- flora_head_pathexp(CanoniTerm,C,Status), (Status == [] -> flmethspec_struct(C,Code); true). flora_head_setexp(CANOBRACE(L,_N,_I),CodeList,Status) :- !, flora_head_pathexplist(L,CodeList,Status). flora_head_setexp(CanoniTerm,[Code],Status) :- flora_head_pathexp(CanoniTerm,Code,Status). /**************************************************************************** flora_tablerefresh(+ArgsList,-Code,-Status) ****************************************************************************/ flora_tablerefresh(Args,Code,Status) :- flora_dbliteral_list(FLDEL,Args,CodeList,Status), (Status == [] -> flrefresh_struct(CodeList,Code) ; true ). /**************************************************************************** flora_dbinsert(+OpCode,+N,+ArgsList,-Code,-Status) ****************************************************************************/ flora_dbinsert(OpCode,1,[CANOTERM(Bar,2,FL_PARENTHESIS,[L,R],_If,_Ip)],Code,Status) :- get_atom(Bar,FL_BAR), !, flora_comma_separated_list(L,LList), flora_dbliteral_list(FLINS,LList,LCodeList,S), ( S == [] -> flora_body(R,RCode,Status), (Status == [] -> flinsert_struct(OpCode,LCodeList,RCode,Code) ; true ) ; Status=S ). flora_dbinsert(OpCode,_N,Args,Code,Status) :- flora_dbliteral_list(FLINS,Args,CodeList,Status), (Status == [] -> flinsert_struct(OpCode,CodeList,Code) ; true ). /**************************************************************************** flora_dbdelete(+OpCode,+N,+Args,-Code,-Status) ****************************************************************************/ flora_dbdelete(OpCode,1,[CANOTERM(Bar,2,FL_PARENTHESIS,[L,R],_If,_Ip)],Code,Status) :- get_atom(Bar,FL_BAR), !, flora_comma_separated_list(L,LList), flora_dbliteral_list(FLDEL,LList,LCodeList,S), ( S == [] -> flora_body(R,RCode,Status), (Status == [] -> fldelete_struct(OpCode,LCodeList,RCode,Code) ; true ) ; Status=S ). flora_dbdelete(OpCode,_N,Args,Code,Status) :- flora_dbliteral_list(FLDEL,Args,CodeList,Status), (Status == [] -> fldelete_struct(OpCode,CodeList,Code) ; true ). /**************************************************************************** flora_dbliteral_list(+Mode,+ArgsList,-CodeList,-Status) flora_dbliteral_list/4 is for both insert and delete literals. The value of Mode can be either FLINS (insert) or FLDEL (delete). The difference between insert and delete literals is that insert literals cannot contain multivalued reference whereas delete literals can. ****************************************************************************/ flora_dbliteral_list(_Mode,[],[],[]) :- !. flora_dbliteral_list(Mode,[H|T],CodeList,Status) :- !, flora_dbliteral(Mode,H,HCL,S), ( S == [] -> flora_dbliteral_list(Mode,T,TCL,Status), (Status == [] -> append(HCL,TCL,CodeList); true) ; Status=S ). /**************************************************************************** flora_dbliteral(+Mode,+CanoniTerm,-CodeList,-Status) Note: Module names are allowed in insert/delete literals. ****************************************************************************/ flora_dbliteral(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),CodeList,Status) :- get_atom(Funct,FL_AT), !, %% Regular module name, Var, or special token _@ ( (flora_name_or_normvar(R,RCode) ; thismodule_token(R,RCode)) -> flora_comma_separated_list(L,LList), flora_dbwsliteral_list(Mode,LList,RCode,CodeList,Status) ; flora_workspace(R,_,S) -> %% updating system module or illegal module name (S==[] -> parsing_error(R,ERROR_SYSMOD,Status); Status=S) ; parsing_error(R,ERROR_WSNAME,Status) ). flora_dbliteral(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),CodeList,Status) :- get_atom(Funct,FL_COMMA), !, flora_dbliteral(Mode,L,LCode,S), (S==[] -> flora_dbliteral(Mode,R,RCode,Status), append(LCode,RCode,CodeList) ; S == Status ). flora_dbliteral(Mode,CanoniTerm,[Code],Status) :- flora_dblit(Mode,CanoniTerm,Code,Status). /**************************************************************************** flora_dbwsliteral_list(+Mode,+CanoniTermList,+WS,-CodeList,-Status) ****************************************************************************/ flora_dbwsliteral_list(_Mode,[],_WS,[],[]) :- !. flora_dbwsliteral_list(Mode,[H|T],WS,CodeList,Status) :- !, flora_dbwsliteral(Mode,H,WS,HCodeList,S), ( S == [] -> flora_dbwsliteral_list(Mode,T,WS,TCodeList,Status), (Status == [] -> append(HCodeList,TCodeList,CodeList); true) ; Status=S ). /**************************************************************************** flora_dbwsliteral(+Mode,+CanoniTerm,+WS,-CodeList,-Status) ****************************************************************************/ flora_dbwsliteral(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),_WS,CodeList,Status) :- get_atom(Funct,FL_AT), !, %% nested module name %% Regular module name, Var, or special token _@ ( (flora_name_or_normvar(R,RCode) ; thismodule_token(R,RCode)) -> flora_comma_separated_list(L,LList), flora_dbwsliteral_list(Mode,LList,RCode,CodeList,Status) ; flora_workspace(R,_,S) -> %% updating system module or illegal module name (S==[] -> parsing_error(R,ERROR_SYSMOD,Status); Status=S) ; parsing_error(R,ERROR_WSNAME,Status) ). flora_dbwsliteral(Mode,CanoniTerm,WS,[WSCode],Status) :- flora_dbwslit(Mode,CanoniTerm,Code,Status), flmodule_struct(Code,WS,FLORAUSERMOD,WSCode). /**************************************************************************** flora_reify(+Arg,-Code,-Status) Handle reification, ${...} ****************************************************************************/ flora_reify(Arg,Code,Status) :- flora_body(Arg,ArgCode,Status), (Status == [] -> flreify_struct(ArgCode,Code); true). /**************************************************************************** flora_parse_catch(Goal,Error,Handler,Code,Status) Handle catch{Goal,Error,Handler} ****************************************************************************/ flora_parse_catch(Goal,Error,Handler,Code,Status) :- flora_body(Goal,GoalCode,GoalStatus), (GoalStatus == [] -> flora_pure_term(Error,ErrorCode,ErrorStatus), (ErrorStatus == [] -> flora_body(Handler,HandlerCode,Status), (Status == [] -> flcatch_struct(GoalCode,ErrorCode,HandlerCode,Code) ; true ) ; Status = ErrorStatus ) ; Status = GoalStatus ). /**************************************************************************** flora_parse_throw(Error,Code,Status) Handle throw{Error} ****************************************************************************/ flora_parse_throw(Error,Code,Status) :- flora_pure_term(Error,ErrCode,Status), (Status == [] -> flthrow_struct(ErrCode,Code) ; true ). /**************************************************************************** flora_parse_p2h(Prolog,Hilog,Code,Status) Handle p2h{Prolog,Hilog} ****************************************************************************/ flora_parse_p2h(Prolog,Hilog,Code,Status) :- flora_pure_term(Prolog,PrlgCode,PrlgStatus), (PrlgStatus == [] -> flora_pure_term(Hilog,HlgCode,Status), (Status == [] -> flp2h_struct(PrlgCode,HlgCode,Code) ; true ) ; Status = PrlgStatus ). /**************************************************************************** The following flora_check_update_* statements make sure that builtins and other inappropriate things don't occur in update statements. ****************************************************************************/ /**************************************************************************** flora_check_update_builtin(+Mode,+CanoniTerm,-Status) ****************************************************************************/ flora_check_update_builtin(Mode,CANOTERM(Funct,N,FL_PARENTHESIS,_Args,If,_Ip),Status) :- get_atom(Funct,F), flora_nodefp(F,N), ( Mode == FLINS -> parsing_error(If,NO_INSERT,Status) ; Mode == FLDEL, parsing_error(If,NO_DELETE,Status) ). /**************************************************************************** flora_check_update_ifthenelse(+CanoniTerm,-Status) ****************************************************************************/ /* flora_check_update_ifthenelse(CANOTERM(Funct,1,FL_PARENTHESIS,_Args,If,_Ip),Status) :- get_name(Funct,FL_IF), !, parsing_error(If,NO_UPDATEIF,Status). flora_check_update_ifthenelse(CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),Status) :- get_name(Funct,FL_THEN), !, parsing_error(If,NO_UPDATETHEN,Status). flora_check_update_ifthenelse(CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),Status) :- get_name(Funct,FL_ELSE), !, parsing_error(If,NO_UPDATEELSE,Status). */ /**************************************************************************** flora_dblit(+Mode,+CanoniTerm,-Code,-Status) ****************************************************************************/ flora_dblit(Mode,CanoniTerm,_Code,Status) :- flora_check_update_builtin(Mode,CanoniTerm,Status), !. flora_dblit(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,F), is_birelop(F), !, flora_db_pathexplist(Mode,Args,[LCode,RCode],Status), (Status == [] -> flbirelate_struct(LCode,F,RCode,Code); true). flora_dblit(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_Code,Status) :- get_atom(Funct,F), is_objrefop(F), !, ( Mode == FLINS -> parsing_error(If,ERROR_INSERT,Status) ; Mode == FLDEL, parsing_error(If,ERROR_DELETE,Status) ). flora_dblit(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,FL_OBJEQL), !, flora_db_pathexplist(Mode,Args,[LCode,RCode],Status), (Status == [] -> flobjeql_struct(LCode,RCode,Code); true). /* flora_dblit(_Mode,CanoniTerm,_Code,Status) :- flora_check_update_ifthenelse(CanoniTerm,Status), !. flora_dblit(_Mode,CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_Code,Status) :- get_name(Funct,FL_THEN), !, parsing_error(If,NO_UPDATETHEN,Status). flora_dblit(_Mode,CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_Code,Status) :- get_name(Funct,FL_ELSE), !, parsing_error(If,NO_UPDATEELSE,Status). */ flora_dblit(Mode,CANOTERM(Funct,N,FL_PARENTHESIS,Args,If,_Ip),Code,Status) :- !, ( get_atom(Funct,F), flora_prlgdef(F,N) -> parsing_error(If,NO_PROLOGUPDATE,Status) ; flora_db_term(Mode,Funct,N,Args,Code,Status) ). flora_dblit(Mode,CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_db_objspec(Mode,Funct,N,Args,Code,Status). flora_dblit(Mode,CanoniTerm,Code,Status) :- get_atom(CanoniTerm,A), !, ( flora_nodefp(A,0) -> ( Mode == FLINS -> parsing_error(CanoniTerm,NO_INSERT,Status) ; Mode == FLDEL, parsing_error(CanoniTerm,NO_DELETE,Status) ) ; flora_prlgdef(A,0) -> parsing_error(CanoniTerm,NO_PROLOGUPDATE,Status) ; flobject_struct(CanoniTerm,Code), Status=[] ). flora_dblit(_Mode,CanoniTerm,Code,[]) :- get_flvar_struct(CanoniTerm,Code), not is_anonymous_flvar_struct(Code), !. flora_dblit(Mode,CanoniTerm,_Code,Status) :- !, ( Mode == FLINS -> parsing_error(CanoniTerm,ERROR_INSERT,Status) ; Mode == FLDEL, parsing_error(CanoniTerm,ERROR_DELETE,Status) ). /**************************************************************************** flora_dbwslit(+Mode,+CanoniTerm,-Code,-Status) Note: Updating Prolog predicates is not allowed. But explicit module name specification overrides the Prolog directive. ****************************************************************************/ flora_dbwslit(Mode,CanoniTerm,_Code,Status) :- flora_check_update_builtin(Mode,CanoniTerm,Status), !. flora_dbwslit(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,F), is_birelop(F), !, flora_db_pathexplist(Mode,Args,[LCode,RCode],Status), (Status == [] -> flbirelate_struct(LCode,F,RCode,Code); true). flora_dbwslit(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,_Args,If,_Ip),_Code,Status) :- get_atom(Funct,F), is_objrefop(F), !, ( Mode == FLINS -> parsing_error(If,ERROR_INSERT,Status) ; Mode == FLDEL, parsing_error(If,ERROR_DELETE,Status) ). flora_dbwslit(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,FL_OBJEQL), !, flora_db_pathexplist(Mode,Args,[LCode,RCode],Status), (Status == [] -> flobjeql_struct(LCode,RCode,Code); true). flora_dbwslit(Mode,CANOTERM(Funct,N,FL_PARENTHESIS,Args,If,_Ip),Code,Status) :- !, ( get_atom(Funct,F), flora_nowsp(F,N) -> parsing_error(If,NO_WORKSPACE,Status) ; flora_db_term(Mode,Funct,N,Args,Code,Status) ). flora_dbwslit(Mode,CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_db_objspec(Mode,Funct,N,Args,Code,Status). flora_dbwslit(Mode,CanoniTerm,Code,Status) :- get_atom(CanoniTerm,A), !, ( flora_nodefp(A,0) -> ( Mode == FLINS -> parsing_error(CanoniTerm,NO_INSERT,Status) ; Mode == FLDEL, parsing_error(CanoniTerm,NO_DELETE,Status) ) ; flora_nowsp(A,0) -> parsing_error(CanoniTerm,NO_WORKSPACE,Status) ; flobject_struct(CanoniTerm,Code), Status=[] ). flora_dbwslit(_Mode,CanoniTerm,_Code,Status) :- get_flvar_struct(CanoniTerm,_V), !, parsing_error(CanoniTerm,NO_WORKSPACE,Status). flora_dbwslit(Mode,CanoniTerm,_Code,Status) :- !, ( Mode == FLINS -> parsing_error(CanoniTerm,ERROR_INSERT,Status) ; Mode == FLDEL, parsing_error(CanoniTerm,ERROR_DELETE,Status) ). /**************************************************************************** flora_db_term(+Mode,+Funct,+Arity,+Args,-Code,-Status) ****************************************************************************/ flora_db_term(Mode,Funct,N,Args,Code,Status) :- flora_db_pathexp(Mode,Funct,F,S), ( S == [] -> flora_db_pathexplist(Mode,Args,AList,Status), (Status == [] -> flterm_struct(F,N,AList,Code); true) ; Status=S ). /**********************************************.***************************** flora_db_list(+Mode,+ListPrefix,+ListTail,+Index,-FLLIST,-Status) ****************************************************************************/ flora_db_list(_Mode,[],[],Index,T,[]) :- !, fllist_struct([],[],Index,T). flora_db_list(Mode,L,T,Index,Code,Status) :- flora_db_pathexplist(Mode,L,LCode,S), ( S == [] -> ( T == [] -> TCode=[], Status=[] ; flora_db_pathexp(Mode,T,TCode,Status) ), (Status == [] -> fllist_struct(LCode,TCode,Index,Code); true) ; Status=S ). /**************************************************************************** flora_db_pathexplist(+Mode,+ListOfCanoniTerms,-ListOfPathExpressions,-Status) ****************************************************************************/ flora_db_pathexplist(_Mode,[],[],[]) :- !. flora_db_pathexplist(Mode,[T|L],[TCode|LCode],Status) :- flora_db_pathexp(Mode,T,TCode,S), ( S == [] -> flora_db_pathexplist(Mode,L,LCode,Status) ; Status=S ). /**************************************************************************** flora_db_pathexp(+Mode,+CanoniTerm,-InsertPathExpression,-Status) ****************************************************************************/ flora_db_pathexp(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,F), is_birelop(F), !, flora_db_pathexplist(Mode,Args,[LCode,RCode],Status), (Status == [] -> flbirelate_struct(LCode,F,RCode,Code); true). flora_db_pathexp(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- get_atom(Funct,F), is_fdobjrefop(F), !, flora_db_pathexplist(Mode,Args,[LCode,RCode],Status), (Status == [] -> flobjref_struct(LCode,F,RCode,Code); true). flora_db_pathexp(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,Args,If,_Ip),Code,Status) :- get_atom(Funct,F), is_mvdobjrefop(F), !, ( Mode == FLINS -> parsing_error(If,NO_INSERTMULATT,Status) ; Mode == FLDEL, flora_db_pathexplist(Mode,Args,[LCode,RCode],Status), (Status == [] -> flobjref_struct(LCode,F,RCode,Code); true) ). flora_db_pathexp(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),Code,Status) :- get_atom(Funct,FL_AT), !, ( (flora_name_or_normvar(R,RCode) ; thismodule_token(R,RCode)) -> flora_db_pathexp(Mode,L,LCode,S), ( S == [] -> ( is_flworkspace_struct(LCode) -> parsing_error(If,NO_WSNESTING,Status) ; nowspathexp(LCode) -> parsing_error(L,NO_WORKSPACE,Status) ; flmodule_struct(LCode,RCode,FLORAUSERMOD,Code), Status=[] ) ; Status=S ) ; parsing_error(R,ERROR_WSNAME,Status) ). flora_db_pathexp(Mode,CANOTERM(Funct,N,FL_PARENTHESIS,Args,_If,_Ip),Code,Status) :- !, flora_db_term(Mode,Funct,N,Args,Code,Status). flora_db_pathexp(Mode,CANOTERM(Funct,N,FL_BRACKET,Args,_If,_Ip),Code,Status) :- !, flora_db_objspec(Mode,Funct,N,Args,Code,Status). flora_db_pathexp(_Mode,CANOTERM(Funct,1,FL_BRACE,[Arg],_If,_Ip),Code,Status) :- get_atom(Funct,Atom), is_reifyop(Atom), !, flora_reify(Arg,Code,Status). flora_db_pathexp(Mode,CANOLIST(L,T,_N,I,_Ib),Code,Status) :- !, flora_db_list(Mode,L,T,I,Code,Status). /* flora_db_pathexp(_Mode,ObjectTerm,_Code,Status) :- %% New oid directive is not allowed in insert/delete get_spectoken(ObjectTerm,FL_NEWOID), !, parsing_error(ObjectTerm,ERROR_NEWOID,Status). */ flora_db_pathexp(_Mode,ObjectTerm,Code,[]) :- flobject_struct(ObjectTerm,Code), !. flora_db_pathexp(Mode,CanoniTerm,_Code,Status) :- ( Mode == FLINS -> parsing_error(CanoniTerm,ERROR_EXPINSERT,Status) ; Mode == FLDEL, parsing_error(CanoniTerm,ERROR_EXPDELETE,Status) ). /**************************************************************************** flora_db_objspec(+Mode,+Obj,+Arity,+Args,-Code,-Status) flora_db_objspec(+Mode,+CanoniTerm,-Code,-Status) ****************************************************************************/ flora_db_objspec(Mode,Obj,N,Args,Code,Status) :- flora_db_pathexp(Mode,Obj,O,S), ( S == [] -> ( N == 0 -> Spec=[], Status=[] ; Args=[Body], flora_db_objspec(Mode,Body,Spec,Status) ), (Status == [] -> flobjspec_struct(O,Spec,Code); true) ; Status=S ). flora_db_objspec(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),Code,Status) :- get_atom(Funct,F), ( F == FL_COMMA -> flora_db_objspec(Mode,L,LCode,S), ( S == [] -> flora_db_objspec(Mode,R,RCode,Status), (Status == [] -> flconjunct_struct(LCode,RCode,Code); true) ; Status=S ) ; F == FL_SEMICOLON, ( Mode == FLINS -> parsing_error(If,NO_INSERTDISJUN,Status) ; Mode == FLDEL, parsing_error(If,NO_DELETEDISJUN,Status) ) ). flora_db_objspec(Mode,CANOTERM(Funct,1,FL_PARENTHESIS,[_G],If,_Ip),_Code,Status) :- get_atom(Funct,F), (is_notop(F); is_tnotop(F)), !, ( Mode == FLINS -> parsing_error(If,NO_INSERTNEG,Status) ; Mode == FLDEL, parsing_error(If,NO_DELETENEG,Status) ). flora_db_objspec(Mode,CanoniTerm,Code,Status) :- flora_db_attmethspec(Mode,CanoniTerm,Code,Status). /**************************************************************************** flora_db_attmethspec(+Mode,+CanoniTerm,-Goal,-Status) flora_db_setexp(+Mode,+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_db_attmethspec(Mode,CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),Code,Status) :- get_atom(Funct,F), ( is_fdattspecop(F) -> flora_db_pathexplist(Mode,[L,R],[LCode,RCode],Status), (Status == [] -> flfdattspec_struct(LCode,F,RCode,Code); true) ; is_mvdattspecop(F) -> flora_db_pathexp(Mode,L,LCode,S), (S == [] -> flora_db_setexp(Mode,R,RCode,Status); Status=S), (Status == [] -> flmvdattspec_struct(LCode,F,RCode,Code); true) ; (is_incattspecop(F); is_tolistattspecop(F)) -> ( Mode == FLINS -> parsing_error(If,ERROR_INSERT,Status) ; Mode == FLDEL, parsing_error(If,ERROR_DELETE,Status) ) ; F == FL_AT, parsing_error(If,NO_WORKSPACE,Status) ), !. flora_db_attmethspec(Mode,CANOTERM(Funct,1,FL_PARENTHESIS,[A],_If,_Ip),Code,Status) :- get_atom(Funct,FL_INMETH), !, flora_db_pathexp(Mode,A,C,Status), (Status == [] -> flimethspec_struct(C,Code); true). flora_db_attmethspec(Mode,CANOTERM(Funct,1,FL_PARENTHESIS,[A],_If,_Ip),Code,Status) :- get_atom(Funct,FL_TRAN), !, flora_db_pathexp(Mode,A,C,Status), (Status == [] -> fltranspec_struct(C,Code); true). flora_db_attmethspec(Mode,CanoniTerm,Code,Status) :- flora_db_pathexp(Mode,CanoniTerm,C,Status), (Status == [] -> flmethspec_struct(C,Code); true). flora_db_setexp(Mode,CANOBRACE(L,_N,_I),CodeList,Status) :- !, flora_db_pathexplist(Mode,L,CodeList,Status). flora_db_setexp(Mode,CanoniTerm,[Code],Status) :- flora_db_pathexp(Mode,CanoniTerm,Code,Status). /**************************************************************************** flora_ruleupdate(+OpCode,+N,+ArgsList,-Code,-Status) ****************************************************************************/ flora_ruleupdate(OpCode,_N,Args,Code,Status) :- flora_dynrule_list(Args,CodeList,Status), (Status == [] -> flupdaterule_struct(OpCode,CodeList,Code); true). /**************************************************************************** flora_dynrule_list(+RuleList,-CodeList,-Status) ****************************************************************************/ flora_dynrule_list([],[],[]) :- !. flora_dynrule_list([H|T],CodeList,Status) :- !, flora_dynrule(H,HCL,S), ( S == [] -> flora_dynrule_list(T,TCL,Status), (Status == [] -> append(HCL,TCL,CodeList); true) ; Status=S ). /**************************************************************************** flora_dynrule(+CanoniTerm,-CodeList,-Status) ****************************************************************************/ flora_dynrule(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),CodeList,Status) :- get_atom(Funct,FL_AT), !, %% Regular module name, Var, or special token _@ ( (flora_name_or_normvar(R,RCode) ; thismodule_token(R,RCode)) -> flora_comma_separated_list(L,LList), flora_wsdynrule_list(LList,RCode,CodeList,Status) ; flora_workspace(R,_,S) -> %% updating system module or illegal module name (S==[] -> parsing_error(R,ERROR_SYSMOD,Status); Status=S) ; parsing_error(R,ERROR_WSNAME,Status) ). flora_dynrule(CanoniTerm,[Code],Status) :- flora_dynrl(CanoniTerm,Code,Status). /**************************************************************************** flora_wsdynrule_list(+CanoniTermList,+WS,-CodeList,-Status) ****************************************************************************/ flora_wsdynrule_list([],_WS,[],[]) :- !. flora_wsdynrule_list([H|T],WS,CodeList,Status) :- !, flora_wsdynrule(H,WS,HCodeList,S), ( S == [] -> flora_wsdynrule_list(T,WS,TCodeList,Status), (Status == [] -> append(HCodeList,TCodeList,CodeList); true) ; Status=S ). /**************************************************************************** flora_wsdynrule(+CanoniTerm,+WS,-CodeList,-Status) ****************************************************************************/ flora_wsdynrule(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],_If,_Ip),_WS,CodeList,Status) :- get_atom(Funct,FL_AT), !, %% nested module name %% Regular module name, Var, or special token _@ ( (flora_name_or_normvar(R,RCode) ; thismodule_token(R,RCode)) -> flora_comma_separated_list(L,LList), flora_wsdynrule_list(LList,RCode,CodeList,Status) ; flora_workspace(R,_,S) -> %% updating system module or illegal module name (S==[] -> parsing_error(R,ERROR_SYSMOD,Status); Status=S) ; parsing_error(R,ERROR_WSNAME,Status) ). flora_wsdynrule(CanoniTerm,WS,[Code],Status) :- ( is_rule(CanoniTerm,Head,Body) -> flora_dynhead(Head,HCL,S), ( S == [] -> flora_body(Body,FLORAUSERMOD(WS),BodyCode,Status), flmodule_structlist(HCL,WS,FLORAUSERMOD,WSHCL), fldynrule_struct(WSHCL,BodyCode,Code) ; Status=S ) ; parsing_error(CanoniTerm, EXP_RULES, Status) ). /**************************************************************************** flora_dynrl(+CanoniTerm,-Code,-Status) ****************************************************************************/ flora_dynrl(CanoniTerm,Code,Status) :- ( is_rule(CanoniTerm,Head,Body) -> flora_dynhead(Head,HCL,S), ( S == [] -> flora_body(Body,BodyCode,Status), fldynrule_struct(HCL,BodyCode,Code) ; Status=S ) ; parsing_error(CanoniTerm, EXP_RULES, Status) ). /**************************************************************************** flora_dynhead(+CanoniTerm,-CodeList,-Status) Similar to flora_head, but each element of the conjuction may be a normal variable or flora_head_literal ****************************************************************************/ flora_dynhead(CANOTERM(Funct,2,FL_PARENTHESIS,[L,R],If,_Ip),CodeList,Status) :- get_atom(Funct,F), ( F == FL_COMMA -> flora_dynhead(L,LCodeList,S), ( S == [] -> flora_dynhead(R,RCodeList,Status), ( Status == [] -> append(LCodeList,RCodeList,CodeList) ; true ) ; Status=S ) ; F == FL_SEMICOLON -> % Disjunction is prohibited. parsing_error(If,NO_DISJUNCTION,Status) ; % Module name in rule head is prohibited. F == FL_AT, parsing_error(If,NO_WSINRULEHEAD,Status) ), !. flora_dynhead(CANOTERM(Funct,1,FL_PARENTHESIS,[_G],If,_Ip),_CodeList,Status) :- get_atom(Funct,F), (is_notop(F); is_tnotop(F)), !, parsing_error(If,NO_NEGATION,Status). flora_dynhead(CanoniTerm,[Code],Status) :- ( get_flvar_struct(CanoniTerm, Code) -> ( Code=FLVAR(FL_UNDERSCORE,I) -> parsing_error(I,ERROR_HDLITERAL,Status) ; Status=[] ) ; flora_head_literal(CanoniTerm,Code,Status) ). /**************************************************************************** flmodule_structlist(+List,+WS,+MOD,-ListWithModule) distribute module name to each element of the input list ****************************************************************************/ flmodule_structlist([],_WS,_ModType,[]) :- !. flmodule_structlist([H|L],WS,ModType,[HM|LM]) :- flmodule_struct(H,WS,ModType,HM), flmodule_structlist(L,WS,ModType,LM). /**************************************************************************** flatomvar_list(+List,-ListCodeWS,-Status) parse a list of atoms and regular vars ****************************************************************************/ flatomvar_list([],[],[]) :- !. flatomvar_list([H|L],[HCode|LCode],Status) :- ( flora_name_or_normvar(H,HCode) -> flatomvar_list(L,LCode,Status) ; parsing_error(H,EXP_VARORATOM,Status) ).