#!/usr/bin/awk -f
#	expand logic puzzle into prolog program
#	puzzle2pl problem.puzzle > problem.pl 

BEGIN {	Id = "[a-z][A-Za-z0-9_]*"		## identifier
	IdP = "^"Id"$"				## id pattern
	ValueP = "^("Id"|[0-9]+(\\.[0-9]+)?)$" 	## value pattern
	PnP = "^"Id"(,"Id")*$"			## property ,.. pattern

	nProperty = 0			## properties
	nValue = 0			## values for first property
	Part = 1			## property/values section
	Solve = ""			## before constraint checks
	nConstraint = 0			## constraint checks
	exitCode = 0			## != 0 to abort

  print "/* properties and values */\n"
}

/\\$/ {				## \eol conceals
  do {
    if ((getline line) <= 0) fatal("unexpected end of file")
    sub(/[ 	]*\\$/, ""); sub(/^[ 	]*/, "", line)
    $0 = $0" "line
  } while ($0 ~ /\\$/)
}

{ sub(/#.*/, "")		## #..eol is a comment
}

/^[ 	]*$/ { next		## blank lines are ignored
}

/^[ 	]*%%[ 	]*$/ {		## %% separates properties and constraints
  Part = 2
  print "/* constraints */\n"
  next
}

/^[ 	]*%/ {			## % passes rest of line through...
  sub(/^[ 	]*%[ 	]*/, ""); sub(/[ 	]*$/, "")
  if (Part == 1)		## ...in part 1 directly...
    print
  else				## ...in part 2 into solve...
    Solve = Solve"\n  "$0
  next
}

Part == 1 {			## property value ...
  if (NF <= 3) fatal("too few values")

  if ($1 !~ IdP) fatal($1": bad property name")
  if ($1 in Properties) fatal($1": duplicate")

  Property[++nProperty] = $1	## list of property names
  Properties[$1] = nProperty	## set of property names

  if (nValue == 0) {		## first property: rules not needed...
    nValue = NF - 1
    for (n = 2; n <= NF; ++ n)
      Value1[n-1] = $n		## ...values will be set in solve

  } else if (NF-1 < nValue) fatal($1": not enough values")

  else {			## further properties become rules
    for (n = 2; n <= NF; ++ n) {
      if ($n !~ ValueP) fatal($1": bad value name")
      printf "  %s(%s).\n", Property[nProperty], $n
    }
    print ""
  }
  next
}

Part == 2 && $1 ~ /\^/ { 	## property,..^.. constraint
  if ($2 !~ /.\(/) fatal("no constraint found")

  c = $2; sub(/\(.*/, "", c)	## constraint name, global in forL
  if (c !~ IdP) fatal(c": bad constraint name")
  if (c in Constraints) fatal(c": duplicate")
  Constraints[c] = 1		## set of constraint names

  nV = split($1, g, "^")	## number of lists, [1..nV, ..]
  for (f = 1; f <= nV; ++ f)
    if (g[f] ~ PnP) {		## property,..
      vPn[f, 0] = split(g[f], pn, ",")	## list of lists, [,0] is length
      for (i = 1; i <= vPn[f, 0]; ++ i) {
        if (!(pn[i] in Properties)) fatal(pn[i]": no property")
        vPn[f, i] = pn[i]		## [,1..[,0]] are property names
      }
    } else {			## direct argument
      vPn[f, 0] = 0
      vPn[f, 1] = g[f]
    }
  $1 = ""
  				## list of constraint checks
  d2 = ""; xOr = 1		## global in forL
  Constraint[++nConstraint] = "  ( " forL(1, "") " )"

  sub(/^[ 	]*/, ""); sub(/[ 	]*$/, "")
  printf "  %s\n", $0
  next
}

Part == 2 { 			## property,.. constraint
  for (f = 2; f <= NF; ++ f)	## locate constraint
    if ($f ~ /.\(/) break;
  if (f > NF) fatal("no constraint found")

  c = $f; sub(/\(.*/, "", c)	## constraint name, global in forL
  if (c !~ IdP) fatal(c": bad constraint name")
  if (c in Constraints) fatal(c": duplicate")
  Constraints[c] = 1		## set of constraint names

  for (f = 1; $f !~ /.\(/; ++ f) {
    if ($f ~ PnP) {		## property,..
      vPn[f, 0] = split($f, pn, ",")	## list of lists, [,0] is length
      for (i = 1; i <= vPn[f, 0]; ++ i) {
        if (!(pn[i] in Properties)) fatal(pn[i]": no property")
        vPn[f, i] = pn[i]		## [,1..[,0]] are property names
      }
    } else {			## direct argument
      vPn[f, 0] = 0
      vPn[f, 1] = $f
    }
    $f = ""
  }
  nV = f-1				## number of lists, [1..nV, ..]

  				## list of constraint checks
  d2 = ""; xOr = 0		## global in forL
  Constraint[++nConstraint] = "  ( " forL(1, "") " )"

  sub(/^[ 	]*/, ""); sub(/[ 	]*$/, "")
  printf "  %s\n", $0
  next
}

{ fatal("syntax error in part " Part) }

END {				## create solve
  if (exitCode) exit(exitCode)

  print "\n/* solve predicate */\n"
  print solve()" :-" 

  print "\n  /* freeze first property */\n"
  for (v = 1; v <= nValue; ++ v)
    printf "  %s%d = %s,\n", cap(Property[1]), v, Value1[v]

  print "\n  /* make values of other properties distinct */\n"
  for (p = 2; p <= nProperty; ++ p) {
    for (v = 1; v <= nValue; ++ v)
      printf "  %s(%s%d),\n", Property[p], cap(Property[p]), v

    for (v1 = 1; v1 < nValue; ++ v1) {
      printf "\n "
      for (v2 = v1+1; v2 <= nValue; ++ v2)
        printf " %s%d \\= %s%d,", cap(Property[p]), v1, cap(Property[p]), v2
    }
    print "\n"
  }

  if (Solve != "")
    print "  /* direct code */\n"Solve"\n"

  print "  /* assert constraints */\n"
  d1 = ""
  for (c = 1; c <= nConstraint; ++ c) {
    printf "%s%s", d1, Constraint[c]
    d1 = ",\n\n"
  }
  print "."

  print "\n/* main/0 predicate, prints all solutions */\n"
  print "main :-"
  print "  "solve()","

  print "\n  /* print a solution */"
  d1 = ""
  for (v = 1; v <= nValue; ++ v) {
    print d1; d2 = ""
    for (p = 1; p <= nProperty; ++p) {
      printf "%s  write(%s%d)", d2, cap(Property[p]), v
      d2 = ", write('\\t'),\n"
    }
    printf ", write('\\n')"; d1 = ",\n"
  }
  print ",\n\n  /* backtrack for all solutions */\n"
  print "  write('\\n'), fail."
}

function fatal (s) {
  printf "%s(%d) %s\n", FILENAME, NR, s > "/dev/stderr"
  exit(exitCode=1)
}

function cap (s) { # returns s with first letter capitalized
  return toupper(substr(s,1,1)) substr(s,2)
}

# level l of 1..nV nested loops where V[l] ranges over 1..nValue
# global: V[], nValue, xOr, d2, c, nV, vPn[]
function forL (l, s,		lim, d1, v, p) {
  lim = vPn[l, 0] > 0 ? nValue : 1;
  for (V[l] = 1; V[l] <= lim; ++ V[l])
    if (l < nV)
      s = forL(l+1, s)
    else if (!xOr || isPermutation()) {		## body of the nested loops
      s = s sprintf("%s%s(", d2, c)		## constraint(
      d1 = ""; d2 = ";\n    "
      for (v = 1; v <= nV; ++ v)		## for each property group
        if (vPn[v, 0] > 0)
	  for (p = 1; p <= vPn[v, 0]; ++p) {	## for each property
	    s = s sprintf("%s%s%d", d1, cap(vPn[v, p]), V[v])
	    d1 = ", "
	  }
        else {
          s = s sprintf("%s%s", d1, vPn[v, 1])
          d1 = ", "
        }
      s = s")"
    }
  return s
}

# generate permutations by checking if V[1..nV] differ
# this is not a kludge because nV may not be the number of properties
function isPermutation (	i, j) {
  for (i = 1; i < nV; ++ i)
    for (j = i+1; j <= nV; ++ j)
      if (V[i] == V[j]) return 0;
  return 1;
}

function solve (	s, d1, v, d2, p) { # returns solve() header
  s = "solve("; d1 = ""
  for (v = 1; v <= nValue; ++ v) {
    s = s d1; d1 = ", "; d2 = ""
    for (p = 1; p <= nProperty; ++p) {
      s = s sprintf("%s%s%d", d2, cap(Property[p]), v); d2 = ","
    }
  }
  return s")"
}