[Backtracking works! At least when executing concat-tests. Gergö Barany **20090120231406] { hunk ./wam.fs 274 + \ ." *** pushing cp" cr hunk ./wam.fs 279 - b stack-max >= if - ." stack overflow" exception throw + new-b stack-max >= if + s" Prolog choicepoint stack overflow" exception throw hunk ./wam.fs 289 + \ ." *** popping cp" cr hunk ./wam.fs 291 - \ Trail variables! + global-state cp-b @ { prev-cp } + \ Underflow check. + prev-cp stack <= if + s" Prolog choicepoint stack underflow" exception throw + endif + \ Trail variables: Make all variables between the top-of-trail and the + \ previous top-of-trail unbound. + global-state cp-tr { trailptr } + \ ." trailptr: " trailptr @ . cr + prev-cp cp-tr @ { top-of-trail } + \ ." top-of-trail: " top-of-trail . cr + begin + trailptr @ top-of-trail > while + trailptr @ cell - trailptr ! + \ ." unbinding " trailptr @ . ." / " trailptr @ @ . cr + \ trailptr @ @ tag . cr + trailptr @ @ unbind + \ unbind leaves the pointer to the variable (now unbound) on the + \ stack, but we don't need it here anymore. + drop + repeat + \ Copy old choicepoint into current state. + prev-cp global-state choicepoint% %size move hunk ./wam.fs 317 + \ ." set-alternative " dup . cr hunk ./wam.fs 323 + \ ." trailing " dup . ." : " hunk ./wam.fs 325 + \ global-state cp-tr @ . ." -> " hunk ./wam.fs 327 + \ global-state cp-tr @ . cr hunk ./wam.fs 344 +fail global-state cp-bp ! hunk ./wam.fs 573 + global-state cp-bp @ { alternative } + alternative fail <> if + \ ." trying alternative clause " alternative . cr + \ The alternative pointer is not equal to fail. That is, there is an + \ alternative; execute it! I think this means we must pop the choice + \ point here. + pop-choice-point + alternative recurse + endif hunk ./wam.fs 588 + \ ." proceed" cr hunk ./wam.fs 597 + \ TODO: Ask whether to search for additional solutions? hunk ./wam.fs 762 + \ ." try_me_else" cr hunk ./wam.fs 766 +\ wam-instr: trust_me_else ( xt -- ) +\ ." trust_me_else" cr +\ pop-choice-point +\ \ In practice, this will always be called with the fail xt. Thus setting +\ \ the alternative is absolutely unnecessary. But let's do it anyway. +\ set-alternative +\ push-choice-point +\ ;wam-instr hunk ./wam.fs 775 - pop-choice-point - \ In practice, this will always be called with the fail xt. Thus setting - \ the alternative is absolutely unnecessary. But let's do it anyway. + \ ." trust_me_else new!" cr hunk ./wam.fs 906 + \ ." C1a" cr hunk ./wam.fs 911 + \ ." C1" cr hunk ./wam.fs 919 + \ ." C2a" cr hunk ./wam.fs 924 + \ ." C2" cr hunk ./wam.fs 1024 - ." A = " global-a-var @ unparse cr + ." A = " global-a-var @ unparse ." ," cr hunk ./wam.fs 1027 - ." B = " global-b-var @ unparse cr + ." B = " global-b-var @ unparse ." ;" cr cr hunk ./wam.fs 1043 - ." ;" cr - print-solutions + \ ." ;" cr + \ print-solutions hunk ./wam.fs 1054 + \ ." C1: " C1 @ . cr + \ ." C1a: " C1a @ . cr + \ ." C2: " C2 @ . cr + \ ." C2a: " C2a @ . cr }