#!/usr/bin/awk -f
# NAME
#
# m1
#
# USAGE
#
# awk -f m1.awk [file...]
#
# DESCRIPTION
#
# M1 copies its input file(s) to its output unchanged except as modified by
# certain "macro expressions."  The following lines define macros for
# subsequent processing:
#
#     @comment Any text
#     @@                     same as @comment
#     @define name value
#     @default name value    set if name undefined
#     @include filename
#     @if varname            include subsequent text if varname != 0
#     @unless varname        include subsequent text if varname == 0
#     @fi                    terminate @if or @unless
#     @ignore DELIM          ignore input until line that begins with DELIM
#     @stderr stuff          send diagnostics to standard error
#     @shell name command    execute shell command and define as name
#     @undefine name         remove name from symbol table
#
# A definition may extend across many lines by ending each line with
# a backslash, thus quoting the following newline.
#
# Any occurrence of @name@ in the input is replaced in the output by
# the corresponding value.
#
# @name at beginning of line is treated the same as @name@.
#
# BUGS
#
# M1 is three steps lower than m4.  You'll probably miss something
# you have learned to expect.
#
# AUTHOR
#
# Jon L. Bentley, jlb@research.bell-labs.com

function error(s) {
  print "m1 error: " s > "/dev/stderr"; exit 1
}

function dofile(fname, savefile, savebuffer, newstring) {
  if (fname in activefiles)
    error("recursively reading file: " fname)
  activefiles[fname] = 1
  savefile = file; file = fname
  savebuffer = buffer; buffer = ""
  while (readline() != EOF) {
    if (index($0, "@") == 0) {
      print $0
    } else if (/^@define[ \t]/) {
      dodef()
    } else if (/^@undefine[ \t]/) {
      delete symtab[$2]
    } else if (/^@default[ \t]/) {
      if (!($2 in symtab))
        dodef()
    } else if (/^@include[ \t]/) {
      if (NF != 2) error("bad include file")
      dofile(dosubs($2))
    } else if (/^@if[ \t]/) {
      if (NF != 2) error("bad if line")
      if (!($2 in symtab) || symtab[$2] == 0) {
        gobble()
      }
    } else if (/^@unless[ \t]/) {
      if (NF != 2) error("bad unless line")
      if (($2 in symtab) && symtab[$2] != 0)
        gobble()
    } else if (/^@fi[ \t]?/) {
    } else if (/^@comment[ \t]?/) {
    } else if (/^@@/) {
    } else if (/^@longdefine[ \t]/) {
      sym = $2
      val = ""
      while (readline() != EOF) {
        if ($0 ~ /^@longend/) break
        val = val $0 "\n"
      }
      sub(/\n+$/,"",val)
      symtab[sym] = val
    } else if (/^@stderr[ \t]?/) { 
      print substr($0, 9) | "cat 1>&2"
    } else if (/^@ignore[ \t]/) {
      # Dump input until $2
      delim = $2
      l = length(delim)
      while (readline() != EOF)
        if (substr($0, 1, l) == delim) break
    } else if (/^@shell[ \t]/) {
      sym = $2
      val = ""
      sub(/^[ \t]*[^ \t]+[ \t]+[^ \t]+[ \t]*/, "") # OLD BUG: last * was +
      cmd = dosubs($0)
      while ((cmd | getline) > 0) {
        if ($0 !~ /^[ \t]*$/) 
          val = val $0 "\n"
      }
      sub(/\n+$/,"",val)
      symtab[sym] = val
    } else if (/^@calc[ \t]/) {
      sym = $2
      sub(/^[ \t]*[^ \t]+[ \t]+[^ \t]+[ \t]*/, "") # OLD BUG: last * was +
      val = docalc(dosubs($0))
      sub(/\n+$/,"",val)
      symtab[sym] = val
    } else {
      newstring = dosubs($0)
      if ($0 == newstring || index(newstring, "@") == 0) {
        print newstring
      } else
        buffer = newstring "\n" buffer
    }
  }
  close(fname)
  delete activefiles[fname]
  file = savefile
  buffer = savebuffer
}

function push(var) {
  stack[length(stack)+1] = var;
}
function pop(len, var) {
  len = length(stack);
  if (len) {
    var = stack[len];
    delete stack[len];
  } else {
    var = 0;
    print "awkdc: Stack underflow" > "/dev/stderr";
  }
  return var;
}

function o_class(obj,   q, x, z) {
  q = CONVFMT
  CONVFMT = "% g"
  split(" " obj "\1" obj, x, "\1")
  x[1] = obj == x[1]
  x[2] = obj == x[2]
  x[3] = obj == 0
  x[4] = obj "" == +obj
  CONVFMT = q
  z["0001"] = z["1101"] = z["1111"] = "number"
  z["0100"] = z["0101"] = z["0111"] = "string"
  z["1100"] = z["1110"] = "strnum"
  z["0110"] = "undefined"
  return z[x[1] x[2] x[3] x[4]]
}

