;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Touched: Tue Oct 04 20:51:59 2005 +0530 <enometh@meer.net>
;;;   Time-stamp: <05/11/14 07:06:16 madhu>
;;;
;;;	$Id: ibm.lisp,v 1.3 2005/11/13 11:31:29 madhu Exp madhu $	

(defpackage "IBM" (:use "CL") (:export))
(in-package "IBM")

(defvar *ibm-directory* #p"/home/madhu/tex/work/ibm/")

(setq $files
      (directory (make-pathname :name :wild :type "txt" :version :wild
				:defaults  *ibm-directory*)
		 :truenamep nil))

(list
 #P"/home/madhu/tex/work/ibm/Transliterator_Devanagari_InterIndic.utf8.txt"
 #P"/home/madhu/tex/work/ibm/Transliterator_InterIndic_Devanagari.utf8.txt"
 #P"/home/madhu/tex/work/ibm/Transliterator_Latin_Devanagari.utf8.txt")

(setq $t1
      (truename
       (make-pathname
	:name (concatenate 'string "Transliterator" "_" "Latin" "_" "Devanagari"
			   "." "utf8")
	:type "txt"
	:defaults *ibm-directory*)))

#+nil
(mapcar (lambda (x) (unintern (find-symbol x :trie)))
	'("GETTRIE" "REMTRIE" "WITH-TRIE-ITERATOR"))

(import (mapcar (lambda (x) (find-symbol x :trie))
		'("GETTRIE" "REMTRIE" "WITH-TRIE-ITERATOR" "PARSE-IDENTIFIER")))

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

(defvar $ident (cons nil nil)
  "Variable Identifiers in the source. Trie")

(defun assign-ident (string &optional (pos (position #\= string))
		     (eol (position #\; string :start pos)))
  "assign identifier to string of the form lhs=rhs;
pos is the position of #\="
  (assert (char= (char string pos) #\=))
  (assert (char= (char string 0) #\$))
  (assert (char= (char string (1+ pos)) #\[))
  (assert eol)
  (assert (char= (char string (1- eol)) #\]))
  (setf (gettrie (subseq string 1 pos) $ident)
	(subseq string (+ 2 pos) (- eol 2)))
  (warn "ASSIGNED ~A = ~A" 
	(subseq string 0 pos)
	(subseq string (+ 2 pos) (- eol 2))))

(defvar $forward (cons nil nil))
(defvar $reverse (cons nil nil))

(defun expand (string &key (start 0) end)
  (let ((pos (position #\$ string :start start :end end)))
    (when pos
      (multiple-value-bind (key subst endpos)
	  (parse-identifier string $ident :start (1+ pos) :end end)
	(assert endpos)
	(assert (every #'char= (subseq string (1+ pos) endpos) key))
	(assert subst)
	(concatenate 'string
		     (subseq string start pos)
		     subst
		     (when (< endpos (or end (length string)))
		       (or (expand string :start endpos :end end)
			   (subseq string endpos end))))))))

#||
(expand "01234foo$endThing{" :start 4 :end nil)
(expand "foo$endThing{anc" :start 0)
||#

(defun parse-op (sep string seppos eol)
  (let ((lhs (or (expand string :start 0 :end seppos)
		 (subseq string 0 seppos)))
	(rhs (or (expand string :start (1+ seppos) :end eol)
		 (subseq string (1+ seppos) eol))))
    (ecase sep
      (#\< (setf (gettrie lhs $reverse) rhs))
      (#\> (setf (gettrie lhs $forward) rhs)))
    (warn "PARSE-OP: ~A ~S ~S" sep
	  (subseq string 0 seppos)
	  (subseq string (1+ seppos) eol))))

(defun parse-line (string)
  (when (> (length string) 0)
    (case (char string 0)
      (#\# (write string) (terpri) nil)
      (#\return) ;; hack
      (t (multiple-value-bind (sep seppos)
	     (loop for c across string for i from 0
		   do (case c ((#\> #\< #\=)
			       (return (values c i)))))
	   (unless sep (error "no sep. offending line=~S char=~C" string (char string (1- (length string)))))
	   (let ((eol (position #\; string)))
	     (unless eol (error "no ; marker. offending line=~S" string))
	     (ecase sep
	       ((#\> #\<) (parse-op sep string seppos eol))
	       (#\= (assign-ident string seppos eol)))))))))

(defun parse-file (pathname)
  (WITH-open-file (stream pathname)
    (loop for line = (read-line stream nil)
	  while line do (parse-line line))))


(parse-file $t1)