[Gd-chatter] r11288 - in branches/opendylan-melange: melange parsergen
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Tue Apr 24 22:37:31 CEST 2007
Author: andreas
Date: Tue Apr 24 22:37:25 2007
New Revision: 11288
Modified:
branches/opendylan-melange/melange/c-decl-state.dylan
branches/opendylan-melange/melange/c-decl-write.dylan
branches/opendylan-melange/melange/c-decl.dylan
branches/opendylan-melange/melange/c-exports.dylan
branches/opendylan-melange/melange/c-lexer-cpp.dylan
branches/opendylan-melange/melange/c-lexer.dylan
branches/opendylan-melange/melange/exports.dylan
branches/opendylan-melange/melange/int-lexer.dylan
branches/opendylan-melange/melange/interface.dylan
branches/opendylan-melange/melange/melange.lid
branches/opendylan-melange/melange/multistring.dylan
branches/opendylan-melange/melange/win32-vc-decl.lid
branches/opendylan-melange/melange/win32-vc-portability.dylan
branches/opendylan-melange/parsergen/Parsergen.lid
branches/opendylan-melange/parsergen/library.dylan
branches/opendylan-melange/parsergen/lisp-read.dylan
branches/opendylan-melange/parsergen/parsergen.dylan
Log:
Job: minor
get melange and parsergen compile and work (with gtk2 headers)
on opendylan
Modified: branches/opendylan-melange/melange/c-decl-state.dylan
==============================================================================
--- branches/opendylan-melange/melange/c-decl-state.dylan (original)
+++ branches/opendylan-melange/melange/c-decl-state.dylan Tue Apr 24 22:37:25 2007
@@ -115,7 +115,7 @@
// equal-hash isn't defined for general objects, even
// though \= is defined for them.
//
-define class <my-sequence-table> (<value-table>)
+define class <my-sequence-table> (<table>)
end class <my-sequence-table>;
define sealed inline method table-protocol (ht :: <my-sequence-table>)
Modified: branches/opendylan-melange/melange/c-decl-write.dylan
==============================================================================
--- branches/opendylan-melange/melange/c-decl-write.dylan (original)
+++ branches/opendylan-melange/melange/c-decl-write.dylan Tue Apr 24 22:37:25 2007
@@ -1005,7 +1005,7 @@
let raw-value = decl.constant-value;
let value = select (raw-value by instance?)
<declaration> => raw-value.dylan-name;
- <abstract-integer>, <float> => format-to-string("%=", raw-value);
+ <integer>, <float> => format-to-string("%=", raw-value);
<string> => format-to-string("\"%s\"",
escape-characters(raw-value));
<token> => raw-value.string-value;
Modified: branches/opendylan-melange/melange/c-decl.dylan
==============================================================================
--- branches/opendylan-melange/melange/c-decl.dylan (original)
+++ branches/opendylan-melange/melange/c-decl.dylan Tue Apr 24 22:37:25 2007
@@ -438,7 +438,7 @@
end method canonical-name;
define method make-enum-slot
- (name :: <string>, value :: false-or(<abstract-integer>),
+ (name :: <string>, value :: false-or(<integer>),
prev :: false-or(<enum-slot-declaration>), state :: <parse-state>)
=> (result :: <enum-slot-declaration>);
if (element(state.objects, name, default: #f))
Modified: branches/opendylan-melange/melange/c-exports.dylan
==============================================================================
--- branches/opendylan-melange/melange/c-exports.dylan (original)
+++ branches/opendylan-melange/melange/c-exports.dylan Tue Apr 24 22:37:25 2007
@@ -42,10 +42,10 @@
define library melange-c
use dylan;
use common-dylan;
+ use big-integers;
use string-extensions;
use collection-extensions;
use regular-expressions;
- use table-extensions;
use system;
use io;
@@ -104,9 +104,7 @@
define module multistring-match
use common-dylan;
export
-#if (~mindy)
multistring-checker-definer, multistring-positioner-definer,
-#endif
make-multistring-positioner, make-multistring-checker
end module multistring-match;
@@ -115,6 +113,7 @@
exclude: { format, format-to-string,
string-to-integer, integer-to-string, split, position };
use format;
+ use big-integers;
use table-extensions;
use self-organizing-list;
use string-conversions;
@@ -150,8 +149,9 @@
define module portability
use dylan;
use c-lexer, import: {include-path, *handle-c++-comments*, *framework-paths*};
- use system, import: {getenv}; // win32 only
- use regular-expressions; // win32 only
+ use operating-system, import: {environment-variable}; // win32 only
+ use regular-expressions; // win32 only
+ use common-extensions;
export
$default-defines,
$enum-size,
@@ -165,7 +165,7 @@
define module c-parse
use common-dylan, exclude: { format-to-string };
- use extensions, import: { <extended-integer> };
+ use big-integers;
use self-organizing-list;
use c-lexer;
use streams;
@@ -190,7 +190,8 @@
define module c-declarations
use common-dylan, exclude: { format-to-string, split };
- use table-extensions, rename: { table => make-table };
+ use big-integers;
+ use dylan-extensions;
use regular-expressions;
use streams;
use file-system;
Modified: branches/opendylan-melange/melange/c-lexer-cpp.dylan
==============================================================================
--- branches/opendylan-melange/melange/c-lexer-cpp.dylan (original)
+++ branches/opendylan-melange/melange/c-lexer-cpp.dylan Tue Apr 24 22:37:25 2007
@@ -76,7 +76,7 @@
define method file-is-header?(path :: <pathname>)
=> (header? :: <boolean>)
let path = as(<file-system-locator>, path);
- path.file-exists? & path.link-target.file-type = #"file";
+ path.file-exists? & path.file-type = #"file";
end;
// These routines support finding frameworks at run time
@@ -337,14 +337,7 @@
define /* exported */ function file-in-include-path (name :: <string>,
#key skip-to)
=> (full-name :: false-or(<string>));
-
- #if (MacOS)
- // Convert UNIX paths to Mac paths
- name := regexp-replace( name, "\\.\\./", "::" );
- name := regexp-replace( name, "\\./", ":" );
- name := regexp-replace( name, "/", ":" );
- #endif
-
+
if (first(name) == '/')
if(name.file-is-header?) name else #f end;
else
@@ -361,15 +354,7 @@
for (dir in search-path)
block ()
- #if (MacOS)
- let full-name = if( (dir ~= "") & (dir ~= ":") )
- concatenate(dir, ":", name);
- else
- name;
- end if;
- #else
let full-name = concatenate(dir, "/", name);
- #endif
if(full-name.file-is-header?) return(full-name) end;
end block;
finally
@@ -455,11 +440,7 @@
end: quote-end - 1);
let absolute-name = "";
// if (name is not an absolute path) [drive/UNC optional on win32 systems]
-#if (compiled-for-win32)
if (regexp-position(name, "((.:)|\\\\)?(\\\\|/)"))
-#else
- if (first(name) == '/')
-#endif
absolute-name := name;
else
// Turn the a relative pathname into an absolute pathname by
@@ -473,15 +454,7 @@
// again, I suspect Melange will have crapped out long
// before now if a user tried that.
absolute-name := regexp-replace(state.file-name,
- #if (compiled-for-x86-win32)
"[^\\\\/]+$",
- #else
- #if (MacOS)
- "[^:]+$",
- #else
- "[^/]+$",
- #endif
- #endif
name);
end if;
@@ -631,19 +604,10 @@
// = make-regexp-positioner("^#[ \t]*(define|undef|include|ifdef|ifndef|if"
// "|else|elif|line|endif|error|pragma)\\b",
// byte-characters-only: #t, case-sensitive: #t);
-#if (~mindy)
define multistring-checker preprocessor-match
("define", "undef", "include", "include_next", "ifdef", "ifndef", "if",
"else", "elif", "line", "endif", "error", "warning", "pragma");
define multistring-positioner do-skip-matcher("#", "/*");
-#else
-define constant preprocessor-match
- = make-multistring-checker("define", "undef", "include", "include_next",
- "ifdef", "ifndef", "if", "else", "elif", "line",
- "endif", "error", "warning", "pragma");
-define constant do-skip-matcher
- = make-multistring-positioner("#", "/*");
-#endif
//define constant do-skip-matcher
// = make-regexp-positioner("#|/\\*",
Modified: branches/opendylan-melange/melange/c-lexer.dylan
==============================================================================
--- branches/opendylan-melange/melange/c-lexer.dylan (original)
+++ branches/opendylan-melange/melange/c-lexer.dylan Tue Apr 24 22:37:25 2007
@@ -172,7 +172,6 @@
// Specific token types
//----------------------------------------------------------------------
-#if (~mindy)
define macro token-definer
{ define token ?:name :: ?super:expression = ?value:expression }
=> { define class ?name (?super)
@@ -274,269 +273,6 @@
define /* exported */ token <macro-parse-token> :: <token> = 79;
define /* exported */ token <cpp-parse-token> :: <token> = 80;
define /* exported */ token <machine-token> :: <token> = 81;
-#else
-// The mindy declarations have to be a lot clumsier since we don't have macros.
-
-// Magic tokens
-define class <eof-token> (<simple-token>)
- inherited slot token-id = 0;
-end class;
-define class <error-token> (<simple-token>)
- inherited slot token-id = 1;
-end class;
-define class <begin-include-token> (<simple-token>)
- inherited slot token-id = 2;
-end class;
-define class <end-include-token> (<ei-token>)
- inherited slot token-id = 3;
-end class;
-define class <identifier-token> (<name-token>)
- inherited slot token-id = 4;
-end class;
-define class <type-name-token> (<name-token>)
- inherited slot token-id = 5;
-end class;
-// literals
-define class <integer-token> (<literal-token>)
- inherited slot token-id = 6;
-end class;
-define class <character-token> (<literal-token>)
- inherited slot token-id = 7;
-end class;
-define class <string-literal-token> (<literal-token>)
- inherited slot token-id = 8;
-end class;
-define class <cpp-token> (<literal-token>)
- inherited slot token-id = 9;
-end class;
-// A whole bunch of reserved words
-define class <struct-token> (<reserved-word-token>)
- inherited slot token-id = 10;
-end class;
-define class <typedef-token> (<reserved-word-token>)
- inherited slot token-id = 11;
-end class;
-define class <short-token> (<type-specifier-token>)
- inherited slot token-id = 12;
-end class;
-define class <long-token> (<type-specifier-token>)
- inherited slot token-id = 13;
-end class;
-define class <int-token> (<type-specifier-token>)
- inherited slot token-id = 14;
-end class;
-define class <char-token> (<type-specifier-token>)
- inherited slot token-id = 15;
-end class;
-define class <signed-token> (<type-specifier-token>)
- inherited slot token-id = 16;
-end class;
-define class <unsigned-token> (<type-specifier-token>)
- inherited slot token-id = 17;
-end class;
-define class <float-token> (<type-specifier-token>)
- inherited slot token-id = 18;
-end class;
-define class <double-token> (<type-specifier-token>)
- inherited slot token-id = 19;
-end class;
-// "const" and "volatile" will be preprocessed away by the cpp code. They
-// were being used in too many different odd places by various different
-// compilers.
-//
-// define class <const-token> (<reserved-word-token>) end class;
-// define class <volatile-token> (<reserved-word-token>) end class;
-define class <void-token> (<type-specifier-token>)
- inherited slot token-id = 20;
-end class;
-define class <inline-token> (<reserved-word-token>)
- inherited slot token-id = 21;
-end class;
-define class <extern-token> (<reserved-word-token>)
- inherited slot token-id = 22;
-end class;
-define class <static-token> (<reserved-word-token>)
- inherited slot token-id = 23;
-end class;
-define class <auto-token> (<reserved-word-token>)
- inherited slot token-id = 24;
-end class;
-define class <register-token> (<reserved-word-token>)
- inherited slot token-id = 25;
-end class;
-define class <dummy-token> (<reserved-word-token>)
- inherited slot token-id = 26;
-end class;
-define class <union-token> (<reserved-word-token>)
- inherited slot token-id = 27;
-end class;
-define class <enum-token> (<reserved-word-token>)
- inherited slot token-id = 28;
-end class;
-define class <constant-token> (<reserved-word-token>)
- inherited slot token-id = 29;
-end class;
-define class <mul-assign-token> (<reserved-word-token>)
- inherited slot token-id = 30;
-end class;
-define class <div-assign-token> (<reserved-word-token>)
- inherited slot token-id = 31;
-end class;
-define class <mod-assign-token> (<reserved-word-token>)
- inherited slot token-id = 32;
-end class;
-define class <add-assign-token> (<reserved-word-token>)
- inherited slot token-id = 33;
-end class;
-define class <sub-assign-token> (<reserved-word-token>)
- inherited slot token-id = 34;
-end class;
-define class <left-assign-token> (<reserved-word-token>)
- inherited slot token-id = 35;
-end class;
-define class <right-assign-token> (<reserved-word-token>)
- inherited slot token-id = 36;
-end class;
-define class <and-assign-token> (<reserved-word-token>)
- inherited slot token-id = 37;
-end class;
-define class <xor-assign-token> (<reserved-word-token>)
- inherited slot token-id = 38;
-end class;
-define class <or-assign-token> (<reserved-word-token>)
- inherited slot token-id = 39;
-end class;
-// A whole bunch of puctuation
-define class <ellipsis-token> (<punctuation-token>)
- inherited slot token-id = 40;
-end class;
-define class <sizeof-token> (<punctuation-token>)
- inherited slot token-id = 41;
-end class;
-define class <dec-op-token> (<punctuation-token>)
- inherited slot token-id = 42;
-end class;
-define class <inc-op-token> (<punctuation-token>)
- inherited slot token-id = 43;
-end class;
-define class <ptr-op-token> (<punctuation-token>)
- inherited slot token-id = 44;
-end class;
-define class <semicolon-token> (<punctuation-token>)
- inherited slot token-id = 45;
-end class;
-define class <comma-token> (<punctuation-token>)
- inherited slot token-id = 46;
-end class;
-define class <dot-token> (<punctuation-token>)
- inherited slot token-id = 47;
-end class;
-define class <lparen-token> (<punctuation-token>)
- inherited slot token-id = 48;
-end class;
-define class <rparen-token> (<punctuation-token>)
- inherited slot token-id = 49;
-end class;
-define class <lbracket-token> (<punctuation-token>)
- inherited slot token-id = 50;
-end class;
-define class <rbracket-token> (<punctuation-token>)
- inherited slot token-id = 51;
-end class;
-define class <ampersand-token> (<punctuation-token>)
- inherited slot token-id = 52;
-end class;
-define class <star-token> (<punctuation-token>)
- inherited slot token-id = 53;
-end class;
-define class <carat-token> (<punctuation-token>)
- inherited slot token-id = 54;
-end class;
-define class <bar-token> (<punctuation-token>)
- inherited slot token-id = 55;
-end class;
-define class <percent-token> (<punctuation-token>)
- inherited slot token-id = 56;
-end class;
-define class <slash-token> (<punctuation-token>)
- inherited slot token-id = 57;
-end class;
-define class <plus-token> (<punctuation-token>)
- inherited slot token-id = 58;
-end class;
-define class <minus-token> (<punctuation-token>)
- inherited slot token-id = 59;
-end class;
-define class <tilde-token> (<punctuation-token>)
- inherited slot token-id = 60;
-end class;
-define class <bang-token> (<punctuation-token>)
- inherited slot token-id = 61;
-end class;
-define class <lt-token> (<punctuation-token>)
- inherited slot token-id = 62;
-end class;
-define class <gt-token> (<punctuation-token>)
- inherited slot token-id = 63;
-end class;
-define class <question-token> (<punctuation-token>)
- inherited slot token-id = 64;
-end class;
-define class <colon-token> (<punctuation-token>)
- inherited slot token-id = 65;
-end class;
-define class <eq-op-token> (<punctuation-token>)
- inherited slot token-id = 66;
-end class;
-define class <le-op-token> (<punctuation-token>)
- inherited slot token-id = 67;
-end class;
-define class <ge-op-token> (<punctuation-token>)
- inherited slot token-id = 68;
-end class;
-define class <ne-op-token> (<punctuation-token>)
- inherited slot token-id = 69;
-end class;
-define class <and-op-token> (<punctuation-token>)
- inherited slot token-id = 70;
-end class;
-define class <or-op-token> (<punctuation-token>)
- inherited slot token-id = 71;
-end class;
-define class <pound-pound-token> (<punctuation-token>)
- inherited slot token-id = 72;
-end class;
-define class <left-op-token> (<punctuation-token>)
- inherited slot token-id = 73;
-end class;
-define class <right-op-token> (<punctuation-token>)
- inherited slot token-id = 74;
-end class;
-define class <assign-token> (<punctuation-token>)
- inherited slot token-id = 75;
-end class;
-define class <lcurly-token> (<punctuation-token>)
- inherited slot token-id = 76;
-end class;
-define class <rcurly-token> (<punctuation-token>)
- inherited slot token-id = 77;
-end class;
-// "Magic" tokens which provide alternate entry points to the parser
-define class <alien-name-token> (<token>)
- inherited slot token-id = 78;
-end class;
-define class <macro-parse-token> (<token>)
- inherited slot token-id = 79;
-end class;
-define class <cpp-parse-token> (<token>)
- inherited slot token-id = 80;
-end class;
-// An extra token to handle Solaris's "#machine(foo)" construct
-define class <machine-token> (<token>)
- inherited slot token-id = 81;
-end class;
-
-#endif
//----------------------------------------------------------------------
// Support code
@@ -573,7 +309,7 @@
// Integer tokens can be in one of three different radices. Figure out which
// and then compute an integer value.
//
-define method value (token :: <integer-token>) => (result :: <abstract-integer>);
+define method value (token :: <integer-token>) => (result :: <integer>);
let string = token.string-value;
// Strip trailing markers from string.
while (member?(string.last, "uUlL"))
@@ -581,15 +317,32 @@
end while;
case
- string.first ~= '0' => string-to-integer(string);
+ string.first ~= '0' => my-string-to-integer(string);
string.size == 1 => 0;
string.second.digit? =>
- string-to-integer(copy-sequence(string, start: 1), base: 8);
+ my-string-to-integer(copy-sequence(string, start: 1), base: 8);
otherwise =>
- string-to-integer(copy-sequence(string, start: 2), base: 16);
+ my-string-to-integer(copy-sequence(string, start: 2), base: 16);
end case;
end method value;
+define method my-string-to-integer (string :: <sequence>, #key base = 10)
+ => (int :: <integer>);
+ let number = 0;
+ let sign = if (string[0] == '-') -1 else 1 end if;
+ let start-index = if (sign = -1) 1 else 0 end if;
+ for (i from start-index below string.size)
+ let digit = digit-to-integer(string[i]);
+ if (digit >= base)
+ error("\"%s\" isn't in base %d\n", string, base);
+ else
+ number := number * base + digit;
+ end if;
+ end for;
+ sign * number;
+end method my-string-to-integer;
+
+
// Both string and character literals allow you to use '\\' to get certain
// non-alphanumeric characters. This routine translates the second character
// of such a sequence into the appropriate "escaped character".
@@ -706,149 +459,7 @@
//
define constant $long-string-component-size = 16384;
-#if (~mindy)
define constant <long-byte-string> = <byte-string>;
-#else
-// <long-byte-string> -- private class.
-//
-// This class represents arbitrary length strings of <byte-character>. We
-// introduce it because Mindy cannot support <byte-string>s above a certain
-// length. It is also an interesting test for built in assumptions concerning
-// strings.
-//
-define sealed class <long-byte-string> (<string>, <vector>)
- sealed slot size :: <integer> = 0, init-keyword: #"size";
- slot components :: <simple-object-vector> /* of <byte-string> */ = #[];
-end class <long-byte-string>;
-
-define sealed inline method initialize
- (value :: <long-byte-string>, #key fill = ' ')
- if (value.size > 0)
- let (max-component, final-size)
- = floor/(value.size, $long-string-component-size);
- value.components := make(<simple-object-vector>, size: max-component + 1);
- for (i from 0 below max-component)
- value.components[i] := make(<byte-string>,
- size: $long-string-component-size,
- fill: fill);
- end for;
- value.components[max-component]
- := make(<byte-string>, size: final-size, fill: fill);
- end if;
-end method initialize;
-
-// type-for-copy -- method on imported generic.
-//
-// We copy <long-byte-string>s as <byte-string>s because we will want to pass
-// pieces of the string out to restrictive functions such as "write" and
-// "format". Ideally, these should not be so narrow-minded.
-//
-define sealed inline method type-for-copy
- (string :: <long-byte-string>) => (result :: <type>);
- <byte-string>;
-end method type-for-copy;
-
-// copy-sequence -- method on imported generic.
-//
-// Relying on the "standard" definition of copy-sequence makes melange run 20
-// times slower. It's worth spending a few lines on a 20-fold speedup.
-//
-define sealed method copy-sequence
- (vector :: <long-byte-string>, #key start :: <integer> = 0, end: last)
- => (result :: <byte-string>);
- let last :: <integer> = last | size(vector);
- let sz :: <integer> = last - start;
- let (start-component, start-index)
- = floor/(start, $long-string-component-size);
- if (start-index + sz < $long-string-component-size)
- let subseq :: <byte-string> = vector.components[start-component];
- copy-sequence(subseq, start: start-index, end: start-index + sz);
- else
- let result :: <byte-string> = make(<byte-string>, size: sz);
- for (from-index :: <integer> from start below last,
- to-index :: <integer> from 0)
- element(result, to-index) := element(vector, from-index);
- end for;
- result;
- end if;
-end method copy-sequence;
-
-define sealed inline method element
- (string :: <long-byte-string>, key :: <integer>,
- #key default = $not-supplied)
- => (result :: <byte-character>);
- if (key >= 0 & key < string.size)
- let (component, index) = floor/(key, $long-string-component-size);
- let substr :: <byte-string> = string.components[component];
- substr[index];
- elseif (default == $not-supplied)
- error("No such element in %=: %=", string, key);
- else
- default;
- end if;
-end method element;
-
-define sealed inline method element-setter
- (value :: <byte-character>, string :: <long-byte-string>, key :: <integer>)
- => (value :: <byte-character>);
- if (key >= 0 & key < string.size)
- let (component, index) = floor/(key, $long-string-component-size);
- let substr :: <byte-string> = string.components[component];
- substr[index] := value;
- else
- error("No such element in %=: %=", string, key);
- end if;
-end method element-setter;
-
-// forward-iteration-protocol -- method on imported generic.
-//
-// This method is identical to the one in "array.dylan", except that it
-// is more tightly specialized to a single sealed class. If you need to
-// make a general change, you should probably grep for "outlined-iterator"
-// and change all matching locations.
-//
-define inline method forward-iteration-protocol
- (array :: <long-byte-string>)
- => (initial-state :: <integer>,
- limit :: <integer>,
- next-state :: <function>,
- finished-state? :: <function>,
- current-key :: <function>,
- current-element :: <function>,
- current-element-setter :: <function>,
- copy-state :: <function>);
- values(0,
- array.size,
- method (array :: <long-byte-string>, state :: <integer>)
- => new-state :: <integer>;
- state + 1;
- end,
- method (array :: <long-byte-string>, state :: <integer>,
- limit :: <integer>)
- => done? :: <boolean>;
- // We use >= instead of == so that the constraint propagation
- // stuff can tell that state is < limit if this returns #f.
- state >= limit;
- end,
- method (array :: <long-byte-string>, state :: <integer>)
- => key :: <integer>;
- state;
- end,
- method (array :: <long-byte-string>, state :: <integer>)
- => element :: <object>;
- element(array, state);
- end,
- method (new-value :: <object>, array :: <long-byte-string>,
- state :: <integer>)
- => new-value :: <object>;
- element(array, state) := new-value;
- end,
- method (array :: <long-byte-string>, state :: <integer>)
- => state-copy :: <integer>;
- state;
- end);
-end;
-#endif
//========================================================================
// "Simple" operations on tokenizers
@@ -1168,22 +779,11 @@
end if;
end function try-identifier;
-#if (~mindy)
define multistring-checker match-punctuation
("-=", "*=", "/=", "%=", "+=", "<=", ">=", "&=", "^=", "|=", "==", "!=",
"++", "--", "->", "...", ">>", ">>=", "<<", "<<=", "||", "&&", "##",
";", ",", "(", ")", ".", "&", "*", "+", "~", "!", "/", "%", "<", ">", "^",
"|", "?", ":", "=", "{", "}", "-", "[", "]");
-#else
-define constant match-punctuation
- = make-multistring-checker("-=", "*=", "/=", "%=", "+=", "<=", ">=", "&=",
- "^=", "|=", "==", "!=",
- "++", "--", "->", "...", ">>", ">>=", "<<",
- "<<=", "||", "&&", "##",
- ";", ",", "(", ")", ".", "&", "*", "+", "~",
- "!", "/", "%", "<", ">", "^", "|", "?", ":",
- "=", "{", "}", "-", "[", "]");
-#endif
// Attempts to match "punctuation". Returns a token if the match is succesful
// and #f otherwise.
@@ -1207,12 +807,7 @@
//
define /* xported */ variable *handle-c++-comments* :: <boolean> = #f;
-#if (~mindy)
define multistring-checker comment-matcher("/*", "//", "\\\n", "\\\r\n");
-#else
-define constant comment-matcher
- = make-multistring-checker("/*", "//", "\\\n", "\\\r\n");
-#endif
// Skip over whitespace characters (including newlines) and comments.
//
Modified: branches/opendylan-melange/melange/exports.dylan
==============================================================================
--- branches/opendylan-melange/melange/exports.dylan (original)
+++ branches/opendylan-melange/melange/exports.dylan Tue Apr 24 22:37:25 2007
@@ -80,7 +80,6 @@
define library melange
use common-dylan;
- use table-extensions;
use string-extensions;
use collection-extensions;
use regular-expressions;
@@ -127,7 +126,6 @@
define module int-parse
use common-dylan, exclude: { format-to-string, position };
- use table-extensions;
use self-organizing-list;
use c-lexer, import: {include-path, file-in-include-path};
use streams;
@@ -155,7 +153,6 @@
define module define-interface
// From Dylan
use common-dylan, exclude: { format-to-string, split, position };
- use table-extensions;
/*
use %hash-tables;
#if (~mindy)
Modified: branches/opendylan-melange/melange/int-lexer.dylan
==============================================================================
--- branches/opendylan-melange/melange/int-lexer.dylan (original)
+++ branches/opendylan-melange/melange/int-lexer.dylan Tue Apr 24 22:37:25 2007
@@ -154,7 +154,6 @@
define abstract class <literal-token> (<token>) end class;
define abstract class <boolean-token> (<literal-token>) end class;
-#if (~mindy)
define macro token-definer
{ define token ?:name :: ?super:expression = ?value:expression }
=> { define class ?name (?super)
@@ -229,194 +228,6 @@
define token <lbrace-token> :: <punctuation-token> = 57;
define token <rbrace-token> :: <punctuation-token> = 58;
define token <arrow-token> :: <punctuation-token> = 59;
-#else
-define class <eof-token> (<simple-token>)
- inherited slot token-id = 0;
-end class;
-define class <error-token> (<simple-token>)
- inherited slot token-id = 1;
-end class;
-
-define class <integer-token> (<literal-token>)
- inherited slot token-id = 2;
-end class;
-define class <character-token> (<literal-token>)
- inherited slot token-id = 3;
-end class;
-define class <string-literal-token> (<literal-token>)
- inherited slot token-id = 4;
-end class;
-define class <symbol-literal-token> (<literal-token>)
- inherited slot token-id = 5;
-end class;
-define class <true-token> (<boolean-token>)
- inherited slot token-id = 6;
-end class;
-define class <false-token> (<boolean-token>)
- inherited slot token-id = 7;
-end class;
-
-define class <identifier-token> (<name-token>)
- inherited slot token-id = 8;
-end class;
-
-define class <define-token> (<reserved-word-token>)
- inherited slot token-id = 9;
-end class;
-define class <interface-token> (<reserved-word-token>)
- inherited slot token-id = 10;
-end class;
-define class <end-token> (<reserved-word-token>)
- inherited slot token-id = 11;
-end class;
-define class <include-token> (<reserved-word-token>)
- inherited slot token-id = 12;
-end class;
-define class <object-file-token> (<reserved-word-token>)
- inherited slot token-id = 13;
-end class;
-define class <mindy-inc-token> (<reserved-word-token>)
- inherited slot token-id = 14;
-end class;
-define class <define-macro-token> (<reserved-word-token>)
- inherited slot token-id = 15;
-end class;
-define class <undefine-token> (<reserved-word-token>)
- inherited slot token-id = 16;
-end class;
-define class <name-mapper-token> (<reserved-word-token>)
- inherited slot token-id = 17;
-end class;
-define class <import-token> (<reserved-word-token>)
- inherited slot token-id = 18;
-end class;
-define class <prefix-token> (<reserved-word-token>)
- inherited slot token-id = 19;
-end class;
-define class <exclude-token> (<reserved-word-token>)
- inherited slot token-id = 20;
-end class;
-define class <exclude-file-token> (<reserved-word-token>)
- inherited slot token-id = 21;
-end class;
-define class <rename-token> (<reserved-word-token>)
- inherited slot token-id = 22;
-end class;
-define class <mapping-token> (<reserved-word-token>)
- inherited slot token-id = 23;
-end class;
-define class <equate-token> (<reserved-word-token>)
- inherited slot token-id = 24;
-end class;
-define class <superclass-token> (<reserved-word-token>)
- inherited slot token-id = 25;
-end class;
-define class <all-token> (<reserved-word-token>)
- inherited slot token-id = 26;
-end class;
-define class <none-token> (<reserved-word-token>)
- inherited slot token-id = 27;
-end class;
-define class <all-recursive-token> (<reserved-word-token>)
- inherited slot token-id = 28;
-end class;
-define class <function-token> (<reserved-word-token>)
- inherited slot token-id = 29;
-end class;
-define class <map-result-token> (<reserved-word-token>)
- inherited slot token-id = 30;
-end class;
-define class <equate-result-token> (<reserved-word-token>)
- inherited slot token-id = 31;
-end class;
-define class <ignore-result-token> (<reserved-word-token>)
- inherited slot token-id = 32;
-end class;
-define class <map-argument-token> (<reserved-word-token>)
- inherited slot token-id = 33;
-end class;
-define class <equate-argument-token> (<reserved-word-token>)
- inherited slot token-id = 34;
-end class;
-define class <input-argument-token> (<reserved-word-token>)
- inherited slot token-id = 35;
-end class;
-define class <output-argument-token> (<reserved-word-token>)
- inherited slot token-id = 36;
-end class;
-define class <input-output-argument-token> (<reserved-word-token>)
- inherited slot token-id = 37;
-end class;
-define class <struct-token> (<reserved-word-token>)
- inherited slot token-id = 38;
-end class;
-define class <union-token> (<reserved-word-token>)
- inherited slot token-id = 39;
-end class;
-define class <pointer-token> (<reserved-word-token>)
- inherited slot token-id = 40;
-end class;
-define class <constant-token> (<reserved-word-token>)
- inherited slot token-id = 41;
-end class;
-define class <variable-token> (<reserved-word-token>)
- inherited slot token-id = 42;
-end class;
-define class <getter-token> (<reserved-word-token>)
- inherited slot token-id = 43;
-end class;
-define class <setter-token> (<reserved-word-token>)
- inherited slot token-id = 44;
-end class;
-define class <read-only-token> (<reserved-word-token>)
- inherited slot token-id = 45;
-end class;
-define class <seal-token> (<reserved-word-token>)
- inherited slot token-id = 46;
-end class;
-define class <seal-functions-token> (<reserved-word-token>)
- inherited slot token-id = 47;
-end class;
-define class <sealed-token> (<reserved-word-token>)
- inherited slot token-id = 48;
-end class;
-define class <open-token> (<reserved-word-token>)
- inherited slot token-id = 49;
-end class;
-define class <inline-token> (<reserved-word-token>)
- inherited slot token-id = 50;
-end class;
-define class <value-token> (<reserved-word-token>)
- inherited slot token-id = 51;
-end class;
-define class <function-type-token> (<reserved-word-token>)
- inherited slot token-id = 52;
-end class;
-define class <callback-maker-token> (<reserved-word-token>)
- inherited slot token-id = 53;
-end class;
-define class <callout-function-token> (<reserved-word-token>)
- inherited slot token-id = 54;
-end class;
-
-// A whole bunch of punctuation
-
-define class <semicolon-token> (<punctuation-token>)
- inherited slot token-id = 55;
-end class;
-define class <comma-token> (<punctuation-token>)
- inherited slot token-id = 56;
-end class;
-define class <lbrace-token> (<punctuation-token>)
- inherited slot token-id = 57;
-end class;
-define class <rbrace-token> (<punctuation-token>)
- inherited slot token-id = 58;
-end class;
-define class <arrow-token> (<punctuation-token>)
- inherited slot token-id = 59;
-end class;
-#endif
define sealed generic string-value (token :: <token>) => (result :: <string>);
define sealed generic value (token :: <token>) => (result :: <object>);
Modified: branches/opendylan-melange/melange/interface.dylan
==============================================================================
--- branches/opendylan-melange/melange/interface.dylan (original)
+++ branches/opendylan-melange/melange/interface.dylan Tue Apr 24 22:37:25 2007
@@ -498,7 +498,7 @@
full-names[index] := full-name;
end for;
- let defines = make(<equal-table>);
+ let defines = make(<string-table>);
for (i from 0 below $default-defines.size by 2)
defines[$default-defines[i]] := $default-defines[i + 1];
end for;
@@ -887,19 +887,13 @@
end case;
// Handle -I.
- #if (compiled-for-win32)
// translate \ to /, because \ does bad things when inside a
// string literal, like c-include("d:\foo\bar.h")
- include-dirs := map(rcurry(translate, "\\\\", "/"), include-dirs);
- #endif
+ include-dirs := map(rcurry(translate, "\\\\", "/"), include-dirs);
for (dir in include-dirs)
push(include-path, dir);
end for;
- #if (MacOS)
- push(include-path, "");
- #else
- push(include-path, "./");
- #endif
+ push(include-path, "./");
// Handle --framework.
for (dir in framework-dirs)
Modified: branches/opendylan-melange/melange/melange.lid
==============================================================================
--- branches/opendylan-melange/melange/melange.lid (original)
+++ branches/opendylan-melange/melange/melange.lid Tue Apr 24 22:37:25 2007
@@ -1,10 +1,7 @@
library: melange
-unique-id-base: 12000
-executable: melange
-
-exports.dylan
-int-parse.dylan
-interface.dylan
-name-map.dylan
-int-lexer.dylan
-run.dylan
+files: exports
+ int-parse
+ interface
+ name-map
+ int-lexer
+ run
Modified: branches/opendylan-melange/melange/multistring.dylan
==============================================================================
--- branches/opendylan-melange/melange/multistring.dylan (original)
+++ branches/opendylan-melange/melange/multistring.dylan Tue Apr 24 22:37:25 2007
@@ -59,7 +59,6 @@
//
//----------------------------------------------------------------------
-#if (~mindy)
// multistring-checker-definer -- exported macro.
//
// By implementing this as a macro, we get better type checking and dispatch.
@@ -114,7 +113,6 @@
{ } => { }
{ inline } => { inline }
end macro;
-#endif
// make-multistring-positioner -- exported function.
//
Modified: branches/opendylan-melange/melange/win32-vc-decl.lid
==============================================================================
--- branches/opendylan-melange/melange/win32-vc-decl.lid (original)
+++ branches/opendylan-melange/melange/win32-vc-decl.lid Tue Apr 24 22:37:25 2007
@@ -1,15 +1,14 @@
library: melange-c
unique-id-base: 10000
-
-c-exports.dylan
-source-location.dylan
-parse-conditions.dylan
-multistring.dylan
-c-lexer.dylan
-c-lexer-cpp.dylan
-win32-vc-portability.dylan
-c-parse.dylan
-alignment.dylan
-c-decl-state.dylan
-c-decl-write.dylan
-c-decl.dylan
+files: c-exports
+ source-location
+ parse-conditions
+ multistring
+ c-lexer
+ c-lexer-cpp
+ win32-vc-portability
+ c-parse
+ alignment
+ c-decl-state
+ c-decl-write
+ c-decl
Modified: branches/opendylan-melange/melange/win32-vc-portability.dylan
==============================================================================
--- branches/opendylan-melange/melange/win32-vc-portability.dylan (original)
+++ branches/opendylan-melange/melange/win32-vc-portability.dylan Tue Apr 24 22:37:25 2007
@@ -72,18 +72,20 @@
"__stdcall", "",
"inline", "",
"_inline", "",
- "__inline", ""];
+ "__inline", "",
+ "__extension__", "",
+ "__builtin_va_list", "void*"];
// Set up the search path for .h files
begin
- let include-env-variable = getenv("include") | "";
+ let include-env-variable = environment-variable("include") | "";
// Translate backslashes to front slashes, because if we try to use
// backslashes in string literals (esp. inside of a "c-include"
// statement), it does bad things.
let include-env-variable = translate(include-env-variable, "\\\\", "/");
- let (#rest include-dirs) = split(";", include-env-variable);
+ let include-dirs = split(include-env-variable, ';');
for (dir in include-dirs)
push-last(include-path, dir);
end for;
Modified: branches/opendylan-melange/parsergen/Parsergen.lid
==============================================================================
--- branches/opendylan-melange/parsergen/Parsergen.lid (original)
+++ branches/opendylan-melange/parsergen/Parsergen.lid Tue Apr 24 22:37:25 2007
@@ -2,7 +2,6 @@
unique-id-base: 5000
executable: parsergen
entry-point: parsergen:%main
-
-library.dylan
-lisp-read.dylan
-parsergen.dylan
+files: library
+ lisp-read
+ parsergen
Modified: branches/opendylan-melange/parsergen/library.dylan
==============================================================================
--- branches/opendylan-melange/parsergen/library.dylan (original)
+++ branches/opendylan-melange/parsergen/library.dylan Tue Apr 24 22:37:25 2007
@@ -28,6 +28,7 @@
//======================================================================
define library parsergen
+ use common-dylan;
use dylan;
use io;
use system;
@@ -36,11 +37,10 @@
end library parsergen;
define module lisp-read
- use dylan;
+ use common-dylan;
+ use dylan-extensions;
use streams;
use print;
- use extensions;
- use character-type;
use standard-io;
export
<token>, <identifier>, <string-literal>, <character-literal>,
@@ -50,14 +50,13 @@
end module lisp-read;
define module parsergen
- use dylan;
- use extensions;
+ use common-dylan;
+ use dylan-extensions;
use streams;
use print;
use format;
use standard-io;
use file-system;
use regular-expressions;
- use %hash-tables;
use lisp-read, import: { lisp-read };
end module parsergen;
Modified: branches/opendylan-melange/parsergen/lisp-read.dylan
==============================================================================
--- branches/opendylan-melange/parsergen/lisp-read.dylan (original)
+++ branches/opendylan-melange/parsergen/lisp-read.dylan Tue Apr 24 22:37:25 2007
@@ -44,6 +44,21 @@
// don't really know Lisp very well. (Token classes like
// <macro-thingy> ought to give that away pretty quick)
+// isalnum
+//
+define inline function alphanumeric? (c :: <character>) => answer :: <boolean>;
+ (c >= 'a' & c <= 'z') | (c >= 'A' & c <= 'Z') | (c >= '0' & c <= '9');
+end function alphanumeric?;
+
+// isspace
+//
+define inline function whitespace? (c :: <character>) => answer :: <boolean>;
+ select (c)
+ ' ', '\t', '\n', '\f', '\r' => #t;
+ // Space, tab, newline, formfeed, carriage return
+ otherwise => #f;
+ end select;
+end function whitespace?;
define abstract class <token> (<object>)
@@ -252,11 +267,6 @@
// form before the Dylan version of the form. This, of course, is
// better than not translating the comment at all, which is our
// other choice...
- #if (lisp2dylan)
- write(*standard-output*, "/" "/"); // If I type "//", it screws up
- // the emacs mode
- write-line(*standard-output*, line);
- #endif
end method lex-comment;
define method lex-string (input :: <stream>) => string :: <string-literal>;
Modified: branches/opendylan-melange/parsergen/parsergen.dylan
==============================================================================
--- branches/opendylan-melange/parsergen/parsergen.dylan (original)
+++ branches/opendylan-melange/parsergen/parsergen.dylan Tue Apr 24 22:37:25 2007
@@ -703,7 +703,7 @@
define function add-action (state :: <state>, action :: <list>) => ();
local method add-token-action
(token :: <token>, action-kind :: <action-kind>,
- action-datum :: type-union(<false>, <state>, <production>))
+ action-datum :: type-union(singleton(#f), <state>, <production>))
// ### I'm not sure <state> is a possibility, but <false> and
// <production> certainly are
let old-action = find(token, state.state-actions, key: head);
@@ -927,9 +927,6 @@
type-union(<symbol>, <integer>, <string>) =>
print(thing, ofile);
end select;
-#if (compiled-for-cygnus)
- force-output(ofile); // cygnus dies if the buffer gets too big
-#endif
end function dump-constant;
define function emit-production
@@ -991,9 +988,6 @@
format(ofile, " end);\n");
format(ofile, "end method production-%D;\n\n",
production.production-number);
-#if (compiled-for-cygnus)
- force-output(ofile);
-#endif
end function emit-production;
define function encode-actions (actions :: <list>, grammar :: <grammar>)
@@ -1030,9 +1024,6 @@
end;
format(ofile, "define constant $action-table\n"
" = #[");
-#if (compiled-for-cygnus)
- force-output(ofile);
-#endif
for (state in grammar.grammar-all-states, index from 0)
unless (index = state.state-number)
@@ -1102,9 +1093,6 @@
end method,
grammar.grammar-entry-points,
grammar.grammar-start-states);
-#if (compiled-for-cygnus)
- force-output(ofile);
-#endif
end function emit-parser;
@@ -1179,9 +1167,6 @@
new-line(file);
end;
end for;
-#if (compiled-for-cygnus)
- force-output(file);
-#endif
end function emit-log-file;
@@ -1197,9 +1182,6 @@
write-line(ofile, line);
end while;
end block;
-#if (compiled-for-cygnus)
- force-output(ofile);
-#endif
end function grovel-header;
define function parse-grammar (grammar :: <grammar>, ifile :: <stream>) => ();
@@ -1357,9 +1339,6 @@
write-line(ofile, line);
end while;
end block;
-#if (compiled-for-cygnus)
- force-output(ofile);
-#endif
end function grovel-trailer;
define function grovel-file
@@ -1408,7 +1387,7 @@
"\tIf no output-file is specified, output defaults to standard\n"
"\toutput. If no log-file is specified, a log is not outputted.\n");
force-output(*standard-error*);
- exit(exit-code: 1);
+ exit-application(1);
end if;
let input = args.first;
let output = if (args.size > 1) args.second else #f end if;
@@ -1416,7 +1395,7 @@
format(*standard-error*, "Creating parser...\n");
force-output(*standard-error*); // ### Do we need to force output on stderr?
grovel-file(input, output, log);
- exit(exit-code: 0);
+ exit-application(0);
end method main;
@@ -1490,3 +1469,5 @@
#f;
end block;
end function assoc;
+
+apply(main, application-name(), application-arguments());
More information about the chatter
mailing list