20-CS-4003-001 Organization of Programming Languages Fall 2017
Topological Sort

Lambda calculus, Type theory, Formal semantics, Program analysis

    All lectures           Code

Topological Sort - State Based

(define take-helper
  (lambda (i lst acc)
    (if (<= i 0)
          (- i 1) 
          (cdr lst) 
          (append acc (list (car lst)))))))

;; Returns a list of the first i members of the list lst
(define take
  (lambda (i lst)
    (take-helper i lst '())))

;; Returns a list of the last length(lst) - i members of lst
(define drop
  (lambda (i lst)
    (if (<= i 0)
        (drop (- i 1) (cdr lst)))))

;; Returns '() if lst is '() or '(A), otherwise
;; returns a list containing the last member of lst
(define tail
  (lambda (lst)
    (if (null? lst)
        (if (null? (cdr lst))
            (if (null? (cddr lst))
		(cdr lst)
		(tail (cdr lst)))))))

;; Returns the last member of lst
(define last
  (lambda (lst)
    (if (null? lst)
	(car (tail lst)))))

;; Define state:
;;   A list of m+2 lists 
;;   list 0: a vertex stack for DFS
;;   lists 1-m: dependency lists for each vertex
;;      last element of a dependency list is the
;;      vertex itself
;;   list m+1: solution list, in order from right
;;      to left

;; Returns a new state from a current state according
;; to the following;
;;  1. if the vertex stack is empty -
;;     return null
;;  2. if the dependency list of the top vertex in
;;     the stack is null -
;;     return same state except pop the stack
;;  3. if the dependency list of the top vertex in
;;     the stack has one member (the vertex v) -
;;     return a new state where the stack is popped,
;;     vertex v is added to the solution list,
;;     and vertex v is removed from its dep list
;;  4. otherwise
;;     let w be the first member of the dependency 
;;     list of the vertex v at the top of the stack.
;;     return the same state except that w is
;;     removed from v's dependency list and w is
;;     placed at the top of the stack.
(define f
  (lambda (state)
    (if (null? (car state))
        (let* ((v (caar state))
               (lv (car (drop (+ v 1) state))))
          (if (null? lv)
              (append (list (drop 1 (car state))) (drop 1 state))
	      (let* ((r (drop 1 lv))
		     (z (append (take (+ v 1) state) 
				(list r)
				(drop (+ v 2) state))))
		(if (null? (cdr lv))
		    (append (list (drop 1 (car state)))
			    (drop 1 (take (- (length z) 1) z))
			    (list (cons v (last state))))
		    (append (list 
			     (append (take 1 (car (drop (+ v 1) state)))
				     (car state)))
			    (drop 1 z)))))))))

;; Given a state, with an assumed initial stack
;; containing just one member, apply f repeatedly
;; until the stack is empty
(define h 
  (lambda (state)
    (if (null? (car state))
        (h (f state)))))

;; Given a state and vertex v, change the stack so v 
;; is the only member and return the modified state
(define setInit
  (lambda (state v)
    (cons (list v) (cdr state))))

(define topo-helper
  (lambda (state i)
    (if (<= i 0)
	(h (setInit state 0))
	(h (setInit (topo-helper state (- i 1)) i)))))

;; Find a topological sort for a given partial order
(define topo
  (lambda (deps)
    (last (topo-helper (append '(()) deps '(())) (- (length deps) 1)))))
;; An example partial order
(define ex '((2 3 4 0) (1) (1 2) (1 5 3) (3 5 4) (2 5) (1 7 6) (0 2 7)))
 -  Comments to be added