chiark - git - mdw - fringe/blob - icon-fringe.icn

   1 ### -*-icon-*-
   2 ###
   3 ### An Icon implementation of a `same-fringe' solver.
   4
   5 ###--------------------------------------------------------------------------
   6 ### Utilities.
   7
   8 procedure bail(msg)
   9   ## Report MSG as an error, and quit.
  10
  11   write(&errout, &progname, ": ", msg)
  12   flush(&errout)
  13   exit(1)
  14 end
  15
  16 procedure same_sequence_p(test, aseq, bseq)
  17   ## Succeed if the sequences generated by coexpressions ASEQ and BSEQ equal,
  18   ## in the sense that TEST succeeds when applied to corresponding elements,
  19   ## and the sequences have the same length.
  20
  21   local a, b
  22
  23   while a := @aseq do
  24     if not (b := @bseq) | not test(a, b) then fail
  25   if @bseq then fail
  26   return
  27 end
  28
  29 procedure print_sequence(aseq)
  30   ## Write the elements of the sequence generated by coexpression ASEQ
  31   ## followed by a newline.
  32
  33   every writes(|@aseq)
  34   write()
  35 end
  36
  37 procedure string_equal_p(a, b)
  38   ## Succeed if strings A and B are equal.  Useful as a TEST for
  39   ## `print_sequence'.
  40
  41   return a == b
  42 end
  43
  44 ###--------------------------------------------------------------------------
  45 ### Node structure.
  46
  47 record node(left, data, right)
  48 ## A simple binary tree structure.
  49
  50 procedure fringe(node)
  51   ## Generate the elements of the tree headed by NODE inorder.
  52
  53   if /node then fail
  54   suspend fringe(node.left) | node.data | fringe(node.right)
  55 end
  56
  57 procedure scan_tree()
  58   ## Scan a tree from the current subject, advancing the position over it.
  59   ## See `parse_tree' for the syntax.
  60
  61   local data, left, right
  62
  63   if ="(" then {
  64     left := scan_tree()
  65     data := move(1) | bail("no data")
  66     right := scan_tree()
  67     =")" | bail("missing )")
  68     return node(left, data, right)
  69   } else
  70     return &null
  71 end
  72
  73 procedure parse_tree(string)
  74   ## Parse a tree from STRING and return its root.
  75   ##
  76   ## The syntax is as follows.
  77   ##
  78   ##    tree ::= empty | `(' tree char tree `)'
  79   ##
  80   ## Ambiguity is resolved by treating a `(' as starting a tree when a tree
  81   ## is expected.
  82
  83   local t
  84
  85   return string ? {
  86     t := scan_tree()
  87     if not pos(0) then bail("trailing junk")
  88     t
  89   }
  90 end
  91
  92 ###--------------------------------------------------------------------------
  93 ### Main program.
  94
  95 procedure main(argv)
  96   local trees
  97
  98   if *argv = 1 then
  99     print_sequence(create fringe(parse_tree(argv[1])))
 100   else if *argv = 2 then
 101     if same_sequence_p(string_equal_p,
 102                        create fringe(parse_tree(argv[1])),
 103                        create fringe(parse_tree(argv[2]))) then
 104       write("match")
 105     else
 106       write("no match")
 107   else
 108     bail("bad args")
 109 end
 110
 111 ###----- That's all, folks --------------------------------------------------