Pjotr Kourzanov  committed ecb182b

make sequel use common.nw

  • Participants
  • Parent commits 1bc5946

Comments (0)

Files changed (1)

File src/sequel/sequel.nw

      (export <<exports>>)
      (eval (export-exports)))
-  <<SXML auxiliary>>
-  <<SXML namespaces>>
-  <<toplevel>>
 @ Scheme file defines a module for the interpreter. This only requires one to list the dependent modules and libraries.
      (export <<exports>>)
      (eval (export-exports)))
-  <<SXML auxiliary>>
-  <<SXML namespaces>>
-  <<toplevel>>
 @ Import \mac{SLIB} library.
 (library slib)
-@ Import \mac{SCHELOG} library.
-(library schelog)
 @ Import \mac{GLPK} library.
 (library glpk)
 @ \subsection{Input/Output}
-@ \subsubsection{GXF preprocessing}
-@ Miscellaneous functions for \mac{SXML} transformations and namespace support.
-<<SXML auxiliary>>=
-(define Identity (lambda (x) x))
-(define Id (lambda x x))
-(define Unmeta (lambda (tag x) x))
-(define (sxpath/link e)
-	(sxpath/c e `[(xlink . ,XLink)]))
-@ Abbreviations of common namespaces and their elements.
-<<SXML namespaces>>=
-(define XLink "")
-(define XLink:type '
-(define XLink:label '
-(define XLink:href '
-(define XLink:from '
-(define XLink:to '
-@ A transformation to splice the contents of the [[<stream>]] node into the context. This is needed to support outport-inport traversals (along edges); for some reason XLinks do not work if they are not enclosed directly by the root context.
-(define (gxf:stream-splice sxml) (pre-post-order sxml 
-	`((*TOP* *macro* 	. ,(lambda top (car ((sxpath "*") top))))
-	  (@ *preorder*  	. ,Id)
-	  (gxf 			. ,(lambda gxf `(gxf
-              (@ ,@(map-union Identity ((sxpath "attribute::*") gxf)))
-     	         ,@(map-union Identity ((sxpath "node") gxf))
-     	         ,@(map-union Identity ((sxpath "stream/*") gxf))
-     	         ,@(map-union (lambda (x)
-     		   (let ([n (cadadr x)]
-			 [p (cadadr (cdr x))])
-     		   (list <<stream-splice nodes>>
-     		     )))
-     		    ((sxpath "stream/edge/from-node") gxf)))))
-	  (*text*  		. ,Unmeta)
-	  (*default*  		. ,Id))))
-@ Also, add these handy link nodes for outport-edge, edge-outport traversals.
-<<stream-splice nodes>>=
-     		    `(el (@ (,XLink:type "locator")
-     		            (,XLink:label ,(string-append n "_" p "_fanout"))
-     		            (,XLink:href ,(string-append
-     			      "#xpointer(gxf//edge[contains(from-node/id,'" n "') "
-     			      "and contains(from-node/port-id,'" p "')])"))))
-     		    `(nl (@ (,XLink:type "locator")
-     		            (,XLink:label ,(string-append n ":" p))
-     		            (,XLink:href ,(string-append "#" n ":" p))))
-     		    `(ea (@ (,XLink:type "arc")
-     		            (,XLink:from ,(string-append n "_" p "_fanout"))
-     		            (,XLink:to ,(string-append n ":" p))))
-     		    `(pa (@ (,XLink:type "arc")
-     		            (,XLink:from ,(string-append n ":" p))
-     		            (,XLink:to ,(string-append n "_" p "_fanout"))))
-@ Dump the \mac{GXF} to the filesystem...
-(define (gxf:convert in out)
-   (with-output-to-file out (lambda ()
-	(print "<?xml version='1.0' encoding='utf-8'?>")
-	(print (string-append "<!DOCTYPE gxf PUBLIC "
-	               "'-//LIME/DTD gxf 1.0 Transitional//EN' "
-		       "'/home/pjotr/LIME/doc/gxf.dtd'>"))
-	(srl:parameterizable
-	 (gxf:stream-splice
-	  (xlink:find-doc in (xlink:documents in))) (current-output-port)
-	  ;'(indent . "")
-	  '(omit-xml-declaration . #t)
-	  '(standalone . yes)
-	  '(cdata-section-elements . (code))
-	  ))))
 @ \subsubsection{Conversion to the incidence matrix}
 @ A transformation to extract the incidence list: a list containing output ports per edge, tagged by containing node, followed by a list containing incoming ports per edge, tagged by containing node (list of $2$ lists).
 (define (gxf:handle-port p)
-   (let ([ts ((sxpath "type/size/text()") p)])
-   `(* ,(string->number (car ((sxpath "size/text()") p)))
+   (let ([ts (Xs p '(type size *text*))])
+   `(* ,(string->number (X p size))
        ,(if [pair? ts] (/ (string->number (car ts)) 8)
-	    `(sizeof '(,@(map string->symbol (string-split (car ((sxpath "type/text()") p)))))))
+	    `(sizeof '(,@(map string->symbol (string-split (X p type))))))
 @ Traverse instantiation hierarchy and get to the port.
 (define (gxf:handle-endpoint sxml i p)
 	(list (string->symbol i)
 	      (string->symbol p)
-	      (gxf:handle-port ((sxpath "gxf/node[id=$n]/port[id=$p]") sxml
-		  `((n . ,((sxpath "gxf/node[id=$n]/stereo-type/text()") sxml
-		  	    `[(n . ,i])))
-	    (p . ,p))))));$
+	      (gxf:handle-port (Xs sxml "gxf/node[id=$n]/port[id=$p]"
+				   where [$n = (Xs sxml "gxf/node[id=$n]/stereo-type/text()"
+						   where [$n = i])]
+				   [$p = p]))));$
 @ This function retrieves the instantiation list from the \mac{SXML} representation of the graph. It supports instances and uses edges themselves to get to the ports.
 (define <<gxf:incidence signature>> (pre-post-order sxml 
 	`((*TOP* *macro* 	. ,(lambda top (list
-		`(nodes ,((sxpath "gxf/stream/edge[type='fifo']/from-node") top))
-	        `(nodes ,((sxpath "gxf/stream/edge[type='fifo']/to-node") top)))))
+		`(nodes ,(Xs top "gxf/stream/edge[type='fifo']/from-node"))
+	        `(nodes ,(Xs top "gxf/stream/edge[type='fifo']/to-node")))))
 	  (nodes		. ,(lambda (t . x) (map-union Identity x)))
 	  (from-node 		. ,(lambda (t i p) (gxf:handle-endpoint sxml (cadr i) (cadr p))))
 	  (to-node 		. ,(lambda (t i p) (gxf:handle-endpoint sxml (cadr i) (cadr p))))
 (define <<gxf:delays signature>> (pre-post-order sxml 
 	`((*TOP* *macro* 	. ,(lambda top (list
-	        `(nodes  ,((sxpath "gxf/stream/edge[type='fifo']/to-node") top)))))
+	        `(nodes  ,(Xs top "gxf/stream/edge[type='fifo']/to-node")))))
 	  (nodes		. ,(lambda (t . x) (map-union Identity x)))
 	  (to-node 		. ,(lambda (t ti tp)
-	 	(let ([ttn ((sxpath "gxf/stream/edge[type='init_fifo' and to-node/id=$n and to-node/port-id=$p]/from-node") sxml
-	      		    `((n . ,(cadr ti))
-			      (p . ,(cadr tp))))])
+	 	(let ([ttn (Xs sxml "gxf/stream/edge[type='init_fifo' and to-node/id=$n and to-node/port-id=$p]/from-node"
+			       where [$n = (cadr ti)]
+			       [$p = (cadr tp)])])
 		     (if (pair? ttn) (let ([i (cadar ttn)]
 		    			   [p (caddar ttn)])
 		     	(list 'unquote (caddr (gxf:handle-endpoint sxml (cadr i) (cadr p)))))
 			   [c (list-ref b i)])
 			(let ([pp (position (car p) d)]
 			      [pc (position (car c) d)]
-			      [maybe-cadr (lambda (x) (if [pair? x] (cadr x)
-							 x))])
+			      [maybe-cadr (lambda (x) (if [pair? x] (cadr x) x))])
 			   (vector-set! v pp (list 'unquote `(+ ,(maybe-cadr (vector-ref v pp)) ,(caddr p))))
 			   (vector-set! v pc (list 'unquote `(- ,(maybe-cadr (vector-ref v pc)) ,(caddr c))))
 			   (vector-set! r i v))))
     (let ([v (simulate:fireable-bounds G b
     		(cond ((null? B) (lambda (z) (array:positive? z)))
                        (else (lambda (z) (array:positive-bounds? z B)))))])
-       <<simulate:historian>>       
-      ;;(printf "b=~s v=~s " (array->vector b) (array->vector v))
+      <<simulate:historian>>
+      ;(printf "b=~s v=~s " (array->vector b) (array->vector v));(debug (array->vector b) (array->vector v))
       (set! b (matrix:sum b (matrix:product G v)))
-      ;;(printf "b=~s~n" (array->vector b))
+      ;(printf "b=~s~n" (array->vector b));(debug (array->vector b))
       (array-map! mb max mb b)
       (set! found (assoc (array->vector b) history))
       (if found
 (let ([s (cadr found)])
+     ;(printf "~nCYCLE DETECTED ~s..~s~n" s i)
      [assert (s) (= s 0)]
-     ;(printf "~nCYCLE DETECTED ~s..~s~n" s i)
      (let ([r (do [(j s (+ j 1))
 	           (r v)]
 	          ((>= j i) r)
         (if (pred z) 
 	   (set! v (matrix:sum Z a))
 	   ;(set! v (matrix:sum v a))
-	   #;(printf "v1=~a~n" (array->vector v))
+	   ;(printf "v1=~a~n" (array->vector v))
      (array-set! a 0 i 0)
-     #;(printf "v2=~a~n" (array->vector v))
+     ;(printf "v2=~a~n" (array->vector v))
 @ \subsection{Miscellaneous funcions}
 		   	(int*-set! ia k (+ i 1))
 		   	(int*-set! ja k (+ j 1))
 		   	(double*-set! ar k (exact->inexact (array-ref G i j)))
-			#;(printf "~a G[~a,~a]=~a~n" k i j (array-ref G i j))
+			;(printf "~a G[~a,~a]=~a~n" k i j (array-ref G i j))
 		   	(set! k (+ k 1))))
 	      (glp:load_matrix g (* rows cols) ia ja ar))
 	  (glp:Simplex g)
   the first and the second element of the list returned (see \ref{chunk:imat})
 <<old testing code using temporary files>>=
-(begin #;(gxf:convert "/tmp/test.gxf" "/tmp/")
+(begin ;(gxf:convert "/tmp/test.gxf" "/tmp/")
        (gxf->imat "/tmp/test.gxf" "/tmp/")
        (let* ([data (with-input-from-file "/tmp/" (lambda () (eval (read) (my-environment))))]
 	      [buf (car data)]