/* Ensure that all choices have a default case */ -metacalls(complete, fail) /* For debug purposes: Add a call to complete:fail(id,args) in * body of each default rule that is added. */ -proc_metacalls(complete, complete:complete1) complete(cond) {|| transform(cond,complete:complete1()) } complete1(id,body,newbody) {|| complete2({id,[],"yes"},body,newbody) } /* Flag=yes means we are not in a choice block */ complete2(arg,body,newbody) {? arg ?= {id,as,flag} -> { ? body ?= program(args,muts,body1) -> {|| complete2({id,args,"yes"},body1,newbody1), newbody=program(args,muts,newbody1) }, body ?= block(op,bs), op != "?" -> {|| ptn_co:map_list(complete:complete2({id,as,"yes"}),bs,newbs), newbody=block(op,newbs) }, body ?= block("?",bs) -> {|| ptn_co:map_list(complete:complete2({id,as,"no"}),bs,newbs), look_default(bs,r), { ? r == "true" -> {|| newbody=block("?",newbs) }, r != "true" -> {|| dblock = {"->","default", call({":","complete","fail"},[id,as],[])}, app(newbs,[dblock],blocks), newbody=block("?",blocks) } } }, body ?= {"->",guard,body1}, flag == "yes" -> {|| complete2(arg,body1,newbody1), newbody=block("?",[{"->",guard,newbody1}, {"->","default", call({":","complete","fail"},[id,as],[])}]) }, default -> /* Primitive, call, or directive */ {|| newbody=body } } } look_default(blocks,r) { ? blocks ?= [{"->","default",_}|_] -> {|| r="true" }, blocks ?= [{"->",c,_}|bs], c != "default" -> {|| look_default(bs,r) }, blocks ?= [] -> {||r="false" } } app(x,y,z) { ? x ?= [e|x1] -> {|| z=[e|z1], app(x1,y,z1)}, x ?= [] -> {|| z=y } } /* Debugging support for APS */ fail(id,as) { ? id ?= {":",mod,name} -> {|| stdio:printf("Failed - %s:%s(",{mod,name},d), {? data(d) -> fail_args(as) } }, default -> print(fail_error(id,as)) } fail_args(as) { ? as ?= [a|as1], as1 != [] -> {|| print(a), print(","), fail_args(as1)}, as ?= [a] -> {|| print(a), print(")\n")}, as ?= [] -> print(")\n") }