[Golok-commit] SF.net SVN: golok:[28] trunk

[<sr...@us...>]

Revision: 28
          http://golok.svn.sourceforge.net/golok/?rev=28&view=rev
Author:   sralmai
Date:     2010-06-15 22:12:17 +0000 (Tue, 15 Jun 2010)

Log Message:
-----------
[BUGFIX]: path mangling problem for sytem configuration file ouptut fixed

Modified Paths:
--------------
    trunk/find-k.scm
    trunk/golok.scm

Modified: trunk/find-k.scm
===================================================================
--- trunk/find-k.scm	2010-06-14 01:39:43 UTC (rev 27)
+++ trunk/find-k.scm	2010-06-15 22:12:17 UTC (rev 28)
@@ -130,16 +130,17 @@
       ; sanity check on file (mostly to prevent pathlist-closure from being called on a directory)
       (if (not (file-exists? filename)) (raise-user-error filename " not found!")
             ; save the path of filename
-         (let ([cl (pathlist-closure (list filename))])
+         (let ([cl (path->complete-path (string->path filename))])
+          (let-values ([(amf-dir amf-file dir?) (split-path cl)])
             (begin
-              (set! amf-directory (path->string (list-ref cl (- (length cl) 2))))
+              (set! amf-directory amf-dir)
               (if (not output-directory) (set! output-directory amf-directory) (void)))
               (set! prot (parse-amf-file filename))
               (set! base-name (parse-filename filename))
               (set! start-time (current-seconds))
               
               ; k is current system instance
-              (set! k (protocol-kernel prot))))))
+              (set! k (protocol-kernel prot)))))))
 
   (define parse-filename
     (lambda (fn)
@@ -202,7 +203,8 @@
 
   (define dump-solution
     (lambda ()
-      (let ([output-name (string-append output-directory "/" (strip-folder base-name) "-cutoff.topo")])
+      (let ([output-name (simplify-path (build-path output-directory
+                                (string-append (strip-folder base-name) "-cutoff.topo")))])
         (begin
           (topology->file k output-name)
           (display-ln "The cut-off system has " (topology->string k) " processes.")
@@ -316,13 +318,5 @@
 ; (string?) -> (string?)
 (define strip-folder
   (lambda (x)
-    (let ([rev-chars (reverse (string->list x))])
-      (list->string (reverse (strip-folder-rec rev-chars))))))
-
-; (list-of char?) -> (list-of char?)
-(define strip-folder-rec
-  (lambda (x)
-     (cond
-        ((null? x) '())
-        ((or (eq? (car x) #\/) (eq? (car x) #\\)) '())
-        (#t (cons (car x) (strip-folder-rec (cdr x)))))))
+    (let-values ([(dir-path file dir?) (split-path x)])
+      (path->string file))))

Modified: trunk/golok.scm
===================================================================
--- trunk/golok.scm	2010-06-14 01:39:43 UTC (rev 27)
+++ trunk/golok.scm	2010-06-15 22:12:17 UTC (rev 28)
@@ -8,7 +8,7 @@
   (require scheme/cmdline)
   
   ;; version header -- should be in form vx.y.z(-tag)
-  (define version "v1.2.0")
+  (define version "v1.2.1")
   
   ; parsed values of command line arguments
   ; currently size 11
@@ -44,7 +44,7 @@
   (define dump #f)
 
   ; output directory
-  (define output-directory "output")
+  (define output-directory #f)
 
   ; fast forward (skip) searching n levels of bfs tree
   ; TODO: not implemented


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.