Commit f19985f9 authored by Erick's avatar Erick

Added #!fold-case and #!no-fold-case

parent 4090634b
This diff is collapsed.
This diff is collapsed.
/*
* f p o r t . c -- File ports
*
* Copyright © 2000-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 2000-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
* This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 8-Jan-2000 14:48 (eg)
* Last file update: 27-May-2011 22:33 (eg)
* Last file update: 18-Mar-2012 18:46 (eg)
*
* This implementation is built by reverse engineering on an old SUNOS 4.1.1
* stdio.h. It has been simplified to fit the needs for STklos. In particular
......@@ -405,6 +405,9 @@ make_fport(char *fname, FILE *f, int flags)
/* keep the indication that file is opened in read in the steam part */
if (flags & (PORT_READ | PORT_RW)) mode |= STK_IOREAD;
/* Set the case sensitive bit */
if (STk_read_case_sensitive) flags |= PORT_CASE_SENSITIVE;
/* Initialize the stream part */
PORT_BASE(fs) = STk_must_malloc_atomic(n);
PORT_PTR(fs) = PORT_BASE(fs);
......@@ -766,7 +769,7 @@ SCM STk_load_source_file(SCM f)
* change while loading the file (with R5RS macro for instance, it
* is the case)
*/
sexpr = STk_read_constant(f, STk_read_case_sensitive);
sexpr = STk_read_constant(f, PORT_CASE_SENSITIVEP(f));
if (sexpr == STk_eof) break;
eval = STk_lookup(eval_symb, STk_current_module(), &ref, TRUE);
STk_C_apply(eval, 1, sexpr);
......
/*
* p o r t . c -- ports implementation
*
* Copyright © 1993-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 1993-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27
* Last file update: 28-Aug-2011 14:02 (eg)
* Last file update: 18-Mar-2012 18:08 (eg)
*
*/
......@@ -255,7 +255,7 @@ doc>
DEFINE_PRIMITIVE("read", scheme_read, subr01, (SCM port))
{
port = verify_port(port, PORT_READ);
return STk_read(port, STk_read_case_sensitive);
return STk_read(port, PORT_CASE_SENSITIVEP(port));
}
......@@ -264,7 +264,7 @@ DEFINE_PRIMITIVE("read", scheme_read, subr01, (SCM port))
DEFINE_PRIMITIVE("%read", scheme_read_cst, subr01, (SCM port))
{
port = verify_port(port, PORT_READ);
return STk_read_constant(port, STk_read_case_sensitive);
return STk_read_constant(port, PORT_CASE_SENSITIVEP(port));
}
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??-Oct-1993 ??:??
* Last file update: 26-Feb-2012 18:25 (eg)
* Last file update: 18-Mar-2012 18:10 (eg)
*
*/
#include <ctype.h>
......@@ -66,7 +66,7 @@ static void Inline printsymbol(SCM symb, SCM port, int mode)
if ((mode==WRT_MODE) &&
((BOXED_INFO(symb) & SYMBOL_NEEDS_BARS) ||
(!STk_read_case_sensitive && (BOXED_INFO(symb) & SYMBOL_HAS_UPPER)))) {
((!PORT_CASE_SENSITIVEP(port)) && (BOXED_INFO(symb) & SYMBOL_HAS_UPPER)))) {
STk_putc('|', port); STk_puts(s, port); STk_putc('|', port);
} else
STk_puts(*s ? s: "||", port); /* print bars around the "null" symbol */
......@@ -78,7 +78,7 @@ static void Inline printkeyword(SCM key, SCM port, int mode)
if (mode==WRT_MODE) {
if ((BOXED_INFO(key) & SYMBOL_NEEDS_BARS) ||
(!STk_read_case_sensitive && (BOXED_INFO(key) & SYMBOL_HAS_UPPER))) {
((!PORT_CASE_SENSITIVEP(port)) && (BOXED_INFO(key) & SYMBOL_HAS_UPPER))) {
STk_nputs(port, "|:", 2); STk_puts(s, port); STk_putc('|', port);
return;
}
......
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??-Oct-1993 ??:??
* Last file update: 26-Feb-2012 18:51 (eg)
* Last file update: 18-Mar-2012 18:25 (eg)
*
*/
......@@ -674,18 +674,33 @@ static SCM read_rec(SCM port, struct read_context *ctx, int inlist)
return STk_false;
case '\\': return read_char(port, STk_getc(port));
case '(' : return read_vector(port, ctx);
case '!' : { /* This can be a comment or a DSSSL keyword */
case '!' : { /* This can be a comment, a DSSSL keyword, or fold-case */
c = STk_getc(port);
if (c == 'o' || c == 'k' || c == 'r') {
if (c == 'o' || c == 'k' || c == 'r' || c == 'n' || c == 'f') {
SCM word = read_token(port, c, FALSE);
if (SYMBOLP(word)) {
char *s = SYMBOL_PNAME(word);
/* Try to see if it is a DSSL keyword */
if ((strcmp(s, "optional") == 0) ||
(strcmp(s, "key") == 0) ||
(strcmp(s, "rest") == 0))
return STk_makekey(s);
/* Treat fold-case and no-fold-case */
if ((strcmp(s, "fold-case") == 0) ||
(strcmp(s, "no-fold-case") == 0)) {
if (c == 'n') {
PORT_FLAGS(port) |= PORT_CASE_SENSITIVE;
ctx->case_significant = TRUE;
}
else {
PORT_FLAGS(port) &= ~PORT_CASE_SENSITIVE;
ctx->case_significant = FALSE;
}
continue;
}
}
}
/* if we are here, consider the rest of the line
......
/*
* s p o r t . c -- String ports management
*
* Copyright © 1993-2010 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 1993-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27
* Last file update: 9-Aug-2010 10:59 (eg)
* Last file update: 18-Mar-2012 18:47 (eg)
*
*/
......@@ -233,6 +233,8 @@ make_sport(enum kind_port kind, SCM str, int init_len, int flags)
PORT_PTR(ss) = PORT_BASE(ss);
PORT_BUFSIZE(ss) = init_len;
/* Set the case sensitive bit */
if (STk_read_case_sensitive) flags |= PORT_CASE_SENSITIVE;
/* Initialize now the port itsef */
NEWCELL(res, port);
......
/*
* stklos.h -- stklos.h
*
* Copyright © 1999-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 1999-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
* This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 9-Sep-2011 15:37 (eg)
* Last file update: 18-Mar-2012 18:08 (eg)
*/
......@@ -894,7 +894,7 @@ struct port_obj {
#define PORT_IS_STRING (1<<6)
#define PORT_IS_VIRTUAL (1<<7)
#define PORT_IS_INTERACTIVE (1<<8)
#define PORT_CASE_SENSITIVE (1<<9)
#define PORT_STREAM(x) (((struct port_obj *) (x))->stream)
#define PORT_FLAGS(x) (((struct port_obj *) (x))->flags)
......@@ -935,10 +935,9 @@ struct port_obj {
#define IVPORTP(x) (VPORTP(x) && (PORT_FLAGS(x) & (PORT_READ|PORT_RW)))
#define OVPORTP(x) (VPORTP(x) && (PORT_FLAGS(x) & (PORT_WRITE|PORT_RW)))
#define PORT_IS_CLOSEDP(x) (PORT_FLAGS(x) & PORT_CLOSED)
#define PORT_CASE_SENSITIVEP(x) (PORT_FLAGS(x) & PORT_CASE_SENSITIVE)
/****
**** sio.h primitives
......
......@@ -2,7 +2,7 @@
*
* s y m b o l . c -- Symbols management
*
* Copyright © 1993-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 1993-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
* This program is free software; you can redistribute it and/or modify
......@@ -22,7 +22,7 @@
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 20-Nov-1993 12:12
* Last file update: 6-Aug-2006 23:19 (eg)
* Last file update: 18-Mar-2012 18:11 (eg)
*/
#include <ctype.h>
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 26-Feb-2012 23:39 (eg)
* Last file update: 18-Mar-2012 18:13 (eg)
*/
// INLINER values
......@@ -2157,7 +2157,7 @@ SCM STk_load_bcode_file(SCM f)
consts = STk_read_constant(f, TRUE); /* Read the constants */
if (consts == STk_eof) break;
code_size = STk_read(f, STk_read_case_sensitive); /* Read the code size */
code_size = STk_read(f, PORT_CASE_SENSITIVEP(f)); /* Read the code size */
size = STk_integer_value(code_size);
if (size < 0) {
if (system_has_booted)
......
/*
* vport.c -- Virtual Ports
*
* Copyright © 2005-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
* Copyright © 2005-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
*
*
* This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 17-Aug-2005 08:31 (eg)
* Last file update: 27-May-2011 22:48 (eg)
* Last file update: 18-Mar-2012 18:47 (eg)
*/
#include "stklos.h"
......@@ -260,6 +260,7 @@ DEFINE_PRIMITIVE("%open-input-virtual", open_input_vport, subr1, (SCM v))
{
SCM z;
struct vstream *vs;
int flag = (STk_read_case_sensitive) ? PORT_CASE_SENSITIVE : 0;
if (!VECTORP(v) || VECTOR_SIZE(v) != 4) error_bad_vector(v, 4);
......@@ -274,7 +275,7 @@ DEFINE_PRIMITIVE("%open-input-virtual", open_input_vport, subr1, (SCM v))
vs->putc = vs->putstring = vs->flush = NULL;
PORT_STREAM(z) = vs;
PORT_FLAGS(z) = PORT_READ | PORT_IS_VIRTUAL;
PORT_FLAGS(z) = PORT_READ | PORT_IS_VIRTUAL | flag;
PORT_UNGETC(z) = EOF;
PORT_LINE(z) = 1;
PORT_POS(z) = 0;
......@@ -353,6 +354,7 @@ DEFINE_PRIMITIVE("%open-output-virtual", open_output_vport, subr1, (SCM v))
{
SCM z;
struct vstream *vs;
int flag = (STk_read_case_sensitive) ? PORT_CASE_SENSITIVE : 0;
if (!VECTORP(v) || VECTOR_SIZE(v) != 4) error_bad_vector(v, 4);
......@@ -367,7 +369,7 @@ DEFINE_PRIMITIVE("%open-output-virtual", open_output_vport, subr1, (SCM v))
vs->getc = vs->readyp = vs->eofp = NULL;
PORT_STREAM(z) = vs;
PORT_FLAGS(z) = PORT_WRITE | PORT_IS_VIRTUAL;
PORT_FLAGS(z) = PORT_WRITE | PORT_IS_VIRTUAL | flag;
PORT_UNGETC(z) = EOF;
PORT_LINE(z) = 1;
PORT_POS(z) = 0;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment