1:- module(redcg, [ 2 op(1200, xfx, '-->>'), % EDCG rule operator (mirrors EDCG) 3 op(1200, xfx, '==>>'), % reserved (SSU variant) — not yet implemented 4 redcg_import_sentinel/0 5]).

redcg — EDCG-compatible front-end over a record-threaded back-end

Write multi-accumulator predicates in EDCG's surface syntax — the declarations acc_info/5, pass_info/1, pred_info/3 and -->> rules with [Term]:Acc (accumulate), bare [Term] (accumulate onto the built-in dcg list), X/Acc (read current), Acc/X (read final), X/Acc/Y (read both) and insert/2 — but have them expand onto Peter Ludemann's record-threading technique: all hidden state is packed into a single :- record term (library(record)) threaded through one hidden In/Out pair, with every field read/write inlined to plain unification at expansion time.

Backwards compatibility with library(edcg). An EDCG program should run under redcg by swapping library(edcg) for library(redcg) and the `edcg:` declaration prefix for `redcg:`. redcg matches EDCG on: the built-in dcg accumulator, bare-list terminals, the [T]:Acc / X/Acc / Acc/X / X/Acc/Y / insert/2 operators, cuts and {} in bodies, arbitrary-arity base predicates, and the per-accumulator In/Out public-argument convention (accumulator = +2 args, passed arg = +1, in pred_info order). Accumulator direction follows your acc_info/5 declaration positionally, exactly as EDCG.

Like EDCG, this module exports nothing but its operators and the opt-in sentinel. Declarations are `redcg:`-qualified multifile facts:

redcg:acc_info(count, X, In, Out, plus(X, In, Out)).
redcg:pass_info(limit).
redcg:pred_info(sum_e, 1, [count]).

Enable expansion in a module by importing this one (:- use_module(library(redcg))); the import is the opt-in signal, exactly as EDCG uses its own sentinel.

See README.md for the design write-up and the honest EDCG-vs-record benchmark.

