A program to solve the NabeAzz problem written in BibTeX

bibnabeazz.bst

ENTRY
{ start end number style }
{}
{}

INTEGERS
{ a k l x y z xx yy p q
  pa pc pp zero phase gstart gend
}
STRINGS
{ s t u v sep judge accstyle prevstyle }

FUNCTION {phase.get.range} {#1}
FUNCTION {phase.add.style} {#2}

%---------------------------------------

FUNCTION {not}
{ { #0 } { #1 } if$ }
FUNCTION {iftrue}
{ #1 swap$ 'skip$ if$ }

FUNCTION {dispatch.sub}
{ phase = swap$ 'skip$ if$ }
FUNCTION {dispatch}
{ phase.add.style dispatch.sub
  phase.get.range dispatch.sub
}

FUNCTION {digit.to.int}
{ chr.to.int$ zero -
  duplicate$ #0 < { pop$ #0 } 'skip$ if$
  duplicate$ #9 > { pop$ #0 } 'skip$ if$
}
FUNCTION {str.to.int}
{ 't :=
  t text.length$ 'l :=
  #0 'k :=
  #1
    { duplicate$ l > not }
    { duplicate$ t swap$ #1 substring$
      digit.to.int
      k k k + duplicate$ + + duplicate$ +
      + 'k :=
      #1 +
    }
  while$
  pop$ k
}

% Array is a string of form "<1>#<2>#<3>#"

% Start End Func (array.map) Array
FUNCTION {array.map}
{ swap$ 'l := swap$
  "" 't :=
    { duplicate$ l > not }
    { 'k := duplicate$ k swap$ iftrue
      t swap$ * sep * 't :=
      k #1 +
    }
  while$
  pop$ pop$ t
}

% Array Ptr1 (array.skip.next) Ptr2
FUNCTION {array.skip.next}
{ 'q := 't := 
  q t text.length$ <
    { q #1 +
        { duplicate$ t swap$ #1 substring$
          sep = not
        }
        { #1 + }
      while$
    }
    { #0 }
  if$
}
% Array Ptr1 (array.fetch.next) Ptr2 Elem
FUNCTION {array.fetch.next}
{ array.skip.next
  duplicate$ #0 =
    { "" }
    { duplicate$ q - #1 -
      t swap$ q #1 + swap$ substring$
    }
  if$
}

% Array Ptr1 Ptr2 Elem (array.replace.at) Ptr2' Array'
FUNCTION {array.replace.at}
{ 't := 'l := 'k :=
  duplicate$ duplicate$
  text.length$ l - #1 + l swap$ substring$
  t text.length$ k + #1 + 'l :=
  t swap$ * 't :=
  #1 k substring$ t *
  l swap$
}

%---------------------------------------

FUNCTION {is.multiple}
{ 'x :=
    { duplicate$ x < not }
    { x 'y :=
        { y y + 'z :=
          duplicate$ z < not
        }
        { z 'y := }
      while$
      y -
    }
  while$
  #0 =
}

FUNCTION {contains}
{ int.to.str$ 'v :=
  int.to.str$ 'u := 
  u text.length$ 'z :=
  #0 #1
    { duplicate$ z > not }
    { duplicate$ u swap$ #1 substring$
      v =
        { pop$ pop$ #1 z }
        'skip$
      if$
      #1 +
    }
  while$
  pop$
}

FUNCTION {dump.trial.div}
{ duplicate$ xx int.to.str$ "/" *
  swap$ int.to.str$ * warning$
}

FUNCTION {is.prime.a}
{ #25 'yy :=
  #1 #5
    { xx yy < not }
    { % dump.trial.div
      duplicate$ xx swap$ is.multiple
        { pop$ pop$ #0 #0
          xx 'yy :=
        }
        'skip$
      if$
      duplicate$ duplicate$ + duplicate$ + #4 +
      yy + 'yy :=
      #2 +
    }
  while$
  pop$
}

FUNCTION {is.prime}
{ 'xx :=
  xx #4 <
    { xx #1 > }
    { xx #2 is.multiple
        { #0 }
        { xx #3 is.multiple
            { #0 }
            { is.prime.a }
          if$
        }
      if$
    }
  if$
}

%---------------------------------------

FUNCTION {prologue.get.range}
{ phase.get.range 'phase :=
  "0" chr.to.int$ 'zero :=
  "#" 'sep :=
  #1 'gstart := #0 'gend :=
  "\begingroup\par" write$ newline$
  preamble$ write$ newline$
  "\newcommand*{\outnum}[1]{#1}" write$ newline$
  "\makeatletter" write$ newline$
  "\def\outbibcite#1{\if@filesw\immediate\write\@auxout"
  write$ newline$
  "{\string\bibcite{#1}{*}}\fi}" write$ newline$
  "\makeatother" write$ newline$
}

FUNCTION {resolve.range}
{ gstart gend >
    { "invalid number range specified" warning$ }
    'skip$
  if$
  gstart gend
    { pop$ "" }
  array.map
  duplicate$ 'accstyle := 'prevstyle :=
}

FUNCTION {prologue.add.style}
{ phase.add.style 'phase :=
  resolve.range
}

FUNCTION {range.get.range}
{ start str.to.int 'gstart :=
  end str.to.int 'gend :=
}

FUNCTION {dump.ptrs}
{ pc int.to.str$ "/" *
  pp int.to.str$ * "/" *
  pa int.to.str$ * warning$
}
FUNCTION {dump.arrays}
{ "judge=" judge * warning$
  "prevstyle=" prevstyle * warning$
  "accstyle=" accstyle * warning$
}

FUNCTION {update.accstyle}
{ #0 'pa := #0 'pc := #0 'pp :=
  gstart
    { duplicate$ gend > not }
    { judge pc array.fetch.next swap$ 'pc :=
      str.to.int
        { prevstyle pp array.fetch.next swap$ 'p :=
          style =
            { p 'pp :=
              accstyle pa array.skip.next 'pa :=
            }
            { prevstyle pp p style array.replace.at
              'prevstyle := 'pp :=
              accstyle pa array.fetch.next swap$ 'p :=
              style * 's :=
              accstyle pa p s array.replace.at
              'accstyle := 'pa :=
            }
          if$
        }
        { prevstyle pp array.skip.next 'pp :=
          accstyle pa array.skip.next 'pa :=
        }
      if$
      #1 +
    }
  while$
  pop$ 
% dump.arrays
}

FUNCTION {rulemultiple.add.style}
{ number str.to.int 'a :=
  gstart gend
    { a is.multiple int.to.str$ }
  array.map 'judge :=
  update.accstyle
}

FUNCTION {rulecontains.add.style}
{ number str.to.int 'a :=
  gstart gend
    { a contains int.to.str$ }
  array.map 'judge :=
  update.accstyle
}

FUNCTION {ruleprime.add.style}
{ gstart gend
    { is.prime int.to.str$ }
  array.map 'judge :=
  update.accstyle
}

FUNCTION {range}
{ 'range.get.range 'skip$ dispatch }
FUNCTION {rulemultiple}
{ 'skip$ 'rulemultiple.add.style dispatch }
FUNCTION {rulecontains}
{ 'skip$ 'rulecontains.add.style dispatch }
FUNCTION {ruleprime}
{ 'skip$ 'ruleprime.add.style dispatch }

FUNCTION {output.bibcite}
{ "\outbibcite{" cite$ * "}" *
  write$ newline$
}

FUNCTION {output.one}
{ 'a :=
  "{" swap$ * "\outnum{" *
  a int.to.str$ * "}}\space" *
  write$ newline$
}
FUNCTION {output.all}
{ #0 'pa :=
  gstart
    { duplicate$ gend > not }
    { duplicate$ 'a :=
      accstyle pa array.fetch.next swap$ 'pa :=
      a output.one
      #1 +
    }
  while$
  pop$
}

FUNCTION {epilogue}
{ output.all
  "\par" write$ newline$
  "\endgroup" write$ newline$
}

%---------------------------------------

READ

EXECUTE {prologue.get.range}

ITERATE {call.type$}

EXECUTE {prologue.add.style}

ITERATE {call.type$}

ITERATE {output.bibcite}

EXECUTE {epilogue}