/* 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)
).
syntax highlighted by Code2HTML, v. 0.9.1