module emop.expand [Impl, InitGoalIdRef] { constructor: file/1, file/2, error/2, none/0, var/1, var/4, dep/2, dep/3, callable/2, doc/3, clause/4, directive/1, some/2, some/1, scope/3, number/1, atom/4, clause/6, '=>'/2, operator/2, number/3, empty/2, doc/4, grammar/5, 'module'/7, term/1. constructor: symbol/5, callable/5, atom/3, ctx/2, unescaped/0, variable/0, escaped/0, special/4, operator/0, notation/3, syntax/3, level/3, level/4, priority/2. empty([]). empty(none). get_args_info(ArgsInfo, MSgn, EvalEnv, Cache, Dependencies, Pos, Fids, ArgsTarget) :- ( ( ArgsInfo = none ; ArgsTarget = none ) -> true ; ArgsInfo = 'suspended'(CArgs, CList) -> eval_suspended(ArgsTarget, CArgs, CList, EvalEnv, Cache, Dependencies, Pos, Fids, MSgn) ; module { do([], []). do([HI | TI], [HA | TA]) :- ( HI \= none, HA = var(VA) -> unify_module(EvalEnv, VA, HI, Fids) ; true ), do(TI, TA). }:do(ArgsInfo, ArgsTarget) ). eval_suspended(ArgsTarget, CArgs, CList, SupEnv, Cache, Dependencies, Pos, Fids, MSgn) :- ( ( ArgsTarget = none ; CArgs = none ) -> true ; EvalEnv = data.record:{}, module { do([], []). do([HI | TI], [HA | TA]) :- ( HI = var(VI), HA = var(VA) -> EvalEnv:{VI} = SupEnv:{VA} ; true ), do(TI, TA). }:do(CArgs, ArgsTarget), data.list:iter(CList) { do('call'(Mod, CallF, CallArgs)) :- ( CallN = data.list:length(CallArgs), ( Mod = 'scope' -> NewFids = [], MSgn0 = MSgn ; Mod = 'var'(X) -> NewFids = [], EvalEnv:{X} = MVarEnv, \+ data.var:check(MVarEnv), 'root'((NewFids, MSgn0)) = emop.unionfind:get_root(MVarEnv):get ; Mod = 'atom'(Atom), Atom \= 'top' -> NewFids = [Atom], MSgn0 = Dependencies:find_mod_sgn(Atom, Pos) ), data.list:member(symbol(CallF, CallN, 'predicate', ArgsInfo, Position), MSgn0) -> ( data.list:member(Position, Cache) -> true ; get_args_info(ArgsInfo, MSgn, EvalEnv, [Position | Cache], Dependencies, Pos, data.list:append(NewFids, Fids), CallArgs) ) ; true ). do('module'(X, MSgn0)) :- unify_module(EvalEnv, X, MSgn0, Fids). } ). unify_module(EvalEnv, Var, NewSgn, NewFids) :- VAS = EvalEnv:{Var}, ( data.var:check(VAS) -> VAS = data.ref.backtrackable:new('root'((NewFids, NewSgn))) ; VAR = emop.unionfind:get_root(VAS), 'root'((OldFids, VARS)) = VAR:get, VAR:set('root'((data.list:append(NewFids, OldFids), data.list:append(VARS, NewSgn)))) ). fresh_init_goal_id(V) :- ( data.var:check(InitGoalIdRef) -> InitGoalIdRef = data.ref.non_backtrackable:new(0) ; true ), V = data.number.(InitGoalIdRef++). make_scope(Value, Sgn, SupScope, Scope) :- Scope = scope(Value, Sgn, emop.parser:make_grammar(Sgn, Impl:grammars(SupScope))). fresh_dependencies(PackageNodes, RootPackagePath) = data.ref.backtrackable.( DependenciesRef = new([]), ExpandDependenciesRef = new([]) ) >> module { add(Mod, Pos) :- DependenciesRef:get(Dependencies), ( data.list:member(dep(Mod, _), Dependencies) -> true ; DependenciesRef:set([dep(Mod, Pos) | Dependencies]) ). add_expand([], _Pos) :- !. add_expand([H | T], Pos) :- !, add_expand(H, Pos), add_expand(T, Pos). add_expand(Mod, Pos) :- add(Mod, Pos), ExpandDependenciesRef:get(Dependencies), ( data.list:member(Mod, Dependencies) -> true ; ExpandDependenciesRef:set([Mod | Dependencies]) ). get = DependenciesRef:get. get_expand = ExpandDependenciesRef:get. find_mod_sgn(Mod, Pos) = add(Mod, Pos) >> emop.sgn:from_mod_spec( 'name'(Mod, PackageNodes, RootPackagePath), Pos ). }. expand_file(Fid, MainSgn, Filename, FileXml, Dependencies, Expander) :- 'data.ref.backtrackable':( new([], ClausesRef), new([], ModuleListRef), new([], ModuleQueue), new([], CheckQueue), new(0, PredicateIdCounterRef), new(0, FreshModuleCounterRef) ), module ExpandFile [ ExpandFile, Impl, Fid, MainSgn, HasMainModule, FileXml, Dependencies, ModuleListRef, ClausesRef, PredicateIdCounterRef, FreshModuleCounterRef, ModuleQueue, CheckQueue, ] { queue_check(Check) :- CheckQueue:set([Check | CheckQueue:get]). predicate_id(PredicateId) :- PredicateId = 'data.atom':format( 'p~d', [data.number.(PredicateIdCounterRef++)] ). add_clause(F, Args, B) :- ClausesRef:get(Clauses), ClausesRef:set([clause(F, data.list:length(Args), Args, B) | Clauses]). add_directive(X) :- ClausesRef:get(Clauses), ClausesRef:set([directive(X) | Clauses]). get_scope(Mod, Pos, SgnVars, CurrentScope, Scope) :- ( Mod = 'var'(ModVar) -> Sgn0 = SgnVars:{ModVar}, ( data.var:check(Sgn0) -> throw(error('This variable has no associated signature', Pos)) ; 'root'((Fids, Sgn)) = emop.unionfind:get_root(Sgn0):get ) ; Mod = 'callable'(ModAtom, []) -> Fids = [ModAtom], Sgn = Dependencies:find_mod_sgn(ModAtom, Pos), ( data.var:check(Sgn) -> throw(error('No module signature', Pos)) ; true ) ; throw(error('Invalid module', Pos)) ), Dependencies:add_expand(Fids, Pos), Scope = make_scope(Mod, Sgn, CurrentScope). fresh_module_index = data.number.(FreshModuleCounterRef++). constructor: env/3. prolog_module_name(F) = data.atom:format(':~a', [F]). prolog_predicate_name(Id, F) = data.atom:format('~a:~a', [Id, F]). predicate_name_direct(F) = data.atom:format('~a$direct', [F]). expand_import(Ast, Pos, FreeVars, SgnVars, EnvRec, EnvVars, ImplicitConstructorsRef, ThisOption, Scope, Goals) :- module { import(Expr, Goal) :- Expr0 = emop.parser:internal_reparse(emop.parse:reconcat_list(Expr, Pos), Impl:grammars(Scope)), FreeVars1 = emop.parse:fv(Expr0), data.list:append(FreeVars, FreeVars1, FreeVars2), SubSgnVars = SgnVars:copy, LocalExpander = expander(EnvRec:copy, SubSgnVars, ThisOption, EnvVars, FreeVars2, ImplicitConstructorsRef), Ctx = ctx(none, Scope), H1 = LocalExpander:transform_term(Expr0, Ctx, Goal0), ( H1 = var(HVarMod) -> SubSgn = SubSgnVars:{HVarMod} ; true ), queue_check() { do :- LocalExpander:singleton_warning. }, Goal = 'import'(H1, SubSgn, Goal0). do(A, List) :- ( data.list:append(H, [callable(',', unescaped, none, _, _) | T], A) -> List = [import(H) | Tail], do(T, Tail) ; List = [import(A)] ). }:do(Ast, Goals). expand_module(Name, Pb, Pe, Env, Sgn, Clauses, InheritedEnvVars, SupScope, SupSgnVars, Vars, Goal) :- ( data.var:check(Vars) -> throw('uninstanciated vars') ; true ), EnvRec = data.record:{}, SgnVars = data.record:{}, Impl:extract_env(Env, EnvRec, EnvList0, SupSgnVars, SgnVars), IntEnvList0 = data.list:append(EnvList0, AdditionalEnvList), ExtEnvList0 = data.list:append(EnvList0, AdditionalEnvList), ( module [ Title, Sgn, VarSgn, ModuleGoal0, Fid, MainSgn, ExpandFile, IntEnvList0, ExtEnvList0, IntEnvList, ExtEnvList, IntEnvTerm, This, InheritedEnvVars, EnvVars, LocalId, ModuleListRef, SupSgnVars, Vars, Impl, HasMainModule ] { expand_module_name(atom(Title, Escaped, Pb, Pe)) :- emop.parser:fresh_var(ModuleCount), emop.parser:fresh_var(ClosureList), IncrModuleCounter = callable( 'g_inc', [ callable('$module_count', []), ModuleCount ] ), emop.parser:fresh_var(Head), emop.parser:fresh_var(Tail), AppendClosure = callable( ',', [ callable( '=', [ callable('.', [Head, Tail]), ClosureList, ] ), callable( ',', [ callable( 'setarg', [number(1), ClosureList, ExtModTerm] ), callable( 'setarg', [ number(2), ClosureList, callable('.', [Head, Tail]) ] ) ] ) ] ), ( emop.parser:is_variable(Title, Escaped, none) -> Impl:var_lookup(Title, Pb, Pe, Vars, _), SupSgnVars:{Title} = VarSgn, emop.parser:fresh_var(This), EnvVars = [This | InheritedEnvVars], IntEnvList = [This | IntEnvList0], ExtEnvList = [var(Title) | ExtEnvList0], ExpandFile:fresh_module_index(Index), LocalId = prolog_module_name(data.atom:format('~a@~d', [Fid, Index])), ModuleListRef:set([LocalId | ModuleListRef:get]), IntEnvTerm = callable('env', IntEnvList), ExtEnvTerm = callable('env', ExtEnvList), ExtModTerm = callable(LocalId, [ExtEnvTerm]), ModuleGoal0 = callable( ';', [ callable( '->', [ callable('var', [var(Title)]), callable( ',', [ IncrModuleCounter, callable( '=', [ var(Title), callable( '$module', [ ModuleCount, callable( '.', [ ExtModTerm, callable('[]', []) ] ), callable( '.', [ var(Title), callable('[]', []) ] ) ] ) ] ) ] ) ] ), callable( ',', [ callable( '=', [ var(Title), callable( '$module', [ ModuleCount, ClosureList, var('_') ] ) ] ), AppendClosure ] ) ] ) ; ( data.var:check(HasMainModule) -> HasMainModule = 'true' ; throw(error('There can only be one main module per file.', file(Pb, Pe))) ), MainSgn = Sgn, ( Fid = Title -> true ; throw(error(data.atom:format('The named module should be ~a.', [Fid]), file(Pb, Pe))) ), This = callable(Title, []), EnvVars = InheritedEnvVars, IntEnvList = IntEnvList0, ExtEnvList = ExtEnvList0, LocalId = prolog_module_name(Fid), ModuleListRef:set([LocalId | ModuleListRef:get]), IntEnvTerm = callable('env', IntEnvList), ExtEnvTerm = callable('env', ExtEnvList), ExtModTerm = callable(LocalId, [ExtEnvTerm]), % emop.parser:fresh_var(VarValue), ModuleGoal0 = callable('g_link', [This, ExtModTerm]) % callable(',', [callable('g_read', [This, VarValue]), callable(';', [callable('->', [callable('=', [VarValue, number(0)]), callable(',', [IncrModuleCounter, callable('g_link', [This, callable('$module', [ModuleCount, callable('.', [ExtModTerm, callable('[]', [])])])])])]), callable(',', [callable('=', [VarValue, callable('$module', [var(_), ClosureList])]), AppendClosure])])]) ). }:expand_module_name(Name) -> true ; throw('expand_module_name fail') ), Goal = callable(',', [callable('true', []), ModuleGoal]), FileXml:format('\n', [Title]), ( data.var:check(VarSgn) -> VarSgn = data.ref.backtrackable:new('root'(([Fid], Sgn))), SupScope0 = SupScope ; VarSgnRoot = emop.unionfind:get_root(VarSgn), VarSgnRoot:get('root'((OtherFids, OtherSgn))), VarSgnRoot:set('root'(([Fid | OtherFids], data.list:append(OtherSgn, Sgn)))), SupScope0 = [make_scope(This, OtherSgn, SupScope) | SupScope] ), ModuleQueue:set(['module'(Sgn, Clauses, LocalId, IntEnvTerm, SupScope0, This, EnvRec, EnvVars, EnvList0, SgnVars, Pb, Pe, ModuleGoal0, ModuleGoal, InheritedEnvVars, AdditionalEnvList, Vars) | ModuleQueue:get]). compile_module('module'(Sgn, Clauses, LocalId, IntEnvTerm, SupScope, This, EnvRec, EnvVars, EnvList0, SgnVars, Pb, Pe, ModuleGoal0, ModuleGoal, InheritedEnvVars, AdditionalEnvList, Vars)) :- 'data.atom':format('~a$has_predicate', [LocalId], HasPredicate), module AddClause [LocalId, IntEnvTerm, ExpandFile, HasPredicate] { args(Args) = data.list:append(Args, [IntEnvTerm, var('$CutLevel')]). prefixed(F) = data.atom:format('~a:~a', [LocalId, F]). add_clause(F, Args, Body) :- ExpandFile:add_clause(prefixed(F), args(Args), Body). proto_args(N, Args) :- ( 'data.number':(N > 0) -> 'data.atom':format('__~d', [N], Atom), Args = [var(Atom) | Tail], 'data.number':pred(N, M), proto_args(M, Tail) ; Args = [] ). add_predicate(F, N) :- proto_args(N, ProtoArgs), 'data.list':append( ProtoArgs, [var('$env'), var('$CutLevel')], ProtoEnv ), ExpandFile:add_clause( HasPredicate, [callable(F, ProtoArgs)], callable('true', []) ), PrefixedF = prolog_predicate_name(LocalId, F), ExpandFile:add_clause( predicate_name_direct(PrefixedF), data.list:append(ProtoArgs, [var('$env')]), callable( ',', [ callable( ',', [ callable('!', []), callable( '=', [ var('$CutLevel'), callable('$cut', []) ] ) ] ), callable( PrefixedF, ProtoEnv ) ] ) ), ExpandFile:add_clause( LocalId, [callable(F, ProtoArgs), var('$env'), var('_'), var('$CutLevel')], callable( ',', [ callable('!', []), callable(PrefixedF, ProtoEnv) ] ) ). }, AddClause:add_predicate('$sgn', 1), AccuGoal = data.ref.backtrackable:new(callable('true', [])), module SimplifySgn [AccuGoal, ExpandFile, LocalId] { simpl(Sgn) = data.list:fold_right(Sgn, callable('[]', [])) { as_sub_clause(Term) = ( ClauseName = prolog_predicate_name(LocalId, data.atom:new), V = data.atom:new, ExpandFile:add_clause(ClauseName, [var('$s'), var('$Pb'), var('$Pe')], callable('=', [var('$s'), Term])), data.ref.(AccuGoal <- callable(',', [?AccuGoal, callable(ClauseName, [var(V), var('$Pb'), var('$Pe')])])) ) >> var(V). do(syntax(S, _, _), T) = ! >> callable('.', [as_sub_clause(callable('syntax', [simplify_args(S), var('$Pb'), var('$Pe')])), T]). do(level(S, _, _), T) = ! >> callable('.', [as_sub_clause(callable('level', [simplify_args(S), var('$Pb'), var('$Pe')])), T]). do('notation'(S, _, _), T) = ! >> callable('.', [as_sub_clause(callable('notation', [simplify_args(S), var('$Pb'), var('$Pe')])), T]). do(symbol(F, N, Kind, ArgsInfo, _Pos), T) = ! >> callable('.', [as_sub_clause(callable('symbol', ['term'(F), 'number'(N), 'term'(Kind), simplify_args_info(ArgsInfo), var('$pos')])), T]). do(_, T) = T. simplify_args_info([H | T]) = ! >> simpl([H | T]). simplify_args_info(T) = 'term'(T). simplify(callable(F, Escaped, Args, _, _)) = ! >> callable('callable', [callable(F, []), callable(Escaped, []), simplify_args(Args), var('$Pb'), var('$Pe')]). simplify('()'(X, _, _)) = ! >> callable('()', [simplify(X), var('$Pb'), var('$Pe')]). simplify('.()'(M, Term, _, _)) = ! >> callable('.()', [simplify(M), simplify(Term), var('$Pb'), var('$Pe')]). simplify(X) = 'term'(X). simplify_args(none) = callable('none', []). simplify_args([]) = callable('[]', []). simplify_args([H | T]) = callable('.', [simplify(H), simplify_args(T)]) } }, ShortSgn = SimplifySgn:simpl(Sgn), AddClause:add_clause( '$sgn', [var('$sgn')], callable( ',', [ callable( '=', [ var('$Pb'), term(Pb) ] ), callable( ',', [ callable( '=', [ var('$Pe'), term(Pe) ] ), callable( ',', [ callable( '=', [ var('$pos'), callable('file', [var('$Pb'), var('$Pe')]) ] ), callable( ',', [ data.ref.(?AccuGoal), callable('=', [var('$sgn'), ShortSgn]) ] ) ] ) ] ) ] )), data.list:iter(Sgn) [AddClause] { do(symbol(F, N, Kind, _, _)) :- !, do(Kind, F, N). do(_). do('predicate', F, N) :- AddClause:add_predicate(F, N). do('constructor', F, N) :- AddClause:add_predicate(F, N), data.list:length(Args, N), data.list:iter(Args) { do = emop.parser:fresh_var }, data.list:append(Args0, [Result], Args), List0 = data.list:fold_right(Args0, callable('[]', [])) { do(Hd, Tl) = callable('.', [Hd, Tl]) }, List = callable('.', [callable(F, []), List0]), Body = callable('=..', [Result, List]), AddClause:add_clause(F, Args, Body). do('abstract', _, _). }, ImplicitConstructorsRef = data.ref.backtrackable:new([]), GrammarRef = data.ref.backtrackable:new(emop.parser:grammar_empty), ScopeStack = [scope(This, Sgn, GrammarRef:get) | SupScope], CurrentScopeRef = data.ref.backtrackable:new(ScopeStack), EnvListRef = data.ref.backtrackable:new(InheritedEnvVars), ModuleGoalRef = data.ref.backtrackable:new(callable('true', [])), ( data.list:iter(Clauses) [ AddClause, EnvRec, This, EnvVars, CurrentScopeRef, ImplicitConstructorsRef, Impl, EnvList0, FileXml, SgnVars, EnvListRef, ModuleGoalRef ] { do(special(S, Desc, Pb, Pe)) :- do_special(S, Desc, Pb, Pe). do_special(S match ('syntax'; 'level'; 'notation'), Desc, Pb, Pe) :- !, CurrentScopeRef:get([scope(This, Sgn, Grammar) | SupScope]), SupGrammars = Impl:grammars(SupScope), GrammarRef = data.ref.backtrackable:new(Grammar), S match ( 'syntax' -> emop.parser:expand_syntax(GrammarRef, SupGrammars, Desc, Pb, Pe) ; 'level' -> emop.parser:expand_level(GrammarRef, SupGrammars, Desc, Pb, Pe) ; 'notation' -> emop.parser:add_notation(GrammarRef, SupGrammars, Desc, Pb, Pe) ), CurrentScopeRef:set([scope(This, Sgn, GrammarRef:get) | SupScope]). do_special('import', S, Pb, Pe) :- !, FreeVars = data.list:iter(EnvList0) { do(var(X)) = X }, data.list:iter(expand_import(S, file(Pb, Pe), FreeVars, SgnVars, EnvRec, EnvVars, ImplicitConstructorsRef, some(This), CurrentScopeRef:get)) { do('import'(H1, SubSgn, Goal0)) :- FreshPred = data.atom:format('$init~d', [fresh_init_goal_id]), ( H1 = var(HVarMod) -> ( EnvListRef:get(CurrentEnvList), \+ data.list:member(H1, CurrentEnvList) -> emop.parser:fresh_var(HF), HF = var(HFVarMod), Goal1 = callable(',', [Goal0, callable('=', [HF, H1])]), EnvListRef:set([HF | CurrentEnvList]) ; HF = H1, HFVarMod = HVarMod, FreshArgs = [], Goal1 = Goal0 ), SgnVars:{HFVarMod} = SubSgn ; HF = H1, HFVarMod = HVarMod, FreshArgs = [], Goal1 = Goal0 ), AddClause:add_clause(FreshPred, FreshArgs, Goal1), ModuleGoalRef:set(Impl:seq(ModuleGoalRef:get, callable(AddClause:prefixed(FreshPred), AddClause:args(FreshArgs)))), CurrentScope = CurrentScopeRef:get, Scope = get_scope(HF, file(Pb, Pe), SgnVars, CurrentScope), CurrentScope = [Head | Tail], CurrentScopeRef:set([Head, Scope | Tail]). }. do_special(_, _, _, _). generate_doc('nodoc', _, _). generate_doc('doc'(Text, _, _), F, Args) :- FileXml:format(' \n', [F, data.list:length(Args)]), ( data.atom:split_at_delim_left(Text, '.', Proto, Desc) -> true ; Desc = Text, N = ( Args = none -> 0 ; data.list:length(Args) ), Proto = data.atom:format('~a/~n', [F, N]) ), FileXml:format(' ~a\n', [Proto]), FileXml:format(' ~a\n', [Desc]), FileXml:print_endline(' '). do(clause(F, Args0, B0, Doc, _, _)) :- generate_doc(Doc, F, Args0), Args = data.list:iter(Args0) { do(X) = emop.parser:internal_reparse(X, Impl:grammars(CurrentScopeRef:get)) }, B = emop.parser:internal_reparse(B0, Impl:grammars(CurrentScopeRef:get)), FreeVars0 = emop.parse:fv_list(Args), FreeVars1 = emop.parse:fv(B), data.list:merge(FreeVars0, FreeVars1, 'data.term', FreeVars2), data.list:append( data.list:iter(EnvList0) { do(var(X)) = X }, FreeVars2, FreeVars ), LocalExpander = expander(EnvRec:copy, SgnVars:copy, some(This), EnvVars, FreeVars, ImplicitConstructorsRef), Ctx = ctx(none, CurrentScopeRef:get), ( Args1 = LocalExpander:transform_term_list(Args, Ctx, Body0) -> true ; throw('error'('expand_args')) ), ( LocalExpander:transform_goal(B, Ctx, Body1) -> true ; io.err:print_endline(B), io.err:flush, throw('error'('expand_goal')) ), Impl:seq(Body0, Body1, Body), queue_check() { do :- LocalExpander:singleton_warning. }, AddClause:add_clause(F, Args1, Body). } -> true ; throw('iter NewClauses') ), AdditionalEnvList = EnvListRef:get, ModuleGoal = Impl:seq(ModuleGoal0, ModuleGoalRef:get), Impl:warning_implicit_constructors( ImplicitConstructorsRef:get, Dependencies:get, file(Pb, Pe) ), FileXml:print_endline(''), ExpandFile:add_clause( LocalId, [var('$t'), var('$env'), var('$pos'), var('$CutLevel')], callable(DynamicId, [var('$t'), var('$env'), var('$pos'), var('$CutLevel')]) ), DynamicId = data.atom:concat(LocalId, '$dynamic'), add_directive(callable('dynamic', [callable('/', [callable(DynamicId, []), number(4)])])), add_clause( DynamicId, [var('$t'), var('_'), var('$pos'), var('$CutLevel')], callable( ',', [ callable('functor', [var('$t'), var('$f'), var('$n')]), callable( 'throw', [ callable( 'error', [ callable( 'unknown_predicate', [ callable('/', [var('$f'), var('$n')]) ] ), var('$pos') ] ) ] ) ] ) ), module Warning [Impl, Vars] { do(Var, var(PB, PE, _, Status)) :- ( Status = 'singleton', PB = 'dummy' -> true ; Impl:var_lookup(Var, PB, PE, Vars, _), % Not singleton! Impl:var_lookup(Var, _, _, Vars, _), ( Status = 'singleton' -> 'emop.message':warning( 'data.atom':format( 'Environment variable never used \'~a\'', [Var] ), file(PB, PE) ) ; true ) ). }, queue_check() [EnvRec, Warning] { do :- EnvRec:iter(Warning). }. expander(Vars, SgnVars, ThisOption, InheritedEnvVars, FreeVars, ImplicitConstructorsRef, Expander) :- module Expander [Vars, SgnVars, ThisOption, InheritedEnvVars, FreeVars, Expander, Impl, ImplicitConstructorsRef, Dependencies] { singleton_warning :- module Warning [] { do(Var, var(PB, PE, Kind, Status)) :- ( Kind = 'local', Status = 'singleton', \+ 'data.atom':sub(Var, 0, 1, _, '_') -> 'emop.message':warning( 'data.atom':format( 'Singleton variable \'~a\'', [Var] ), file(PB, PE) ) ; true ). }, Vars:iter(Warning). ast_match(A, '()'(B, _, _)) :- !, ast_match(A, B). ast_match('()'(A, _, _), B) :- ast_match(A, B). ast_match('var'(X), Y) :- !, Y = callable(F, Escaped, Args, _, _), emop.parser:is_variable(F, Escaped, Args), X = 'variable'(Y). ast_match('number'(X), Y) :- !, Y = number(_, _, _), X = 'variable'(Y). ast_match('variable'(X), Y) :- !, X = 'variable'(Y). ast_match( callable(F, _Escaped, Args0, _, _), callable(F0, Escaped0, Args1, _, _) ) :- !, \+ emop.parser:is_variable(F0, Escaped0, Args1), ( F = 'variable'(X, Escaped1, Arity) -> X = F0, Escaped1 = Escaped0, Arity = data.list:length(Args0) ; F = F0, Escaped0 \= 'escaped' ), ( Args0 = none -> Args1 = none ; Args1 = none -> ( Args0 = none -> true ; Args0 = ['seq'('seq'([]))] ) ; module [] { match_args([], []). match_args(['seq'(X) | Tail0], List) :- !, X = 'seq'(Sublist0), data.list:append(Sublist0, Tail1, List), match_args(Tail0, Tail1). match_args([U | T0], [V | T1]) :- ast_match(U, V), match_args(T0, T1). }:match_args(Args0, Args1) -> true ). ast_match('module'(Name0, Env0, Body0, _, _), module(Name1, Env1, Body1, Sgn1, Clauses1, _, _)) :- Name0 = 'variable'(Name1), module [] { match_args([], []). match_args(['seq'(X) | Tail0], List) :- !, X = 'seq'(Sublist0), data.list:append(Sublist0, Tail1, List), match_args(Tail0, Tail1). match_args(['variable'(U) | T0], [U | T1]) :- match_args(T0, T1). }:match_args(Env0, Env1), Body0 = 'module'(Body1, Sgn1, Clauses1). ast_match(number(X, _, _), number(X, _, _)). transform_goal(Goal0, Ctx, Goal1) :- Ctx = ctx(_, Scope), ( data.list:member(scope(_, _, Grammar), Scope), Grammar = grammar(_, _, LevelIds, _, _), GoalId = LevelIds:{'goal'}, \+ data.var:check(GoalId) -> expand_notation(Goal0, Scope, GoalId, Goal2) ; Goal2 = Goal0 ), expand_goal(Goal2, Ctx, Goal1). transform_term(Term0, Ctx, Goal1, Term1) :- Ctx = ctx(_, Scope), ( data.list:member(scope(_, _, Grammar), Scope), Grammar = grammar(_, _, LevelIds, _, _), TermId = LevelIds:{'term'}, \+ data.var:check(TermId) -> expand_notation(Term0, Scope, TermId, Term2) ; Term2 = Term0 ), expand_term(Term2, Ctx, Goal1, Term1). transform_term_list([], _, callable('true', []), []). transform_term_list([H0 | T0], Ctx, Goal1, [H1 | T1]) :- transform_term(H0, Ctx, G0, H1), transform_term_list(T0, Ctx, G1, T1), Impl:seq(G0, G1, Goal1). expand_notation(Ast0, Scope, Level, Ast1) :- ( expand_notation_step(Ast0, Scope, Level, Ast2) -> expand_notation(Ast2, Scope, Level, Ast1) ; Ast0 = Ast1 ). init_sequence('seq'(M), S, Pb, Pe) :- data.list:length(M, N), data.list:length(S, N), data.list:iter(S) { do = emop.parser:fresh_var match ( var(X) -> callable(X, variable, none, Pb, Pe) ) }. build_sequence(S, Pb, Pe) = S match ( [] -> callable('true', unescaped, none, Pb, Pe) ; [SH | ST] -> data.list:fold_left(ST, SH) { do(H, Seq) = callable(',', operator, [Seq, H], Pb, Pe) } ). split_list([], [], []). split_list([[H | T] | Ls], [H | Hs], [T | Ts]) :- split_list(Ls, Hs, Ts). template_sequence(AccuLists, AccuVars, M, Pb, Pe, S) :- template_sequence_( data.list:iter(AccuLists) { do('seq'(X)) = ! >> X. do(X) = X. }, AccuVars, M, Pb, Pe, S ). template_sequence_(AccuLists, AccuVars, M, Pb, Pe, S) :- ( split_list(AccuLists, AccuHeads, AccuTails) -> data.term:copy((AccuVars, M), (AccuHeads, H)), S = [rebuild(H, file(Pb, Pe)) | T], template_sequence(AccuTails, AccuVars, M, Pb, Pe, T) ; S = [] ). rebuild_('variable'(X), _, X). rebuild_('fresh'(X), file(Pb, Pe), X) :- ( data.var:check(X) -> emop.parser:fresh_var(var(Name)), X = callable(Name, variable, none, Pb, Pe) ; true ). rebuild_('seq'(S, M), file(Pb, Pe), X) :- init_sequence(M, S, Pb, Pe), X = build_sequence(S, Pb, Pe). rebuild_('seq'(AccuLists, AccuVars, M), file(Pb, Pe), X) :- template_sequence(AccuLists, AccuVars, M, Pb, Pe, S), X = build_sequence(S, Pb, Pe). rebuild_(callable(F, Escaped, Args0, _, _), file(Pb, Pe), callable(F, Escaped, Args1, Pb, Pe)) :- ( Args0 = none -> Args1 = none ; Args1 = data.list:morph(Args0) { do('seq'(A)) = ! >> A. do('seq'(S, M)) = (!, init_sequence(M, S, Pb, Pe)) >> S. do('seq'(AccuLists, AccuVars, M)) = ! >> template_sequence(AccuLists, AccuVars, M, Pb, Pe). do(A) = [rebuild(A, file(Pb, Pe))] } ). rebuild_('module'(Name0, Env0, Body0, _, _), file(Pb, Pe), module(Name1, Env1, Body1, Sgn1, Clauses1, Pb, Pe)) :- Name1 = Name0, ( ( Env0 = none -> Env1 = none ; Env1 = data.list:morph(Env0) { do('seq'(A)) = ! >> A. do('seq'(S, M)) = init_sequence(M, S, Pb, Pe) >> S. do(V) = [rebuild(V, file(Pb, Pe))]. } ) -> true ; throw('rebuild env fail') ), ( Body0 = 'module'(Body1, Sgn1, Clauses1) -> true ; Body0 = 'custom'(Sgn1, Clauses2) -> Clauses1 = data.list:iter(Clauses2) { do(clause(F, Args, B, Doc, _, _)) = ! >> clause(F, data.list:iter(Args) { do(Arg) = rebuild(Arg, file(Pb, Pe)) }, rebuild(B, file(Pb, Pe)), Doc, Pb, Pe). do(A) = A. } ; throw('rebuild body fail') ). rebuild_('()'(T0, _, _), file(Pb, Pe), '()'(T1, Pb, Pe)) :- rebuild(T0, file(Pb, Pe), T1). rebuild_(number(X, _, _), file(Pb, Pe), number(X, Pb, Pe)). rebuild(A, Pos, B) :- ( rebuild_(A, Pos, B) -> true ; throw('rebuild failed'(A)) ). eval_number('number'(X)) = X. eval_number('length'('seq'(X))) = data.list:length(X). eval_number('+'(A, B)) = data.number:(eval_number(A) + eval_number(B)). eval_number('-'(A, B)) = data.number:(eval_number(A) - eval_number(B)). eval_number('*'(A, B)) = data.number:(eval_number(A) * eval_number(B)). eval_number('/'(A, B)) = data.number:(eval_number(A) / eval_number(B)). check_guard(','(A, B), Position, Scope) :- check_guard(A, Position, Scope), check_guard(B, Position, Scope). check_guard(';'(A, B), Position, Scope) :- ( check_guard(A, Position, Scope) ; check_guard(B, Position, Scope) ). check_guard('true', _, _). check_guard('type_term'(Kind, 'variable'(X)), _, _) :- Kind match ( 'var' -> X = callable(F, Escaped, Args, _, _), emop.parser:is_variable(F, Escaped, Args) ; 'number' -> X = number(_, _, _) ). check_guard('sgn_check'(Kind, 'functor'(Mod, Symbol, Escaped, Arity0)), Position, Scope) :- Arity = eval_number(Arity0), ( Mod = 'scope' -> ( Escaped = 'escaped' -> Kind0 = 'constructor' ; module [Kind0, Symbol, Arity] { find([scope(_M, Sgn, _Grammar) | ScopeStack]) :- ( 'data.list':member(symbol(Symbol, Arity, Kind, _ArgsInfo, _), Sgn) -> ( ( Kind = ('predicate') ; Kind = ('abstract') ) -> Kind0 = 'predicate' ; Kind = ('constructor') -> Kind0 = 'constructor' ) ; find(ScopeStack) ). }:find(Scope) ) ; ( Mod = 'variable'(Mod0) -> true ; Mod0 = Mod ), ( Mod0 = callable(MVar, MVEscaped, MVArgs, _, _), emop.parser:is_variable(MVar, MVEscaped, MVArgs) -> MVarEnv = SgnVars:{MVar}, ( data.var:check(MVarEnv) -> fail ; 'root'((_, MSgn)) = emop.unionfind:get_root(MVarEnv):get ) ; Mod0 = callable(Atom, _, none, _, _) -> MSgn = Dependencies:find_mod_sgn(Atom, Position) ), data.list:member(symbol(Symbol, Arity, Kind0, _ArgsInfo, _), MSgn) ), ( Kind = 'symbol' -> true ; Kind = Kind0 ). expand_notation_step(Ast0, Scope, Level, Ast1) :- ( Ast0 = callable(F, _, Args, _, _) -> Index = data.atom:format('~a/~n', [F, (Args = none -> 0; data.list:length(Args))]) ; Index = 0 ), data.list:member(scope(_, _, Grammar), Scope), Grammar = grammar(_, _, _, _, Notations), LevelNotations = Notations:{Level}, \+ data.var:check(LevelNotations), LevelNotations = (Indexed, Unindexed), ( Index \= 0, List = Indexed:{Index}, \+ data.var:check(List) ; List = Unindexed ), data.list:member_last(notation(Head, Guard, Tail), List:get), data.term:copy((Head, Guard, Tail), (Head0, Guard0, Tail0)), ast_match(Head0, Ast0), Position = emop.parse:position(Ast0), check_guard(Guard0, Position, Scope), !, rebuild(Tail0, Position, Ast1). expand_notation_step('()'(Ast0, Pb, Pe), Scope, Level, '()'(Ast1, Pb, Pe)) :- expand_notation_step(Ast0, Scope, Level, Ast1). expand_notation_step('.()'(A0, B0, Pb, Pe), Scope, _, '.()'(A1, B0, Pb, Pe)) :- data.list:member(scope(_, _, Grammar), Scope), Grammar = grammar(_, _, LevelIds, _, _), TermId = LevelIds:{'term'}, \+ data.var:check(TermId), expand_notation_step(A0, Scope, TermId, A1). expand_notation_step(callable(F, Escaped, Args0, Pb, Pe), Scope, Level, callable(F, Escaped, Args1, Pb, Pe)) :- data.list:member(scope(_, _, Grammar), Scope), Grammar = grammar(_, _, _, Levels, _), data.list:member_last(level(LevelList, LF, LEscaped, LArgs), Levels), ( data.list:member(Level, LevelList) -> true ), LEscaped match ( operator -> Escaped \= escaped, F = LF ; unescaped -> true ; 'escaped' -> F = LF ), module [] { compute_level_args([], [], []). compute_level_args([H | T], Args0, LevelArgs) :- H match ( 'seq'(Level) -> data.list:( append(Prefix, Tail, Args0), LevelPrefix = data.list:iter(Prefix) [Level] { do(Arg) = (Level, Arg) }, length(Prefix, N), length(LevelPrefix, N), append(LevelPrefix, LevelTail, LevelArgs) ), compute_level_args(T, Tail, LevelTail) ; Level -> Args0 = [Arg | Tail], LevelArgs = [(Level, Arg) | LevelTail], compute_level_args(T, Tail, LevelTail) ). }:compute_level_args(LArgs, Args0, LevelArgs), !, Args1 = data.list:iter(LevelArgs) [Changed, Scope] { do((Level, Arg0), Arg1) :- ( expand_notation_step(Arg0, Scope, Level, Arg1) -> Changed = 'true' ; Arg1 = Arg0 ). }, \+ Changed = 'false'. expand_goal(callable(F, Escaped, Args, Pb, Pe), Ctx, Goal) :- expand_goal_callable(F, Escaped, Args, Pb, Pe, Ctx, Goal). expand_goal('()'(Term, _, _), Ctx, Goal) :- expand_goal(Term, Ctx, Goal). expand_goal('.()'(Mod, Sub, Pb, Pe), Ctx, Goal) :- expand_term(Mod, Ctx, Goal0, Mod0), open_scope(Mod0, Sub, Pb, Pe, Ctx, Sub0, Ctx0), transform_goal(Sub0, Ctx0, Goal1), Goal = Impl:seq(Goal0, Goal1). expand_goal(module(Name, Env, _, Sgn, Clauses, Pb, Pe), Ctx, Goal) :- Ctx = ctx(_, CurrentScope), expand_module( Name, Pb, Pe, sub_module_env(Env), Sgn, Clauses, InheritedEnvVars, CurrentScope, SgnVars, Vars, Goal ). expand_goal(number(_, Pb, Pe), _, _) :- throw(error('A number is not a valid goal', file(Pb, Pe))). expand_goal(empty(Pb, Pe), _, _) :- throw(error('Empty goal not allowed', file(Pb, Pe))). expand_goal(doc(_, Pb, Pe, _), _, _) :- throw( error('Documentation not allowed here', file(Pb, Pe)) ). expand_goal_callable(',', _, [A0, B0], _, _, Ctx, Goal) :- !, Expander:( expand_goal(A0, Ctx, A1), expand_goal(B0, Ctx, B1) ), Goal = callable(',', [A1, B1]). expand_goal_callable('>>', _, [A0, B0], _, _, Ctx, Goal) :- !, Expander:( expand_goal(A0, Ctx, A1), expand_goal(B0, Ctx, B1) ), Goal = Impl:seq_eq(A1, B1). expand_goal_callable('->', _, [A0, B0], _, _, Ctx, Goal) :- !, Expander:( expand_goal(A0, Ctx, A1), expand_goal(B0, Ctx, B1) ), Goal = callable('->', [A1, B1]). expand_goal_callable(';', _, [A0, B0], _, _, Ctx, Goal) :- !, Expander:( expand_goal(A0, Ctx, A1), expand_goal(B0, Ctx, B1) ), Goal = callable(';', [A1, B1]). % expand_goal_callable('match', operator, [A0, B0], _Pb, _Pe, Ctx, Goal) :- % !, % expand_term(A0, change_current_mod(Ctx, none), AG, A1), % expand_seq_goal(B0, Ctx, A1, 'match', B1), % Impl:seq(AG, B1, Goal). % expand_goal_callable('|', operator, [A0, B0], _Pb, _Pe, Ctx, Goal) :- % !, % expand_term(A0, change_current_mod(Ctx, none), AG, A1), % expand_seq_goal(B0, Ctx, A1, 'pipe', B1), % Impl:seq(AG, B1, Goal). expand_goal_callable(':', _, [A0, B0], Pb, Pe, Ctx, Goal) :- !, expand_term(A0, change_current_mod(Ctx, none), AG, A1), expand_goal(B0, change_current_mod(Ctx, some(Used, A1)), B1), Impl:check_prefix_used(Used, Pb, Pe), Impl:seq(AG, B1, Goal). expand_goal_callable('\\+', _, [A0], _, _, Ctx, Goal) :- !, expand_goal(A0, Ctx, A1), Goal = callable('\\+', [A1]). expand_goal_callable('catch', unescaped, [A0, B0, C0], _, _, Ctx, Goal) :- !, Expander:( expand_goal(A0, Ctx, A1), expand_term(B0, change_current_mod(Ctx, none), BG, B1), expand_goal(C0, Ctx, C1) ), Impl:seq(BG, callable('catch', [A1, B1, C1]), Goal). expand_goal_callable('call_det', unescaped, [A0, B0], _, _, Ctx, Goal) :- !, Expander:( expand_goal(A0, Ctx, A1), expand_term(B0, change_current_mod(Ctx, none), BG, B1) ), Impl:seq(callable('call_det', [A1, B1]), BG, Goal). expand_goal_callable('!', unescaped, empty, _, _, _, Goal) :- !, Goal = make_cut(var('$CutLevel')). expand_goal_callable('!', unescaped, [A], _, _, Ctx, Goal) :- !, expand_term(A, Ctx, AG, AT), Goal = Impl:seq(AG, make_cut(AT)). expand_goal_callable('true', unescaped, empty, _, _, _, Goal) :- !, Goal = callable('true', []). expand_goal_callable('fail', unescaped, empty, _, _, _, Goal) :- !, Goal = callable('fail', []). expand_goal_callable('repeat', unescaped, empty, _, _, _, Goal) :- !, Goal = callable('repeat', []). expand_goal_callable('for', unescaped, [I0, A0, B0], _, _, Ctx, Goal) :- !, Expander:( expand_term(I0, change_current_mod(Ctx, none), IG, I1), expand_term(A0, change_current_mod(Ctx, none), AG, A1), expand_term(B0, change_current_mod(Ctx, none), BG, B1) ), Impl:( seq(IG, AG, Term0), seq(Term0, BG, Term1), seq(Term1, callable('for', [I1, A1, B1]), Goal) ). expand_goal_callable('throw', unescaped, [A0], _, _, Ctx, Goal) :- !, Expander:expand_term(A0, change_current_mod(Ctx, none), AG, A1), Impl:seq(AG, callable('throw', [A1]), Goal). expand_goal_callable('=', _, [A0, B0], _, _, Ctx, Goal) :- !, expand_term(A0, change_current_mod(Ctx, none), AG, A1), expand_term(B0, change_current_mod(Ctx, none), BG, B1), ( A1 = var(V1), B1 = var(V2) -> AS = SgnVars:{V1}, BS = SgnVars:{V2}, ( data.var:check(AS) -> BS = AS ; data.var:check(BS) -> AS = BS ; AR = emop.unionfind:get_root(AS), BR = emop.unionfind:get_root(BS), AR:get('root'((AFids, ASgn))), BR:get('root'((BFids, BSgn))), AR:set('root'((data.list:append(AFids, BFids), data.list:append(ASgn, BSgn)))), BR:set('link'(AR)) ) ; true ), Impl:seq(AG, BG, Term), ( ( A1 = 'var'('_') ; B1 = 'var'('_') ) -> Goal = Term ; Impl:seq(callable('=', [A1, B1]), Term, Goal) ). expand_goal_callable('\\=', _, [A0, B0], _, _, Ctx, Goal) :- !, expand_term(A0, change_current_mod(Ctx, none), AG, A1), expand_term(B0, change_current_mod(Ctx, none), BG, B1), Impl:( seq(AG, BG, SubG), seq(SubG, callable('\\=', [A1, B1]), Goal) ). expand_goal_callable('==', _, [A0, B0], _, _, Ctx, Goal) :- !, expand_term(A0, change_current_mod(Ctx, none), AG, A1), expand_term(B0, change_current_mod(Ctx, none), BG, B1), Impl:( seq(AG, BG, SubG), seq(SubG, callable('==', [A1, B1]), Goal) ). expand_goal_callable(F, Escaped, Args, Pb, Pe, Ctx, Goal) :- ( emop.parser:is_variable(F, Escaped, Args) -> throw(error(data.atom:format('Variable ~a is not a valid goal', [F]), file(Pb, Pe))) ; expand_term_list(Args, change_current_mod(Ctx, none), G0, Args1), expand_call(F, Escaped, Args1, Pb, Pe, Ctx, G1), Impl:seq(G0, G1, Goal) ). make_cut(AT) = callable( ',', [ callable('true', []), callable( ',', [ callable( '=', [ AT, callable('$cut', []) ] ), callable('!', []) ] ) ] ). change_current_mod( ctx(_CurrentMod, CurrentScope), NewMod, ctx(NewMod, CurrentScope) ). open_scope(Mod, Sub, Pb, Pe, Ctx, Sub0, Ctx0) :- Ctx = ctx(CurrentMod, CurrentScope), Scope = get_scope(Mod, file(Pb, Pe), SgnVars, CurrentScope), CurrentScope0 = [Scope | CurrentScope], Sub0 = emop.parser:internal_reparse(Sub, Impl:grammars(CurrentScope0)), Ctx0 = ctx(CurrentMod, CurrentScope0). expand_call(F, Escaped, Args, Pb, Pe, Ctx, Goal) :- Ctx = ctx(CurrentMod, CurrentScope), data.list:length(Args, N), module [F, N, Escaped, Args, Pb, Pe, Goal, CurrentScope, ImplicitConstructorsRef, SgnVars, Dependencies, Fid] { constr(N0) :- data.list:( append(Args0, [Result], Args), !, length(Args0, N0) ), Goal = callable('=', [Result, callable(F, Args0)]). expand_call(none) :- module SolveScope [F, N, Args, Pb, Pe, ImplicitConstructorsRef, Escaped, SgnVars, Dependencies, Fid] { find([]) :- ( Args = empty -> throw(error(data.atom:format('Unknown predicate ~a/0', [F]), file(Pb, Pe))) ; constr(N0), ( Escaped = 'escaped' -> true ; ImplicitConstructors = ImplicitConstructorsRef:get, ( data.list:member('c'(F, N0, Usages), ImplicitConstructors) -> data.list:add_to_left(file(Pb, Pe), Usages) ; ImplicitConstructorsRef:set( [ 'c'(F, N0, [file(Pb, Pe)]) | ImplicitConstructors ] ) ) ) ). find([scope(M, Sgn, _Grammar) | ScopeStack]) :- ( 'data.list':member(symbol(F, N, Kind, ArgsInfo, _), Sgn) -> make_call(M, Kind), get_args_info(ArgsInfo, Sgn, SgnVars, [], Dependencies, file(Pb, Pe), [Fid], Args) ; find(ScopeStack) ). }, ( Escaped = 'escaped' -> constr(_) ; SolveScope:find(CurrentScope) -> true ; throw('error'('scope resolution failed')) ). expand_call(some('used', callable('top', []))) :- !, Goal = callable(F, Args). expand_call(some('used', M)) :- ( M = callable(Atom, []) -> MSgn = Dependencies:find_mod_sgn(Atom, file(Pb, Pe)), check_defined(MSgn, Kind), make_call(M, Kind) ; M = var(MVar) -> MVarEnv = SgnVars:{MVar}, ( data.var:check(MVarEnv) -> true ; 'root'((_, MSgn)) = emop.unionfind:get_root(MVarEnv):get, check_defined(MSgn, Kind) ), make_call(M, Kind) ). make_call(M, Kind) :- ( ( Kind = ('predicate') ; Kind = ('abstract') ) -> ( M = callable(Atom, []) -> emop.parser:fresh_var(CallEnv), ModName = prolog_module_name(Atom), Goal = callable( ',', [ callable( 'g_read', [ callable(Atom, []), callable(ModName, [CallEnv]), ] ), callable( prolog_predicate_name(ModName, predicate_name_direct(F)), data.list:append(Args, [CallEnv]) ) ] ) ; emop.message:position_text(file(Pb, Pe), Text), Goal = callable('emop_call', [M, callable(F, Args), callable(Text, [])]) ) ; Kind = ('constructor') -> constr(_N0) ). check_defined(MSgn, Kind) :- N = data.list:length(Args), ( 'data.list':member(symbol(F, N, Kind, ArgsInfo, _), MSgn) -> ( Kind = 'predicate' -> get_args_info(ArgsInfo, MSgn, SgnVars, [], Dependencies, file(Pb, Pe), [Fid], Args) ; true ) ; emop.message:warning(data.atom:format('Predicate ~a/~d may be undefined.', [F, N]), file(Pb, Pe)) ). }:expand_call(CurrentMod). sub_module_env('none') = ! >> data.list:iter(FreeVars) [] { do(X) = callable(X, variable, none, 'dummy', 'dummy') }. sub_module_env(Env) = Env. expand_term_list(none, _, callable('true', []), []). expand_term_list([], _, callable('true', []), []). expand_term_list([H0 | T0], Ctx, G, [H1 | T1]) :- Expander:( expand_term(H0, Ctx, G0, H1), expand_term_list(T0, Ctx, G1, T1) ), Impl:seq(G0, G1, G). expand_term_call(F, Escaped, Args, Pb, Pe, Ctx, Goal, Term) :- ( emop.parser:fresh_var(Term0), data.list:append(Args, [Term0], Args0), expand_call(F, Escaped, Args0, Pb, Pe, Ctx, G1), ( G1 = callable('=', [Term0, callable(F, Args1)]) -> Goal = callable('true', []), Term = callable(F, Args1) ; Goal = G1, Term = Term0 ) -> true ; throw(error('expand_term_call failed', file(Pb, Pe))) ). expand_subterm(F, Escaped, Args0, Pb, Pe, Ctx, Goal, Term) :- expand_term_list(Args0, change_current_mod(Ctx, none), G0, Args1), expand_term_call(F, Escaped, Args1, Pb, Pe, Ctx, G1, Term), Impl:seq(G0, G1, Goal). expand_term(callable(F, Escaped, Args, Pb, Pe), Ctx, Goal, Term) :- expand_term_callable(F, Escaped, Args, Pb, Pe, Ctx, Goal, Term). expand_term('()'(SubTerm, _, _), Ctx, Goal, Term) :- expand_term(SubTerm, Ctx, Goal, Term). expand_term('.()'(Mod, Sub, Pb, Pe), Ctx, Goal, Term) :- expand_term(Mod, Ctx, Goal0, Mod0), open_scope(Mod0, Sub, Pb, Pe, Ctx, Sub0, Ctx0), transform_term(Sub0, Ctx0, Goal1, Term), Goal = Impl:seq(Goal0, Goal1). expand_term(module(Name, Env, _Body, Sgn, Clauses, PB, PE), Ctx, Goal, Term) :- Name = atom(Atom, Escaped, _, _), ( emop.parser:is_variable(Atom, Escaped, none) -> ( Atom = '_' -> emop.parser:fresh_var(Term), Term = var(FreshVarName), Name0 = atom(FreshVarName, variable, PB, PE) ; Name0 = Name, Term = var(Atom) ) ; Name0 = Name, Term = callable(Atom, []) ), Ctx = ctx(_, CurrentScope), expand_module( Name0, PB, PE, sub_module_env(Env), Sgn, Clauses, InheritedEnvVars, CurrentScope, SgnVars, Vars, Goal ). expand_term(number(Number, _, _), _, Goal, Term) :- Goal = callable('true', []), Term = number(Number). expand_term(empty(Pb, Pe), _, _, _) :- throw(error('Empty term not allowed', file(Pb, Pe))). expand_term(doc(_, Pb, Pe, _), _, _, _) :- throw( error('Documentation not allowed here', file(Pb, Pe)) ). % expand_term_callable('->', operator, [A0, B0], _, _, Ctx, Goal, Term) :- % !, % Expander:( % expand_goal(A0, Ctx, A1), % expand_term(B0, Ctx, B1, Term) % ), % Goal = callable('->', [A1, B1]). expand_term_callable('>>', (unescaped; operator), [A0, B0], _, _, Ctx, Goal, Term) :- !, Expander:( expand_goal(A0, Ctx, A1), expand_term(B0, Ctx, B1, Term) ), Goal = Impl:seq_eq(A1, B1). % expand_term_callable(';', operator, [callable('->', operator, [C0, A0], _, _), B0], _, _, Ctx, Goal, Term) :- % !, % Expander:( % expand_goal(C0, Ctx, C1), % expand_term(A0, Ctx, AG, A1), % expand_term(B0, Ctx, BG, B1) % ), % emop.parser:fresh_var(Term), % Goal = callable(';', [ % callable('->', [ % C1, % callable(',', [AG, callable('=', [A1, Term])]) % ]), % callable(',', [BG, callable('=', [B1, Term])]) % ]). % expand_term_callable(';', operator, [A0, B0], _, _, Ctx, Goal, Term) :- % !, % Expander:( % expand_term(A0, Ctx, AG, A1), % expand_term(B0, Ctx, BG, B1) % ), % emop.parser:fresh_var(Term), % Goal = callable(';', [ % callable(',', [AG, callable('=', [A1, Term])]), % callable(',', [BG, callable('=', [B1, Term])]) % ]). expand_term_callable(':', (unescaped; operator), [A0, B0], Pb, Pe, Ctx, Goal, Term) :- !, expand_term(A0, Ctx, AG, A1), expand_term(B0, change_current_mod(Ctx, some(Used, A1)), BG, B1), Impl:check_prefix_used(Used, Pb, Pe), Impl:seq(AG, BG, Goal), Term = B1. expand_term_callable(':', (unescaped; operator), [A0], _Pb, _Pe, Ctx, Goal, Term) :- !, Expander:expand_term(A0, change_current_mod(Ctx, none), Goal, Term). expand_term_callable('this', unescaped, none, Pb, Pe, _Ctx, Goal, Term) :- !, Goal = callable('true', []), ( ThisOption = 'none' -> throw( error( '\'this\' cannot be used outside a module', file(Pb, Pe) ) ) ; ThisOption = some(Term) ). expand_term_callable(F, Escaped, Args, Pb, Pe, Ctx, Goal, Term) :- ( emop.parser:is_variable(F, Escaped, Args) -> Goal = callable('true', []), Impl:var_lookup(F, Pb, Pe, Vars, _), Term = var(F) ; expand_subterm(F, Escaped, Args, Pb, Pe, Ctx, Goal, Term) ). }. dequeue_modules :- ( ModuleQueue:get([H | T]) -> ModuleQueue:set(T), compile_module(H), dequeue_modules ; true ). }, ImplicitConstructorsRef = data.ref.backtrackable:new([]), module Expander { expand_goal(Ast, Scope, SgnVars, FreeVars, SingletonWarning, Goal) :- Vars = 'data.record':({}), ExpandFile:expander( Vars, SgnVars, none, [], FreeVars, ImplicitConstructorsRef, ExpandGoal ), Ast0 = emop.parser:internal_reparse(Ast, Impl:grammars(Scope)), ExpandGoal:transform_goal(Ast0, ctx(none, Scope), Goal), ( SingletonWarning = 'singleton_warning' -> ExpandFile:queue_check() { do :- ExpandGoal:singleton_warning. } ; true ). expand_import(Ast, Pos, FreeVars, SgnVars, Scope, Goals) :- EnvRec = data.record:{}, EnvVars = [], ThisOption = none, ExpandFile:expand_import(Ast, Pos, FreeVars, SgnVars, EnvRec, EnvVars, ImplicitConstructorsRef, ThisOption, Scope, Goals). close(ModuleList, Clauses) :- Impl:warning_implicit_constructors(ImplicitConstructorsRef:get, Dependencies:get, file(Filename)), ExpandFile:dequeue_modules, data.list:iter(CheckQueue:get) [] { do(Check) :- Check:do. }, ModuleList = ModuleListRef:get, Clauses = data.list:reverse(ClausesRef:get). get_scope(Mod, Pos, SgnVars, CurrentScope, Scope) :- ExpandFile:get_scope(Mod, Pos, SgnVars, CurrentScope, Scope). }. }, module Impl [] { constructor: file/2, callable/5, error/2, dep/2, var/4, doc/4, var/3, '/'/2, unescaped/0, operator/0, 'module'/7, scope/3. grammars([]) = []. grammars([scope(_, _, Grammar) | Scopes]) = [Grammar | grammars(Scopes)]. warning_implicit_constructors(Constructors, Dependencies, Pos) :- Constructors0 = data.list:fold_left(Constructors, []) [Dependencies] { do('c'(F, 0, _), Constructors, Constructors) :- data.list:member(dep(F, _), Dependencies), !. do('c'(F, N, U), Constructors, ['c'(F, N, U) | Constructors]). }, warning_implicit_constructors_aux(Constructors0, Pos). warning_implicit_constructors_aux([], _) :- !. warning_implicit_constructors_aux(Constructors, Pos) :- Sgn = data.list:iter(Constructors) { do('c'(F, N, _)) = F / N }, emop.message:warning( data.atom:format('Implicit constructors: ~q', [Sgn]), Pos ), data.list:iter(Constructors) { do('c'(F, N, Usages)) :- [First | Others] = data.list:reverse(Usages), io.err:format('~q appears at ~a', [F / N, emop.message:line_text(First, 'lowercase')]), data.list:iter(Others) { do(OtherPos) :- io.err:format(' and ~a', [emop.message:line_text(OtherPos, 'lowercase')]) }, io.err:print_endline('.'). }, io.err:endline. var_lookup(Name, PB, PE, Vars, Var) :- Var = Vars:({Name}), ( 'data.var':check(Var) -> Var = var(PB, PE, 'local', _) ; Var = var(_, _, _, 'non_singleton') ). extract_env(StructEnv, EnvRec, Env, SupSgnVars, SgnVars) :- module Extract [Extract, EnvRec, SupSgnVars, SgnVars] { do(callable(Atom, Escaped, Args, Pb, Pe), Result) :- ( emop.parser:is_variable(Atom, Escaped, Args) -> ( Atom = '_' -> throw( error('Anonymous environment variable', file(Pb, Pe)) ) ; true ), SgnVars:{Atom} = SupSgnVars:{Atom}, Var = EnvRec:({Atom}), ( 'data.var':check(Var) -> Result = ['var'(Atom)], Var = var(Pb, Pe, 'env', _) ; Result = [], ( Pb \= 'dummy' -> 'emop.message':warning( 'data.atom':format( 'Duplicated variable in environment \'~a\'', [Atom] ), file(Pb, Pe) ) ; true ) ) ; throw( error('A term cannot appear in an environment', file(Pb, Pe)) ) ). do('()'(SubEnv, _, _), Env) :- Extract:do(SubEnv, Env). do(module(_, _, _, _, _, Pb, Pe), _) :- throw( error('A module cannot appear in an environment', file(Pb, Pe)) ). do('number'(_, Pb, Pe), _) :- throw( error('A number cannot appear in an environment', file(Pb, Pe)) ). do('empty'(Pb, Pe), _) :- throw( error('Empty item not allowed in an environment', file(Pb, Pe)) ). do(doc(_, Pb, Pe, _), _) :- throw( error('Documentation not allowed here', file(Pb, Pe)) ). }, 'data.list':morph(StructEnv, Extract, Env). constructor: callable/2. seq(callable('true', []), G, G) :- !. seq(G, callable('true', []), G) :- !. seq(G0, G1, callable(',', [G0, G1])). has_cut(callable((','; ';'; '->'), [G, G'])) :- !, ( has_cut(G) -> true ; has_cut(G') ). has_cut(callable('!', ([]; [_]))). seq_eq(callable('true', []), G, G) :- !. seq_eq(G, callable('true', []), G) :- !. seq_eq(G0, G1) = (has_cut(G0), !) >> callable(',', [G0, G1]). seq_eq(G, callable('=', [X, Y])) = ! >> callable(',', [callable('=', [X, Y]), G]). seq_eq(G0, callable(',', [callable(',', [G1, G2]), G3])) = ! >> seq_eq(G0, callable(',', [G1, callable(',', [G2, G3])])). seq_eq(G0, callable(',', [callable('=', [X, Y]), G1])) = ! >> callable(',', [callable('=', [X, Y]), seq_eq(G0, G1)]). seq_eq(G0, G1, callable(',', [G0, G1])). check_prefix_used(Used, Pb, Pe) :- ( 'data.var':check(Used) -> 'emop.message':warning( 'Unused prefix', file(Pb, Pe) ) ; true ). }