source: project/release/3/nemo/trunk/nemo.scm @ 11858

Last change on this file since 11858 was 11858, checked in by Ivan Raikov, 12 years ago

Added XML stuff and created initial nemo program.

File size: 4.3 KB
Line 
1;;
2;; NEMO
3;;
4;; Copyright 2008 Ivan Raikov.
5;;
6;; This program is free software: you can redistribute it and/or
7;; modify it under the terms of the GNU General Public License as
8;; published by the Free Software Foundation, either version 3 of the
9;; License, or (at your option) any later version.
10;;
11;; This program is distributed in the hope that it will be useful, but
12;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14;; General Public License for more details.
15;;
16;; A full copy of the GPL license can be found at
17;; <http://www.gnu.org/licenses/>.
18;;
19
20
21(require-extension  srfi-1)
22(require-extension  syntax-case)
23(require-extension  matchable)
24(require-extension  stx-engine)
25(require-extension  sxpath-plus)
26(require-extension  sxml-transforms)
27(require-extension  sxml-tools)
28(require-extension  nemo-macros)
29(require-extension  nemo-nmodl)
30(require-extension  nemo-hh)
31
32
33(define (lookup-def k lst . rest)
34  (let-optionals rest ((default #f))
35      (let ((kv (assoc k lst)))
36        (if (not kv) default
37            (match kv ((k v) v) (else (cdr kv)))))))
38
39
40;;; Procedures for string concatenation and pretty-printing
41
42(define (s+ . lst)    (string-concatenate (map ->string lst)))
43(define (sw+ lst)     (string-intersperse (filter-map (lambda (x) (and x (->string x))) lst) " "))
44(define (s\ p . lst)  (string-intersperse (map ->string lst) p))
45(define (sl\ p lst)   (string-intersperse (map ->string lst) p))
46(define nl "\n")
47
48;;; Error/warning procedures for the XML parser
49
50(define (parser-error port message . specialising-msgs)
51  (error (string-append message (string-concatenate (map ->string specialising-msgs)))))
52
53(define (ssax:warn port message . specialising-msgs)
54  (print-error-message message (current-output-port) "Warning")
55  (print (string-concatenate (map ->string specialising-msgs))))
56
57(include "SXML.scm")
58(include "SSAX.scm")
59(include "SXML-to-XML.scm")
60
61
62
63(define opts
64  `(
65    ,(args:make-option (nmodl-file)       (required: "FILE")   
66                       (s+ "write NMODL output to file"))
67    ,(args:make-option (nmodl-method)       (required: "METHOD")
68                       (s+ "specify NMODL integration method (cnexp, derivimplicit, expeuler)")
69                       (string->symbol arg))
70    ,(args:make-option (t)       #:none
71                       (s+ "use interpolation tables")
72                       #t)
73    ,(args:make-option (sxml-file)       (optional: "FILE")   
74                       (s+ "write SXML output to file (default: <file>.sxml)")
75                       arg)
76    ,(args:make-option (h help)  #:none               "Print help"
77                       (usage))
78
79    ))
80
81
82;; Use args:usage to generate a formatted list of options (from OPTS),
83;; suitable for embedding into help text.
84(define (usage)
85  (print "Usage: " (car (argv)) " [options...] <list of files to be processed> ")
86  (newline)
87  (print "The following options are recognized: ")
88  (newline)
89  (print (parameterize ((args:indent 5)) (args:usage opts)))
90  (exit 1))
91
92
93;; Process arguments and collate options and arguments into OPTIONS
94;; alist, and operands (filenames) into OPERANDS.  You can handle
95;; options as they are processed, or afterwards.
96(define args    (command-line-arguments))
97(set!-values (options operands)  (args:parse args opts))
98
99 
100(define (main options operands)
101  (if (not (null? operands))
102      (for-each
103       (lambda (operand)
104         (let ((doc (call-with-input-file operand
105                      (lambda (port) (ssax:xml->sxml port '((cml . "http://morphml.org/channelml/schema") 
106                                                            (meta . "http://morphml.org/metadata/schema"))))))
107               (mod-fname  (s+ (lookup-def 'mod-file options (pathname-strip-extension operand)) ".mod"))
108               (sxml-fname ((lambda (x) (and x (if (string? (cdr x)) (s+ (pathname-strip-extension (cdr x)) ".sxml")
109                                                   (s+  (pathname-strip-extension operand) ".sxml"))))
110                            (assoc 'sxml-file options)))
111               (method      (let ((method  ((lambda (x) (and x (string->symbol x))) (lookup-def 'method options) )))
112                              (case method
113                                ((cnexp derivimplicit expeuler #f) method)
114                                (else (error "method must be one of cnexp, derivimplicit, expeuler"))))))
115           (if sxml-fname (with-output-to-file sxml-fname (lambda () (print doc))))
116           (with-output-to-file
117               mod-fname  (lambda () (cml->neuron `((method . ,method)
118                                                    (table  . ,(assoc 'table options))) doc)))
119           ))
120       operands)))
121
122(main options operands)
123
Note: See TracBrowser for help on using the repository browser.