42:- use_module(library(record)). 43:- use_module(library(lists), [nth1/3, append/3]). 44 45% ---- user-facing declaration hooks (multifile, `redcg:`-qualified) ---------- 46% EDCG-style contract: users add facts with the redcg: prefix. Declared 47% multifile so a client file can contribute them; zero clauses fail cleanly. 48 49:- multifile 50 acc_info/5, % acc_info(Name, Term, Left, Right, Joiner) 51 pass_info/1, % pass_info(Name) 52 pred_info/3. % pred_info(Name, BaseArity, HiddenList) 53 54% ---- built-in accumulators (EDCG parity) ------------------------------------ 55% `dcg` is the standard DCG list accumulator, always available (as in EDCG): 56% threading Left = [Term|Right] builds the list in forward order. 57builtin_acc_info(dcg, T, S0, S, S0 = [T|S]). 58 59% acc_lookup/5: resolve a name against user acc_info first, then the built-ins. 60acc_lookup(Name, Term, Left, Right, Joiner) :- 61 ( acc_info(Name, Term, Left, Right, Joiner) *-> true 62 ; builtin_acc_info(Name, Term, Left, Right, Joiner) ). 63 64% is_acc/1: is Name an accumulator (user-declared or built-in)? 65is_acc(Name) :- acc_info(Name, _,_,_,_), !. 66is_acc(Name) :- builtin_acc_info(Name, _,_,_,_). 67 68% ---- per-source-file expansion state ---------------------------------------- 69% Keyed by source file so a re-consult re-emits the record directive + wrappers 70% (a persistent flag would survive reload and leave wrappers missing). 71 72:- dynamic record_emitted/1. % record_emitted(SourceFile) 73:- dynamic wrapper_done/3. % wrapper_done(SourceFile, Name, BaseArity) 74 75% Reset this file's emission state at the start of every (re)load. NOT gated on 76% wants_expansion: begin_of_file fires BEFORE the client's use_module(library(redcg)) 77% runs, so the sentinel isn't visible yet. Resetting a non-redcg file's (absent) 78% flags is a harmless no-op, and guarantees a clean slate on every re-consult. 79user:term_expansion(begin_of_file, _) :- 80 prolog_load_context(source, File), 81 retractall(record_emitted(File)), 82 retractall(wrapper_done(File, _, _)), 83 fail. % never consume begin_of_file 84 85redcg_import_sentinel. 86 87% opt-in detection: only expand in modules that imported us 88wants_expansion :- 89 prolog_load_context(module, M), 90 M \== redcg, 91 predicate_property(M:redcg_import_sentinel, imported_from(redcg)). 92 93% ---- field layout ----------------------------------------------------------- 94% Derived from the declared facts plus the built-in `dcg`, recomputed each 95% expansion. sort/2 makes the layout deterministic and order-independent; the 96% only requirement is that every rule in a file sees the same declarations. 97 98field_order(Fields) :- 99 findall(A, acc_info(A,_,_,_,_), As0), 100 findall(P, pass_info(P), Ps0), 101 sort([dcg|As0], As), % `dcg` is always an available accumulator 102 sort(Ps0, Ps), 103 append(As, Ps, Fields). 104 105% ---- clause expansion ------------------------------------------------------- 106 107user:term_expansion((H -->> B), Clauses) :- 108 wants_expansion, 109 expand_rule(H, B, Clauses). 110 111expand_rule(H, B, Clauses) :- 112 functor(H, Name, BaseArity), 113 ( pred_info(Name, BaseArity, Hidden) -> true 114 ; throw(error(redcg(no_pred_info(Name/BaseArity)), _)) ), 115 field_order(Fields), 116 H =.. [Name | BaseArgs], 117 internal_name(Name, IName), 118 IHead =.. [IName | BaseArgs], 119 add_state_pair(IHead, S0, S, IHeadS), 120 % S is the clause-final record; Acc/X and X/Acc/Y read their final values 121 % from it. (It is the same variable threaded out of the last body goal.) 122 expand_body(B, S0, S, S, Fields, TBody), 123 Clause = (IHeadS :- TBody), 124 preamble(Name, BaseArity, Hidden, Fields, Pre), 125 append(Pre, [Clause], Clauses). 126 127internal_name(Name, IName) :- atom_concat('$redcg$', Name, IName). 128 129add_state_pair(Goal, S0, S, GoalS) :- 130 Goal =.. L, 131 append(L, [S0, S], L2), 132 GoalS =.. L2. 133 134% Emit (once per file) the :- record directive, and (once per file per 135% predicate) the public EDCG-arity wrapper. 136preamble(Name, BaseArity, Hidden, Fields, Pre) :- 137 prolog_load_context(source, File), 138 ( record_emitted(File) -> RecPre = [] 139 ; assertz(record_emitted(File)), 140 record_directive(Fields, RecDir), 141 RecPre = [RecDir] ), 142 ( wrapper_done(File, Name, BaseArity) -> WPre = [] 143 ; assertz(wrapper_done(File, Name, BaseArity)), 144 wrapper_clause(Name, BaseArity, Hidden, Wrapper), 145 WPre = [Wrapper] ), 146 append(RecPre, WPre, Pre). 147 148record_directive(Fields, (:- record RecSpec)) :- 149 RecSpec =.. [redcg_state | Fields]. % fields, no type/default => unbound if unset 150 151% public wrapper: sum_e(Base..., CountIn, CountOut) :- 152% make_redcg_state([count(CountIn)], S0), '$redcg$sum_e'(Base..., S0, S), 153% redcg_state_count(S, CountOut). 154wrapper_clause(Name, BaseArity, Hidden, Wrapper) :- 155 length(BaseArgs, BaseArity), 156 hidden_public_args(Hidden, PubArgs, SeedPairs, OutGoals), 157 append(BaseArgs, PubArgs, PubAll), 158 Head =.. [Name | PubAll], 159 internal_name(Name, IName), 160 ICall0 =.. [IName | BaseArgs], 161 add_state_pair(ICall0, S0, S, ICall), 162 ( SeedPairs == [] -> MakeGoal = (S0 = _) ; MakeGoal = make_redcg_state(SeedPairs, S0) ), 163 bind_out_goals(OutGoals, S, OutConj), 164 Wrapper = (Head :- MakeGoal, ICall, OutConj). 165 166% For each hidden param: acc => [In,Out] public args, seed In, read Out from S. 167% pass => [In] public arg, seed In, no output. 168hidden_public_args([], [], [], []). 169hidden_public_args([Nm|T], Pub, Seeds, Outs) :- 170 ( is_acc(Nm) -> 171 Seed =.. [Nm, In], Pub = [In,Out|PubT], Seeds = [Seed|SeedsT], 172 Outs = [out(Nm,Out)|OutsT] 173 ; pass_info(Nm) -> 174 Seed =.. [Nm, In], Pub = [In|PubT], Seeds = [Seed|SeedsT], Outs = OutsT 175 ; throw(error(redcg(unknown_hidden(Nm)), _)) 176 ), 177 hidden_public_args(T, PubT, SeedsT, OutsT). 178 179bind_out_goals([], _, true). 180bind_out_goals([out(Nm,Var)|T], S, (Get, Rest)) :- 181 atom_concat(redcg_state_, Nm, Getter), 182 Get =.. [Getter, S, Var], 183 bind_out_goals(T, S, Rest). 184 185% ---- body expansion --------------------------------------------------------- 186% expand_body(+Body, +Sin, -Sout, +SFinal, +Fields, -Goal) 187% Sin/Sout : the record threaded through this goal. 188% SFinal : the clause-final record (constant across the clause) — the source 189% of an accumulator's "final" value for Acc/X and X/Acc/Y. 190 191expand_body((A, B), Sin, Sout, SF, F, (GA, GB)) :- !, 192 expand_body(A, Sin, Smid, SF, F, GA), 193 expand_body(B, Smid, Sout, SF, F, GB). 194% If-then-else and disjunction: each arm may advance the record differently, so 195% each threads to its OWN fresh output var and is reconciled to the shared Sout 196% by a RUNTIME `Sout = SbranchOut` goal. Sharing one Sout term across arms at 197% expansion time would wrongly cross-link their field vars — the exact hazard 198% EDCG's `_merge_acc` exists to handle. 199expand_body((C -> T ; E), Sin, Sout, SF, F, (GC -> GT2 ; GE2)) :- !, 200 expand_body(C, Sin, Sc, SF, F, GC), 201 expand_body(T, Sc, St, SF, F, GT), close_branch(St, Sout, GT, GT2), 202 expand_body(E, Sin, Se, SF, F, GE), close_branch(Se, Sout, GE, GE2). 203expand_body((C *-> T ; E), Sin, Sout, SF, F, (GC *-> GT2 ; GE2)) :- !, 204 expand_body(C, Sin, Sc, SF, F, GC), 205 expand_body(T, Sc, St, SF, F, GT), close_branch(St, Sout, GT, GT2), 206 expand_body(E, Sin, Se, SF, F, GE), close_branch(Se, Sout, GE, GE2). 207expand_body((A ; B), Sin, Sout, SF, F, (GA2 ; GB2)) :- !, 208 expand_body(A, Sin, Sa, SF, F, GA), close_branch(Sa, Sout, GA, GA2), 209 expand_body(B, Sin, Sb, SF, F, GB), close_branch(Sb, Sout, GB, GB2). 210expand_body((C -> T), Sin, Sout, SF, F, (GC -> GT)) :- !, 211 expand_body(C, Sin, Sc, SF, F, GC), 212 expand_body(T, Sc, Sout, SF, F, GT). 213expand_body((\+ A), Sin, Sout, SF, F, (\+ GA)) :- !, 214 Sout = Sin, 215 expand_body(A, Sin, _, SF, F, GA). 216expand_body(!, Sin, Sout, _SF, _F, !) :- !, Sout = Sin. % cut: preserved literally 217expand_body({G}, Sin, Sout, _SF, _F, G) :- !, Sout = Sin. % {Goal}: no threading 218expand_body([], Sin, Sout, _SF, _F, true) :- !, Sout = Sin. % empty terminal 219% bare list terminal => accumulate onto the built-in `dcg` accumulator (EDCG). 220expand_body(List, Sin, Sout, _SF, F, Goal) :- 221 is_list(List), List \== [], !, 222 accumulate_list(List, dcg, Sin, Sout, F, Goal). 223expand_body(insert(L,R):Acc, Sin, Sout, _SF, F, Goal) :- 224 atom(Acc), is_acc(Acc), !, % insert(Left,Right):Acc endpoints 225 insert_acc(Acc, L, R, Sin, Sout, F, Goal). 226expand_body(insert(L,R), Sin, Sout, _SF, F, Goal) :- !, % bare insert => dcg 227 insert_acc(dcg, L, R, Sin, Sout, F, Goal). 228expand_body(List:Acc, Sin, Sout, _SF, F, Goal) :- 229 is_list(List), !, % [Term,...]:Acc -> accumulate 230 accumulate_list(List, Acc, Sin, Sout, F, Goal). 231expand_body(X/Acc/Y, Sin, Sout, SF, F, (GC, GFin)) :- 232 atom(Acc), is_acc(Acc), !, % X/Acc/Y: read current AND final 233 Sout = Sin, 234 read_field(Acc, Sin, X, F, GC), 235 read_field(Acc, SF, Y, F, GFin). 236expand_body(V/Name, Sin, Sout, _SF, F, Goal) :- 237 atom(Name), ( is_acc(Name) ; pass_info(Name) ), !, % V/Acc or V/Pass: read current 238 Sout = Sin, 239 read_field(Name, Sin, V, F, Goal). 240expand_body(Name/V, Sin, Sout, SF, F, Goal) :- 241 atom(Name), is_acc(Name), !, % Acc/X: read FINAL value 242 Sout = Sin, 243 read_field(Name, SF, V, F, Goal). 244expand_body(G, Sin, Sout, _SF, _F, GT) :- 245 functor(G, Nm, Ar), 246 pred_info(Nm, Ar, _), !, % hidden-param predicate call 247 internal_name(Nm, INm), 248 G =.. [Nm | Args], 249 G2 =.. [INm | Args], 250 add_state_pair(G2, Sin, Sout, GT). 251expand_body(G, Sin, Sout, _SF, _F, G) :- Sout = Sin. % plain goal, no threading 252 253% close a branch: reconcile the branch's own output record Sbr to the shared 254% Sout via a runtime unification appended to the branch goal. 255close_branch(Sbr, Sout, G, (G, Sout = Sbr)). 256 257% accumulate each element of List into accumulator Acc, threading the record. 258accumulate_list(List, Acc, Sin, Sout, Fields, Goal) :- 259 ( is_acc(Acc) -> true 260 ; throw(error(redcg(unknown_accumulator(Acc)), _)) ), 261 nth1(P, Fields, Acc), !, 262 read_field_at(P, Fields, Sin, In0), % current value 263 chain_joiner(List, Acc, In0, InN, Joiners), 264 set_field_at(P, Fields, Sin, Sout, InN), % rebuild record w/ new value 265 Goal = Joiners. 266 267chain_joiner([], _, In, In, true). 268chain_joiner([E|Es], Acc, In0, InN, (J, Js)) :- 269 acc_lookup(Acc, TermT, LeftT, RightT, JoinerT), 270 copy_term(acc(TermT,LeftT,RightT,JoinerT), acc(TermC,LeftC,RightC,JoinerC)), 271 TermC = E, LeftC = In0, RightC = In1, 272 J = JoinerC, 273 chain_joiner(Es, Acc, In1, InN, Js). 274 275% insert(Left,Right):Acc — Left unifies with the accumulator's current value, 276% Right becomes the new value. Mirrors EDCG's insert/2 for endpoint control. 277insert_acc(Acc, Left, Right, Sin, Sout, Fields, (Left = In0)) :- 278 ( is_acc(Acc) -> true 279 ; throw(error(redcg(unknown_accumulator(Acc)), _)) ), 280 nth1(P, Fields, Acc), !, 281 read_field_at(P, Fields, Sin, In0), 282 set_field_at(P, Fields, Sin, Sout, Right). 283 284% read the current value of a named field (no record advance) 285read_field(Name, S, V, Fields, Goal) :- 286 nth1(P, Fields, Name), !, 287 read_field_at(P, Fields, S, V), 288 Goal = true. 289 290% read_field_at: unify V with position P of record S (S = redcg_state(...)) 291read_field_at(P, Fields, S, V) :- 292 length(Fields, N), 293 functor(S, redcg_state, N), 294 arg(P, S, V). 295 296% set_field_at: Sout is Sin with position P replaced by NewVal (rebuild compound) 297set_field_at(P, Fields, Sin, Sout, NewVal) :- 298 length(Fields, N), 299 functor(Sin, redcg_state, N), 300 functor(Sout, redcg_state, N), 301 set_args(1, N, P, Sin, Sout, NewVal). 302 303set_args(I, N, _, _, _, _) :- I > N, !. 304set_args(I, N, P, Sin, Sout, NewVal) :- 305 ( I =:= P -> arg(I, Sout, NewVal) 306 ; arg(I, Sin, A), arg(I, Sout, A) ), 307 I1 is I + 1, 308 set_args(I1, N, P, Sin, Sout, NewVal). 309 310% ---- messages --------------------------------------------------------------- 311 312:- multifile prolog:message//1. 313prolog:message(error(redcg(Detail), _)) --> redcg_detail(Detail). 314redcg_detail(no_pred_info(PI)) --> 315 ['redcg: no pred_info/3 declared for ~w'-[PI]]. 316redcg_detail(unknown_hidden(N)) --> 317 ['redcg: ~w is not a declared accumulator or passed argument'-[N]]. 318redcg_detail(unknown_accumulator(N)) --> 319 ['redcg: ~w is not a declared accumulator'-[N]]