; -*- Scheme -*-
;
; $Id: pathname01.scm,v 1.1 1998/03/16 07:59:04 foner Exp $
;
;------------
;
; A state machine for extracting the directory portion of a string
; that purports to represent a UNIX filename.  The extraction could be
; done using more generic string scanning functions, but a) it would
; be slower and b) it is messy (at least my first version was :-).
; IMHO a state machine is easily the clearest and also the fastest way
; of extracting the required information. 
;
; The code is derived from the following diagram :-
;
;         +--/--+
;         |    /
;         |  / 
;         v/
; START-->1 ------.-------> 2 ------.------> 6 ------/------> 8 ----%----> 1
;         | \               | \             / \
;         |  `-----+        |   \          /   \
;         $  +-+   |        /     $       $     _
;         |  |  \  |        |      \     /       \
;         v  |   \ v        v       v   v         v
;         9  +-_->11<---%---3       5   7         11
;                /  \       |
;               |    |      $
;               $    /      |
;               |    |      v
;               v    v      4
;               12   1
;
; This assumes that the state prior to START being called is that
; "/" has been found to mark the _end_ of the directory.  Yes, the
; _end_, because the above diagram shows the state as it moves
; _backwards_ over the string.
;
; A key to what the symbols mean :-
;
;   _ = anything else not dealt with on any other branch
;   $ = end
;   % = epsilon move, only to be taken if nothing else matches
;
; What the states mean :-
;
;    1 = start state
;    4 = root directory with redundant "/./" at start of pathname ignored
;    5 = relative directory
;    7 = relative up
;    8 = up
;    9 = root directory
;   12 = relative directory
;
;------------

;+doc
; procedure: substring->unix:pathname:directory
; arguments: string start end
; signature: string x int x int -> [string|symbol]
;
; Treats STRING between START (inclusive) and END (exclusive) as
; defining a UNIX directory and converts it into a
; UNIX:PATHNAME:DIRECTORY 
;-doc

(define substring->unix:pathname:directory
  (lambda (s ss se)
    (substring->unix:pathname::dir s ss se (- se 1) '())))

;------------

; procedure: substring->unix:pathname::dir
; arguments: string string-start string-end current-position directory
; signature: string x int x int x int x [string|symbol] -> [string|symbol]
; internal-pre: (char=? #\/ (string-ref string (+ current-position 1)))

(define substring->unix:pathname::dir
  (lambda (s ss se p d)
    (if (< p ss)
	(let ((d (if (= (+ p 1) se) d (cons (substring s ss se) d))))
	  (cons 'root d))
	(let ((c (string-ref s p)))
	  (cond ((char=? c #\.)
		 (substring->unix:pathname::dir:. s ss se (- p 1) d))
		((char=? c #\/)
		 (substring->unix:pathname::dir s ss p (- p 1) d))
		(else
		 (substring->unix:pathname::dir:_ s ss se (- p 1) d)))))))

;------------

; procedure: substring->unix:pathname::dir:_
; arguments: string string-start current-position directory string-end
; signature: string x int x int x [string|symbol] x int -> [string|symbol]

(define substring->unix:pathname::dir:_
  (lambda (s ss se p d)
    (if (< p ss)
	(let ((d (if (= (+ p 1) se) d (cons (substring s ss se) d))))
	  (cons 'relative d))
	(if (char=? #\/ (string-ref s p))
	    (let ((ds (substring s (+ p 1) se)))
	      (substring->unix:pathname::dir s ss p (- p 1) (cons ds d)))
	    (substring->unix:pathname::dir:_ s ss se (- p 1) d)))))

;--------------

; procedure: substring->unix:pathname::dir:.
; arguments: string string-start current-position directory string-end
; signature: string x int x int x [string|symbol] x int -> [string|symbol]
; pre:       (char=? #\. (string-ref string (+ current-position 1)))

(define substring->unix:pathname::dir:.
  (lambda (s ss se p d)
    (if (< p ss)
	(cons 'relative d)
	(let ((c (string-ref s p)))
	  (cond ((char=? c #\.)
		 (substring->unix:pathname::dir:.. s ss se (- p 1) d))
		((char=? c #\/)
		 (substring->unix:pathname::dir s ss p (- p 1) d))
		(else
		 (substring->unix:pathname::dir:_ s ss se (- p 1) d)))))))

;--------------

; procedure: substring->unix:pathname::dir:..
; arguments: string string-start current-position directory string-end
; signature: string x int x int x [string|symbol] x int -> [string|symbol]
; pre:       (char=? #\. (string-ref string (+ current-position 1)))

(define substring->unix:pathname::dir:..
  (lambda (s ss se p d)
    (if (< p ss)
	(cons 'relative (cons 'up d))
	(let ((c (string-ref s p)))
	  (if (char=? c #\/)
	      (substring->unix:pathname::dir s ss p (- p 1) (cons 'up d))
	      (substring->unix:pathname::dir:_ s ss se (- p 1) d))))))

;------------

; eof
