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
  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 not ="(" then
  64     return &null
  65   else {
  66     left := scan_tree()
  67     data := move(1) | bail("no data")
  68     right := scan_tree()
  69     =")" | bail("missing )")
  70     return node(left, data, right)
  71   }
  72 end
  73
  74 procedure parse_tree(string)
  75   ## Parse a tree from STRING and return its root.
  76   ##
  77   ## The syntax is as follows.
  78   ##
  79   ##    tree ::= empty | `(' tree char tree `)'
  80   ##
  81   ## Ambiguity is resolved by treating a `(' as starting a tree when a tree
  82   ## is expected.
  83
  84   local t
  85
  86   return string ? {
  87     t := scan_tree()
  88     if not pos(0) then bail("trailing junk")
  89     t
  90   }
  91 end
  92
  93 ###--------------------------------------------------------------------------
  94 ### Main program.
  95
  96 procedure main(argv)
  97   local trees
  98
  99   if *argv = 1 then
 100     print_sequence(create fringe(parse_tree(argv[1])))
 101   else if *argv = 2 then
 102     if same_sequence_p(string_equal_p,
 103                        create fringe(parse_tree(argv[1])),
 104                        create fringe(parse_tree(argv[2]))) then
 105       write("match")
 106     else
 107       write("no match")
 108   else
 109     bail("bad args")
 110 end
 111
 112 ###----- That's all, folks --------------------------------------------------