function docalc(str ,elements,key,fld,idx) {
  fmt = "%.0f\n";
  split(str,elements," ")
  split("",stack)
  processing = 1
  for (idx=1;elements[idx] != "";idx++) {
    fld = elements[idx]
    if (processing) {
      if (fld ~ /[0-9]+,/) {
        gsub(",","",fld)
        fld = fld + 0
      }
      if (o_class(fld) == "strnum" || o_class(fld) == "number") {
        push(fld);
      }
      # math operations
      if (fld == "+") {
        a = pop();
        b = pop();
        push(b+a);
      }
      if (fld == "-") {
        a = pop();
        b = pop();
        push(b-a);
      }
      if (fld == "/") {
        a = pop();
        b = pop();
        push(b/a);
      }
      if (fld == "*") {
        a = pop();
        b = pop();
        push(b*a);
      }
      # comparison operators
      if (fld == ">") {
        a = pop();
        b = pop();
        push(a > b);
      }
      if (fld == "<") {
        a = pop();
        b = pop();
        push(a < b);
      }
      if (fld == "=") {
        a = pop();
        b = pop();
        push(a == b);
      }
      if (fld == ">=") {
        a = pop();
        b = pop();
        push(a >= b);
      }
      if (fld == "<=") {
        a = pop();
        b = pop();
        push(a <= b);
      }
      if (fld == "<>") {
        a = pop();
        b = pop();
        push(a != b);
      }
      if (fld == "0=") {
        a = pop();
        push(a == 0);
      }
      if (fld == "0<>") {
        a = pop();
        push(a != 0);
      }
      # print
      if (fld == "p") {
        printf fmt, stack[length(stack)];
      }
      # set precision
      if (fld == "k") {
        p = pop();
        fmt = "%." p "f\n";
      }
      if (fld == ",") {
        if (index(fmt, "\47")) {
          sub("\47","",fmt)
        } else {
          sub("%","%\47",fmt)
        }
      }
      # swap
      if (fld == "r") {
        a = pop();
        b = pop();
        push(a);
        push(b);
      }
      # dup
      if (fld == "d") {
        a = pop();
        push(a);
        push(a);
      }
      # clear
      if (fld == "c") {
        split("",stack);
      }
    }
    # conditionals
    if (fld == "if") {
      processing = (pop() != 0)
    }
    if (fld == "else") {
      # invert processing flag
      processing = (processing == 0)
    }
    if (fld == "then") {
      # turn processing on
      processing = 1
    }
  }
  return sprintf(fmt,stack[length(stack)])
}

function readline(i, status, str) {
  status = ""
  str = ""
  if (buffer != "") {
    i = index(buffer, "\n")
    $0 = substr(buffer,1,i-1)
    buffer = substr(buffer, i+1)
  } else {
      if (getline <file <= 0) status = EOF
  }
  return status
}

function gobble (ifdepth) {
  ifdepth = 1
  while (readline() != EOF) {
    if (/^@(if|unless)[ \t]/)
      ifdepth++
    if (/^@fi[ \t]?/ && --ifdepth <= 0)
      break
  }
}

function dosubs(s, l, r, i, m) {
  if (index(s, "@") == 0)
    return s
  l = "" # Left of surrent pos; ready for output
  r = s  # Right of current pos; unexamined at this time
  while ((i = index(r, "@")) != 0) {
    l = l substr(r,1,i-1)
    r = substr(r, i+1) # Currently scanning @
    i = index(r,"@")
    if (i == 0) {
      l = l "@"
      break
    }
    m = substr(r,1,i-1)
    r = substr(r,i+1)
    if (m in symtab) {
      r = symtab[m] r
    } else {
      l = l "@" m
      r = "@" r
    }
  }
  return l r
}

function dodef(fname, str, x) {
  name = $2 
  sub(/^[ \t]*[^ \t]+[ \t]+[^ \t]+[ \t]*/, "") # OLD BUG: last * was +
  str = $0
  while (str ~ /\\$/) {
    if (readline() == EOF) error("EOF inside definition")
    x = $0
    sub(/^[ \t]+/, "", x)
    str = substr(str, 1, length(str)-1) "\n" x
  }
  symtab[name] = str
}

BEGIN {
  EOF = "EOF"
  if (ARGC == 1) dofile("/dev/stdin")
  else if (ARGC > 1) {
    for (arg=2;arg<=ARGC;arg++)
      dofile(ARGV[arg-1])
  } else error("usage: m1 fname")
}