Changeset 22109 in project


Ignore:
Timestamp:
12/25/10 06:57:54 (9 years ago)
Author:
Alan Post
Message:

genturfa'i: improve command-line utility.

Rework the way I handle input and output files, allowing '-i' '-o'
command-line options, and reading from the current input port if
no command-line option was specified.

Also allow the user to specify a different debug/profile output
file.

Location:
release/4/genturfahi/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/genturfahi/trunk/eval.scm

    r22102 r22109  
    5050  'output-file
    5151  (lambda (file)
    52     (let ((port (open-output-file file)))
    53       (lambda () port))))
     52    (call-with-output-file file current-output-port)))
    5453
    5554(safe-environment-set!
  • release/4/genturfahi/trunk/main-srfi-37.scm

    r22054 r22109  
    1919
    2020(define (debug option name arg . seeds)
     21  (if arg (sexuna-debug-file arg))
    2122  (secuxna-debug #t))
    2223
    2324(define (help option name arg . seeds)
    2425  (print #<<EOS
    25 usage: genturfahi [-dhmpv] [-help] [-version]
    26                   [-debug] [-no-memoize] [-profile]
    27                   [file]
     26usage: genturfahi [-:?]
     27                  [-d | --debug]
     28                  [-h | --help]
     29                  [-i | --input-file NAME]
     30                  [-m | --no-memoize]
     31                  [-n | --define-name NAME]
     32                  [-o | --output-file NAME]
     33                  [-p | --profile]
     34                  [-s | --start-production NAME]
     35                  [-t | --define-toplevel]
     36                  [-v | --version]
     37                  [file]*
    2838EOS
    2939  )
     
    3646  (secuxna-define-toplevel #t))
    3747
     48(define (input-file option name arg . seeds)
     49  (call-with-input-file arg current-input-port))
     50
    3851(define (no-memoize option name arg . seeds)
    3952  (secuxna-memoize #f))
    4053
     54(define (output-file option name arg . seeds)
     55  (call-with-output-file arg current-output-port))
     56
    4157(define (profile option name arg . seeds)
     58  (if arg (sexuna-profile-file arg))
    4259  (secuxna-profile #t))
    4360
     
    5471
    5572(define options
    56   (list (option '(#\d "debug")            #f         #f debug)
    57         (option '(#\h "sidju" "help")     #f         #f help)
    58         (option '(#\m "no-memoize")       #f         #f no-memoize)
    59         (option '(#\n "define-name")      #:required #f define-name)
    60         (option '(#\p "profile")          #f         #f profile)
    61         (option '(#\s "start-production") #:required #f start-production)
    62         (option '(#\t "define-toplevel")  #f         #f define-toplevel)
    63         (option '(#\v "version")          #f         #f version)
    64         (option '(#\:)                    #:required #f runtime)))
     73  (list (option '(#\d "debug")            #f #t debug)
     74        (option '(#\h "sidju" "help")     #f #f help)
     75        (option '(#\i "input-file")       #t #f input-file)
     76        (option '(#\m "no-memoize")       #f #f no-memoize)
     77        (option '(#\n "define-name")      #t #f define-name)
     78        (option '(#\o "output-file")      #t #f output-file)
     79        (option '(#\p "profile")          #f #t profile)
     80        (option '(#\s "start-production") #t #f start-production)
     81        (option '(#\t "define-toplevel")  #f #f define-toplevel)
     82        (option '(#\v "version")          #f #f version)
     83        (option '(#\:)                    #t #f runtime)))
    6584
    6685(define (usage option name args . seeds)
    6786  (error (format "unrecognized option \"~a\"" name)))
    6887
    69 (define (args name . seeds)
    70   (let ((jalge    (call-with-input-file name genturfahi-peg))
     88(define (peg name . seeds)
     89  (call-with-input-file name for-port))
     90
     91(define (for-port port)
     92  (let ((jalge    (genturfahi-peg port))
    7193        (tamgau   (secuxna-define-name))
    72         (toplevel (secuxna-define-toplevel)))
     94        (toplevel (secuxna-define-toplevel))
     95        (port     (current-output-port)))
    7396    (if (not jalge)
    7497        (secuxna-exit-status 1))
    75     (display genturfahi-license)
     98    (display genturfahi-license port)
    7699    (if toplevel
    77         (for-each pretty-print jalge)
    78         (if (pair? tamgau)
    79             (pretty-print `(define-values ,(map string->symbol tamgau) ,jalge))
    80             (pretty-print `(define ,(string->symbol tamgau) ,jalge))))))
     100        (for-each (lambda (jalge) (pretty-print jalge port)) jalge)
     101        (pretty-print
     102          (if (pair? tamgau)
     103              `(define-values ,(map string->symbol tamgau) ,jalge)
     104              `(define ,(string->symbol tamgau) ,jalge))
     105          port))))
    81106
    82107(define (main)
    83   (args-fold (cdr (argv)) options usage args))
     108  (let ((args (cdr (argv))))
     109    (if (null? args)
     110        (for-port (current-input-port))
     111        (args-fold args options usage peg))))
Note: See TracChangeset for help on using the changeset viewer.