mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
Implement SRFI 193: Command lines
This commit is contained in:
parent
2e63c53a6b
commit
65b197f7de
3 changed files with 60 additions and 8 deletions
23
lib/srfi/193.sld
Normal file
23
lib/srfi/193.sld
Normal file
|
@ -0,0 +1,23 @@
|
||||||
|
|
||||||
|
(define-library (srfi 193)
|
||||||
|
(export command-line command-name command-args script-file script-directory)
|
||||||
|
(import (scheme base) (chibi filesystem) (chibi pathname)
|
||||||
|
(only (meta) command-line raw-script-file))
|
||||||
|
(begin
|
||||||
|
|
||||||
|
(define (command-name)
|
||||||
|
(let ((filename (car (command-line))))
|
||||||
|
(and (not (= 0 (string-length filename)))
|
||||||
|
(path-strip-extension (path-strip-directory filename)))))
|
||||||
|
|
||||||
|
(define (command-args)
|
||||||
|
(cdr (command-line)))
|
||||||
|
|
||||||
|
(define (script-file)
|
||||||
|
(and raw-script-file
|
||||||
|
(path-normalize
|
||||||
|
(path-resolve raw-script-file (current-directory)))))
|
||||||
|
|
||||||
|
(define (script-directory)
|
||||||
|
(let ((filename (script-file)))
|
||||||
|
(and filename (string-append (path-directory filename) "/"))))))
|
32
main.c
32
main.c
|
@ -9,7 +9,8 @@
|
||||||
#include "chibi/eval.h"
|
#include "chibi/eval.h"
|
||||||
#include "chibi/gc_heap.h"
|
#include "chibi/gc_heap.h"
|
||||||
|
|
||||||
#define sexp_argv_symbol "command-line"
|
#define sexp_command_line_symbol "command-line"
|
||||||
|
#define sexp_raw_script_file_symbol "raw-script-file"
|
||||||
|
|
||||||
#define sexp_import_prefix "(import ("
|
#define sexp_import_prefix "(import ("
|
||||||
#define sexp_import_suffix "))"
|
#define sexp_import_suffix "))"
|
||||||
|
@ -282,6 +283,14 @@ static void do_init_context (sexp* ctx, sexp* env, sexp_uint_t heap_size,
|
||||||
#define init_context() if (! ctx) do { \
|
#define init_context() if (! ctx) do { \
|
||||||
do_init_context(&ctx, &env, heap_size, heap_max_size, fold_case); \
|
do_init_context(&ctx, &env, heap_size, heap_max_size, fold_case); \
|
||||||
sexp_gc_preserve4(ctx, tmp, sym, args, env); \
|
sexp_gc_preserve4(ctx, tmp, sym, args, env); \
|
||||||
|
sexp_set_parameter( \
|
||||||
|
ctx, sexp_meta_env(ctx), \
|
||||||
|
sym=sexp_intern(ctx, sexp_command_line_symbol, -1), \
|
||||||
|
args=sexp_cons(ctx, sexp_c_string(ctx,"",-1), SEXP_NULL)); \
|
||||||
|
sexp_env_define( \
|
||||||
|
ctx, sexp_meta_env(ctx), \
|
||||||
|
sym=sexp_intern(ctx, sexp_raw_script_file_symbol, -1), \
|
||||||
|
SEXP_FALSE); \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
#define load_init(bootp) if (! init_loaded++) do { \
|
#define load_init(bootp) if (! init_loaded++) do { \
|
||||||
|
@ -306,7 +315,7 @@ sexp run_main (int argc, char **argv) {
|
||||||
sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE;
|
sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE;
|
||||||
sexp out=SEXP_FALSE, ctx=NULL, ls;
|
sexp out=SEXP_FALSE, ctx=NULL, ls;
|
||||||
sexp_gc_var4(tmp, sym, args, env);
|
sexp_gc_var4(tmp, sym, args, env);
|
||||||
args = SEXP_NULL;
|
args = NULL;
|
||||||
env = NULL;
|
env = NULL;
|
||||||
|
|
||||||
/* SRFI 22: invoke `main` procedure by default if the interpreter is */
|
/* SRFI 22: invoke `main` procedure by default if the interpreter is */
|
||||||
|
@ -545,15 +554,22 @@ sexp run_main (int argc, char **argv) {
|
||||||
done_options:
|
done_options:
|
||||||
if (!quit || main_symbol != NULL) {
|
if (!quit || main_symbol != NULL) {
|
||||||
init_context();
|
init_context();
|
||||||
|
load_init(i < argc || main_symbol != NULL);
|
||||||
/* build argument list */
|
/* build argument list */
|
||||||
if (i < argc)
|
if (i < argc) {
|
||||||
|
args = SEXP_NULL;
|
||||||
for (j=argc-1; j>=i; j--)
|
for (j=argc-1; j>=i; j--)
|
||||||
args = sexp_cons(ctx, tmp=sexp_c_string(ctx,argv[j],-1), args);
|
args = sexp_cons(ctx, tmp=sexp_c_string(ctx,argv[j],-1), args);
|
||||||
/* if no script name, use interpreter name */
|
sexp_set_parameter(
|
||||||
if (i >= argc || main_module != NULL)
|
ctx, sexp_meta_env(ctx),
|
||||||
args = sexp_cons(ctx, tmp=sexp_c_string(ctx,argv[0],-1), args);
|
sym=sexp_intern(ctx, sexp_command_line_symbol, -1),
|
||||||
load_init(i < argc || main_symbol != NULL);
|
args);
|
||||||
sexp_set_parameter(ctx, sexp_meta_env(ctx), sym=sexp_intern(ctx, sexp_argv_symbol, -1), args);
|
sexp_env_define(
|
||||||
|
ctx, sexp_meta_env(ctx),
|
||||||
|
sym=sexp_intern(ctx, sexp_raw_script_file_symbol, -1),
|
||||||
|
sexp_c_string(ctx,argv[i],-1));
|
||||||
|
}
|
||||||
|
|
||||||
if (i >= argc && main_symbol == NULL) {
|
if (i >= argc && main_symbol == NULL) {
|
||||||
/* no script or main, run interactively */
|
/* no script or main, run interactively */
|
||||||
repl(ctx, env);
|
repl(ctx, env);
|
||||||
|
|
13
tests/srfi-193-test.scm
Executable file
13
tests/srfi-193-test.scm
Executable file
|
@ -0,0 +1,13 @@
|
||||||
|
#! /usr/bin/env chibi-scheme
|
||||||
|
|
||||||
|
(import (scheme base) (scheme write) (srfi 193))
|
||||||
|
|
||||||
|
(define-syntax pp
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ expr) (begin (write 'expr) (display " => ") (write expr) (newline)))))
|
||||||
|
|
||||||
|
(pp (command-line))
|
||||||
|
(pp (command-name))
|
||||||
|
(pp (command-args))
|
||||||
|
(pp (script-file))
|
||||||
|
(pp (script-directory))
|
Loading…
Add table
Reference in a new issue