Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #45668

Rosettacode topological sort (was: Topological sort)

Show all headers | View raw

I found that Rosettacode also has a "topological" sort task
<https://rosettacode.org/wiki/Topological_sort>, which is a bit
different from the task I solved earlier.  I also came up with an idea
of how to get rid of the flag field and the IF in NODE.

The task description is about the compiling order of libraries and contains the following additional requirements:

* Assume library names are single words.
* Items mentioned as only dependants, (sic), have no dependants of
  their own, but their order of compiling must be given.
* Any self dependencies should be ignored.
* Any un-orderable dependencies should be flagged.

So I decided to do some syntactic sugar that accepts input similar
to the example given (line-oriented input with the dependent
(after-node) at the start followed by dependencies (before-nodes)).

Implementation: Each node (with dependencies) goes through three
states: At the start, it contains an xt that calls all before-nodes.
At the start of that, the xt called by the node changes to
PROCESSING; if that is ever called, there is a cycle (or
self-reference), and if it is not a self-reference, the cycle is
printed.  When the processing of the before-nodes is complete, the
present node is printed, and the xt changes to DROP, so any further
processing of the node does nothing.

This implements depth-first search
<https://en.wikipedia.org/wiki/Topological_sorting#Depth-first_search>,
with PROCESSING being the temporary mark, and DROP being the permanent
mark.

The cool thing about this implementation is that we don't need a
single conditional branch for topologically sorting the dependencies
of a single node; there are a few for deciding what to output on a
cycle, but if we are happy with more primitive output, we can get rid
of that; we do have EXECUTE instead, so we don't get rid of branch
mispredictions, but given our representation of the dependencies, we
need the indirect branch anyway.

A special feature is that we can recognize self-references and print
cycles without building an extra data structure, because the chain
of nodes we are looking at is on the data stack (this is not very
idiomatic in Forth).

Another Forth feature is that we use the dictionary as symbol table
for input processing: Each node is turned into a Forth word.  Also,
the list of dependencies is turned into an anonymous colon
definition rather than some list or array.

This code uses a number of Gforth extensions, some just as minor
conveniences, some more substantial (although nothing that could not
be replaced with a few lines of standard code; still, if you replace
all of them, the code becomes considerably bigger.  If you think
that these conveniences are unnecessary, do the conversion as an
exercise.  I am happy to assist in explaining the meaning of the
extensions.

An additional feature that Gforth does not have yet and that would be
beneficial here would be to have several dictionary section to which
code and words can be added alternatingly or at least in a nested way.
If Gforth had that, I would have replaced the linked list of nodes and
ALL-NODES with a colon definition calling all the nodes.

- anton
------------------------------------------------
variable nodes 0 nodes ! \ linked list of nodes

: node. ( body -- )
    body> >name name>string type ;

: nodeps ( body -- )
    \ the word referenced by body has no (more) dependencies to resolve
    ['] drop over ! node. space ;

: processing ( body1 ... bodyn body -- body1 ... bodyn )
    \ the word referenced by body is in the middle of resolving dependencies
    2dup <> if \ unless it is a self-reference (see task description)
	['] drop over !
	." (cycle: " dup node. >r 1 begin \ print the cycle
	    dup pick dup r@ <> while
		space node. 1+ repeat
	." ) " 2drop r>
	then drop ;

: >processing ( body -- body )
    ['] processing over ! ;

: node ( "name" -- )
    \ define node "name" and initialize it to having no dependences
    create
    ['] nodeps , \ on definition, a node has no dependencies
    nodes @ , lastxt nodes ! \ linked list of nodes
  does> ( -- )
    dup @ execute ; \ perform xt associated with node

: define-nodes ( "names" <newline> -- )
    \ define all the names that don't exist yet as nodes
    begin
	parse-name dup while
	    2dup find-name 0= if
		2dup nextname node then
	    2drop repeat
    2drop ;

: deps ( "name" "deps" <newline> -- )
    \ name is after deps.  Implementation: Define missing nodes, then
    \ define a colon definition for 
    >in @ define-nodes >in !
    ' :noname ]] >processing [[ source >in @ /string evaluate ]] nodeps ; [[
    swap >body ! 0 parse 2drop ;

: all-nodes ( -- )
    \ call all nodes, and they then print their dependences and themselves
    nodes begin
	@ dup while
	    dup execute
	    >body cell+ repeat
    drop ;

deps des_system_lib std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
deps dw01           ieee dw01 dware gtech
deps dw02           ieee dw02 dware
deps dw03           std synopsys dware dw03 dw02 dw01 ieee gtech
deps dw04           dw04 ieee dw01 dware gtech
deps dw05           dw05 ieee dware
deps dw06           dw06 ieee dware
deps dw07           ieee dware
deps dware          ieee dware
deps gtech          ieee gtech
deps ramlib         std ieee
deps std_cell_lib   ieee std_cell_lib
deps synopsys
\ to test the cycle recognition (overwrites dependences for dw1 above)
deps dw01           ieee dw01 dware gtech dw04

all-nodes cr

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Topological sort "WJ" <w_a_x_man@yahoo.com> - 2016-02-19 21:11 +0000
  Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-19 23:41 -0800
    Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-20 01:00 -0800
    Re: Topological sort anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-20 11:13 +0000
      Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-20 10:39 -0800
      Rosettacode topological sort (was: Topological sort) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-22 07:54 +0000
        Re: Rosettacode topological sort (was: Topological sort) Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-22 10:04 +0000
          Re: Rosettacode topological sort (was: Topological sort) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-22 12:26 +0000
            Re: Rosettacode topological sort (was: Topological sort) Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-22 13:28 +0000
    Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-23 01:12 -0800
    Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-23 10:56 -0800

csiph-web