[Gd-chatter] r11145 - in trunk/src: d2c/compiler/main tools tools/refman
agent at gwydiondylan.org
agent at gwydiondylan.org
Thu Jan 25 03:01:58 CET 2007
Author: agent
Date: Thu Jan 25 03:01:54 2007
New Revision: 11145
Added:
trunk/src/d2c/compiler/main/Main-DU.lid (contents, props changed)
trunk/src/d2c/compiler/main/main-du-exports.dylan (contents, props changed)
trunk/src/tools/refman/
trunk/src/tools/refman/Makegen (contents, props changed)
trunk/src/tools/refman/TODO (contents, props changed)
trunk/src/tools/refman/main.dylan (contents, props changed)
trunk/src/tools/refman/refman-library.dylan (contents, props changed)
trunk/src/tools/refman/refman.dtd (contents, props changed)
trunk/src/tools/refman/refman.dylan (contents, props changed)
trunk/src/tools/refman/refman.lid (contents, props changed)
Modified:
trunk/src/d2c/compiler/main/Main.lid
trunk/src/d2c/compiler/main/Makegen
trunk/src/d2c/compiler/main/lid-mode-state.dylan
trunk/src/d2c/compiler/main/main-exports.dylan
trunk/src/d2c/compiler/main/single-file-mode-state.dylan
trunk/src/d2c/compiler/main/unit-info.dylan
trunk/src/tools/Makegen
Log:
Bug: 7341
refman tool, and compiler-main module to expose necessary bindings.
Added: trunk/src/d2c/compiler/main/Main-DU.lid
==============================================================================
--- (empty file)
+++ trunk/src/d2c/compiler/main/Main-DU.lid Thu Jan 25 03:01:54 2007
@@ -0,0 +1,6 @@
+library: compiler-main-du
+
+main-du-exports.dylan
+version.dylan
+file-locations.dylan
+unit-info.dylan
Modified: trunk/src/d2c/compiler/main/Main.lid
==============================================================================
--- trunk/src/d2c/compiler/main/Main.lid (original)
+++ trunk/src/d2c/compiler/main/Main.lid Thu Jan 25 03:01:54 2007
@@ -5,9 +5,6 @@
main-exports.dylan
progress-indicator.dylan
-file-locations.dylan
-version.dylan
-unit-info.dylan
main-unit-state.dylan
single-file-mode-state.dylan
lid-mode-state.dylan
Modified: trunk/src/d2c/compiler/main/Makegen
==============================================================================
--- trunk/src/d2c/compiler/main/Makegen (original)
+++ trunk/src/d2c/compiler/main/Makegen Thu Jan 25 03:01:54 2007
@@ -8,7 +8,7 @@
$GC_CFLAGS =~ s/\\/\\\\/g;
$GC_LIBS =~ s/\\/\\\\/g;
print FILELOC <<"EOF";
-Module: main
+Module: main-constants
Note: this file is generated by gen-makefile from Makegen
define constant \$default-dylan-dir = "$munged_destdir";
@@ -23,7 +23,7 @@
open(VERSION,">$srcdir/version.dylan")
|| die "cannot create version.dylan";
print VERSION <<"EOF";
-Module: main
+Module: main-constants
Note: this file is generated by gen-makefile from Makegen
define constant \$version = "$version";
@@ -54,6 +54,8 @@
. ' -L../../runtime/random'
. ' -L../../runtime/threads';
+do emit_library_rule('Main-DU', '$(BUILDROOT)/force.timestamp', '',
+ 'compile', 'install');
do emit_library_rule('Main', '$(BUILDROOT)/force.timestamp', '',
'compile', 'install');
Modified: trunk/src/d2c/compiler/main/lid-mode-state.dylan
==============================================================================
--- trunk/src/d2c/compiler/main/lid-mode-state.dylan (original)
+++ trunk/src/d2c/compiler/main/lid-mode-state.dylan Thu Jan 25 03:01:54 2007
@@ -305,7 +305,7 @@
cc-flags := concatenate(cc-flags, " ", getenv("CCOPTS")|"");
state.unit-cback-unit := make(<unit-state>, prefix: state.unit-mprefix);
- state.unit-other-cback-units := map-as(<simple-object-vector>, unit-name,
+ state.unit-other-cback-units := map-as(<simple-object-vector>, unit-info-name,
*units*);
let makefile-name = format-to-string("cc-%s-files.mak", state.unit-mprefix);
@@ -611,7 +611,7 @@
for (unit in *units*)
format(stream,
"{ extern void %s_Library_init(descriptor_t*); %s_Library_init(sp); }\n",
- string-to-c-name(unit.unit-name), string-to-c-name(unit.unit-name));
+ string-to-c-name(unit.unit-info-name), string-to-c-name(unit.unit-info-name));
end;
if (entry-function-name)
format(stream,
@@ -663,7 +663,7 @@
:= stringify(' ', unit.unit-linker-options, linker-args);
end if;
unless (unit == state.unit-unit-info)
- add-archive(concatenate(unit.unit-name, "-dylan"));
+ add-archive(concatenate(unit.unit-info-name, "-dylan"));
end unless;
end;
@@ -701,7 +701,7 @@
for (unit in *units*)
unless (unit == state.unit-unit-info)
- add-archive(concatenate(unit.unit-name, "-dylan"));
+ add-archive(concatenate(unit.unit-info-name, "-dylan"));
end unless;
end;
Added: trunk/src/d2c/compiler/main/main-du-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/src/d2c/compiler/main/main-du-exports.dylan Thu Jan 25 03:01:54 2007
@@ -0,0 +1,63 @@
+module: dylan-user
+copyright: see below
+
+//======================================================================
+//
+// Copyright (c) 1995, 1996, 1997 Carnegie Mellon University
+// Copyright (c) 1998, 1999, 2000 Gwydion Dylan Maintainers
+// All rights reserved.
+//
+// Use and copying of this software and preparation of derivative
+// works based on this software are permitted, including commercial
+// use, provided that the following conditions are observed:
+//
+// 1. This copyright notice must be retained in full on any copies
+// and on appropriate parts of any derivative works.
+// 2. Documentation (paper or online) accompanying any system that
+// incorporates this software, or any part of it, must acknowledge
+// the contribution of the Gwydion Project at Carnegie Mellon
+// University, and the Gwydion Dylan Maintainers.
+//
+// This software is made available "as is". Neither the authors nor
+// Carnegie Mellon University make any warranty about the software,
+// its performance, or its conformity to any specification.
+//
+// Bug reports should be sent to <gd-bugs at gwydiondylan.org>; questions,
+// comments and suggestions are welcome at <gd-hackers at gwydiondylan.org>.
+// Also, see http://www.gwydiondylan.org/ for updates and documentation.
+//
+//======================================================================
+
+define library compiler-main-du
+ use dylan;
+ use common-dylan, import: { common-extensions };
+ use compiler-base, import: { od-format, compile-time-values };
+ export main-constants, main-unit-info;
+end;
+
+define module main-constants
+ use dylan;
+ export $version,
+ $bootstrap-counter,
+ $default-dylan-dir,
+ $default-dylan-user-dir,
+ $gc-libs,
+ $default-target-name
+end;
+
+define module main-unit-info
+ use dylan;
+ use common-extensions, import: { false-or };
+ use od-format, import: { add-make-dumper };
+ use compile-time-values, import: { *compiler-dispatcher* };
+ export <unit-info>,
+ *units*,
+ unit-info-name,
+ unit-info-name-setter,
+ undumped-objects,
+ extra-labels,
+ unit-linker-options,
+ undumped-objects-setter,
+ extra-labels-setter,
+ unit-linker-options-setter;
+end;
Modified: trunk/src/d2c/compiler/main/main-exports.dylan
==============================================================================
--- trunk/src/d2c/compiler/main/main-exports.dylan (original)
+++ trunk/src/d2c/compiler/main/main-exports.dylan Thu Jan 25 03:01:54 2007
@@ -45,6 +45,7 @@
use compiler-parser;
use compiler-cback;
use compiler-convert;
+ use compiler-main-du;
end;
define module progress-indicator
@@ -123,6 +124,8 @@
use definitions;
use platform;
use platform-constants;
+ use main-constants;
+ use main-unit-info;
use file-system;
use extensions, import: {key-exists?};
use command-processor;
Modified: trunk/src/d2c/compiler/main/single-file-mode-state.dylan
==============================================================================
--- trunk/src/d2c/compiler/main/single-file-mode-state.dylan (original)
+++ trunk/src/d2c/compiler/main/single-file-mode-state.dylan Thu Jan 25 03:01:54 2007
@@ -216,7 +216,7 @@
"void inits(descriptor_t *sp, int argc, char *argv[])\n{\n");
for (unit in *units*)
format(stream, "{ extern void %s_Library_init(descriptor_t*); %s_Library_init(sp); }\n",
- string-to-c-name(unit.unit-name), string-to-c-name(unit.unit-name));
+ string-to-c-name(unit.unit-info-name), string-to-c-name(unit.unit-info-name));
end;
format(stream, "}\n");
format(stream, "\nextern void real_main(int argc, char *argv[]);\n\n");
@@ -254,7 +254,7 @@
:= stringify(' ', unit.unit-linker-options, linker-args);
end if;
unless (unit == state.unit-unit-info)
- add-archive(concatenate(unit.unit-name, "-dylan"));
+ add-archive(concatenate(unit.unit-info-name, "-dylan"));
end unless;
end;
@@ -330,7 +330,7 @@
parse-and-finalize-library(state);
if (~ zero?(*errors*)) give-up(); end if;
state.unit-cback-unit := make(<unit-state>, prefix: state.unit-mprefix);
- state.unit-other-cback-units := map-as(<simple-object-vector>, unit-name,
+ state.unit-other-cback-units := map-as(<simple-object-vector>, unit-info-name,
*units*);
compile-file(state);
if (~ zero?(*errors*)) give-up(); end if;
Modified: trunk/src/d2c/compiler/main/unit-info.dylan
==============================================================================
--- trunk/src/d2c/compiler/main/unit-info.dylan (original)
+++ trunk/src/d2c/compiler/main/unit-info.dylan Thu Jan 25 03:01:54 2007
@@ -1,4 +1,4 @@
-module: main
+module: main-unit-info
copyright: see below
//======================================================================
@@ -49,6 +49,9 @@
define sealed domain make (singleton(<unit-info>));
define sealed domain initialize (<unit-info>);
+define constant unit-info-name = unit-name;
+define constant unit-info-name-setter = unit-name-setter;
+
define variable *units* :: <stretchy-vector> = make(<stretchy-vector>);
define method initialize (info :: <unit-info>, #next next-method, #key) => ();
Modified: trunk/src/tools/Makegen
==============================================================================
--- trunk/src/tools/Makegen (original)
+++ trunk/src/tools/Makegen Thu Jan 25 03:01:54 2007
@@ -12,6 +12,7 @@
'parsergen',
'melange',
'pidgin',
+ 'refman',
'shared-misc',
$system_dependent_misc
);
Added: trunk/src/tools/refman/Makegen
==============================================================================
--- (empty file)
+++ trunk/src/tools/refman/Makegen Thu Jan 25 03:01:54 2007
@@ -0,0 +1,41 @@
+$D2CFLAGS # added by update-libdirs
+ = $d2c_runtime
+ . ' -L../../common/collection-extensions'
+ . ' -L../../common/common-dylan'
+ . ' -L../../common/getopt'
+ . ' -L../../common/io'
+ . ' -L../../common/regular-expressions'
+ . ' -L../../common/string-ext'
+ . ' -L../../common/system'
+ . ' -L../../common/table-ext'
+ . ' -L../../d2c/runtime/random'
+ . ' -L../../d2c/runtime/threads'
+ . ' -L.';
+
+if ($features{'compiled_for_win32'}) {
+ $c_decl_lid = "win32-vc-decl";
+} elsif ($features{'compiled_for_hpux'}) {
+ $c_decl_lid = "hp-c-decl";
+} elsif ($features{'compiled_for_solaris'}) {
+ $c_decl_lid = "solaris-c-decl";
+} elsif ($features{'compiled_for_cygnus'}) {
+ $c_decl_lid = "cygnus-c-decl";
+} elsif ($features{'compiled_for_linux'}
+ || $features{'compiled_for_beos'}) {
+ $c_decl_lid = "linux-c-decl";
+} elsif ($features{'compiled_for_freebsd'}
+ || $features{'compiled_for_bsdi'}) { # best guess for bsdi
+ $c_decl_lid = "freebsd-c-decl";
+} elsif ($features{'compiled_for_netbsd'}) {
+ $c_decl_lid = "netbsd-c-decl";
+} elsif ($features{'compiled_for_openbsd'}) {
+ $c_decl_lid = "openbsd-c-decl";
+} elsif ($features{'compiled_for_darwin'}) {
+ $c_decl_lid = "macos-decl";
+} elsif ($features{'compiled_for_irix'}) {
+ $c_decl_lid = "irix-c-decl";
+} else {
+ &unknown_platform_error();
+};
+
+do emit_library_rule('refman', '', '', 'compile', 'install');
Added: trunk/src/tools/refman/TODO
==============================================================================
--- (empty file)
+++ trunk/src/tools/refman/TODO Thu Jan 25 03:01:54 2007
@@ -0,0 +1,37 @@
+This program has the following known issues.
+
+* The names given to functions' required arguments, #rest arguments, and
+ return values are not correct. For example, all required arguments are named
+ 'arg'. This is because the <signature> class does not provide these names,
+ and I don't know where else to get them.
+
+* It is not the most elegant of programs.
+
+
+Refman documentation in general should be improved in the following ways,
+which will probably require a new version of refman.dtd.
+
+* The current module should list its methods on other modules' general
+ functions.
+
+ For example, io:format defines print-message, an open generic method. Let's
+ say module B defines a print-message method, but does not itself export the
+ print-message name -- it does not need to. However, module B's print-message
+ *should* be included in its refman output.
+
+ This lets users of the module know that they can productively call
+ print-message on module B's classes; they don't have to write their own.
+ This also gives documenters a chance to note any special behaviors of
+ print-message (print-message won't have any special behaviors, but another
+ method might).
+
+* Required keywords and default values for optional keywords should be part of
+ the refman structure, not the descriptive text.
+
+* The refman <typedef>, <exceptiondef>, and <raises> tags should be put to
+ use. <typedef> tags should probably be used for situations where a type is
+ aliased to another type via "define constant". <exceptiondef> and <raises>
+ tags are a good idea, but should probably be expanded to cover recovery
+ protocols and the like.
+
+* The <macrodef> tag should be structured in some way.
Added: trunk/src/tools/refman/main.dylan
==============================================================================
--- (empty file)
+++ trunk/src/tools/refman/main.dylan Thu Jan 25 03:01:54 2007
@@ -0,0 +1,77 @@
+synopsis: This code performs set-up and includes main().
+author: Dustin Voss
+copyright: © 2007 Dustin Voss
+module: refman
+
+
+/// Arguments
+
+define argument-parser <my-arg-parser> ()
+ regular-arguments libnames;
+ option help?, "", "Help", long: "help", short: "h";
+ option libpaths, "", "Library paths", long: "libdir", short: "L",
+ kind: <repeated-parameter-option-parser>;
+ synopsis print-help,
+ usage: "refman [options] libnames...",
+ description:
+"Export a library or libraries to a refman-style XML document, sent to STDOUT."
+"\n"
+"libnames are library names (as in libname.lib.du).";
+end argument-parser;
+
+
+/// Main
+
+// Load requested libraries and kick off the process.
+define function main(name, arguments)
+
+ // Check arguments
+ let args = make(<my-arg-parser>);
+ parse-arguments(args, arguments);
+ if (args.help? | args.libnames.empty?)
+ print-help(args, *standard-output*);
+ exit-application(0);
+ end;
+
+ // Set up library search path if not specified.
+ let lib-paths =
+ if (args.libpaths.empty?)
+ list(".",
+ concatenate($default-dylan-user-dir, "/lib/dylan/",
+ $version, "/", $default-target-name, "/dylan-user"),
+ concatenate($default-dylan-dir, "/lib/dylan/", $version, "/",
+ $default-target-name));
+ else
+ args.libpaths;
+ end;
+ *data-unit-search-path* := map(curry(as, <directory-locator>), lib-paths);
+
+ // Prevent d2c from using stdout.
+ *debug-output* := make(<string-stream>, direction: #"output");
+
+ // Load libraries of interest.
+ let target-libraries = map(curry(as, <symbol>), args.libnames);
+ for (name in target-libraries)
+ block()
+ let lib = find-library(name, create: #t);
+ assure-loaded(lib);
+ exception (cond :: <format-string-condition>)
+ apply(format, *standard-error*, cond.condition-format-string,
+ cond.condition-format-arguments);
+ format(*standard-error*, "\n");
+ exit-application(1);
+ exception (cond :: <condition>)
+ format(*standard-error*, "Failed to load library %s:\n%s\n",
+ name, cond);
+ exit-application(1);
+ end;
+ end;
+
+ // Print out the XML.
+ format-out("%s\n", refman($Libraries, target-libraries));
+ exit-application(0);
+end function main;
+
+
+// Invoke our main() function.
+main(application-name(), application-arguments());
Added: trunk/src/tools/refman/refman-library.dylan
==============================================================================
--- (empty file)
+++ trunk/src/tools/refman/refman-library.dylan Thu Jan 25 03:01:54 2007
@@ -0,0 +1,58 @@
+module: dylan-user
+
+define library refman
+ use common-dylan,
+ import: { common-dylan };
+ use string-extensions,
+ import: { substring-search };
+ use io,
+ import: { format, format-out, standard-io, streams };
+ use getopt,
+ import: { getopt };
+ use system,
+ import: { locators };
+
+ // Compiler internal
+ // These libraries need to be used to initialize loaders for various ODF
+ // tags, but for the most part, we don't need to use any of their bindings.
+ use compiler-base;
+ use compiler-front;
+ use compiler-optimize;
+ use compiler-cback;
+ use compiler-main-du;
+ use compiler-convert;
+ use compiler-parser;
+ // use compiler-fer-transform;
+end library;
+
+define module refman
+ use common-dylan,
+ exclude: { format-to-string, direct-superclasses, direct-subclasses };
+ use substring-search;
+ use getopt;
+ use standard-io;
+ use format;
+ use format-out;
+ use streams;
+ use locators;
+
+ // Compiler internal
+ // We need to use bindings from these modules.
+ use common,
+ import: { *debug-output* };
+ use od-format,
+ import: { *data-unit-search-path* };
+ use variables;
+ use definitions;
+ use names;
+ use function-definitions;
+ use variable-definitions;
+ use signature-interface;
+ use define-constants-and-variables;
+ use define-classes;
+ use ctype;
+ use classes;
+ use macros;
+ use compile-time-values;
+ use main-constants;
+end module;
Added: trunk/src/tools/refman/refman.dtd
==============================================================================
Binary file. No diff available.
Added: trunk/src/tools/refman/refman.dylan
==============================================================================
--- (empty file)
+++ trunk/src/tools/refman/refman.dylan Thu Jan 25 03:01:54 2007
@@ -0,0 +1,414 @@
+synopsis: This code actually outputs the XML.
+author: Dustin Voss
+copyright: © 2007 Dustin Voss
+module: refman
+
+// tlf.method-tlf-parse.method-parameters in theory ought to get me method
+// parameter names, but it isn't exported.
+
+// The refman document as a whole.
+define function refman (libraries :: <table>, targets :: <sequence>)
+=> (refman :: <string>)
+ let target-libraries = map(curry(element, libraries), targets);
+
+ format-to-string(
+ "<?xml version=\"1.0\" standalone=\"no\"?>"
+ "\n<!DOCTYPE refman SYSTEM \"refman.dtd\">"
+ "\n<refman>"
+ "%s"
+ "\n</refman>",
+ reduce(concatenate, refman-head(), map(refman-library, target-libraries)));
+end;
+
+
+// The <head> tag.
+define function refman-head () => (text :: <string>)
+ "\n <head>"
+ "\n <title></title>"
+ "\n <organization></organization>"
+ "\n <copyright></copyright>"
+ "\n <version></version>"
+ "\n </head>"
+end;
+
+
+// The <library> tag.
+define function refman-library (the-library :: <library>) => (text :: <string>)
+ let modules-text = "";
+
+ do-exported-modules(the-library,
+ method (name, the-module) => ()
+ modules-text := concatenate(modules-text, refman-module(the-module))
+ end);
+
+ format-to-string(
+ "\n <library>"
+ "\n <name>%s</name>"
+ "%s"
+ "\n </library>",
+ as(<string>, the-library.library-name).xml-esc,
+ modules-text);
+end;
+
+
+// The <module> tag.
+define function refman-module (the-module :: <module>) => (text :: <string>)
+ let entries-text = "";
+
+ do-exported-variables(the-module,
+ method (name, the-entry) => ()
+ entries-text := concatenate(entries-text, refman-entry(the-entry))
+ end);
+
+ format-to-string(
+ "\n <module>"
+ "\n <name>%s</name>"
+ "%s"
+ "\n </module>",
+ as(<string>, the-module.module-name).xml-esc,
+ entries-text);
+end;
+
+
+// The <entry> tag.
+define function refman-entry (the-entry :: <variable>) => (text :: <string>)
+ format-to-string(
+ "\n <entry>"
+ "\n <name>%s</name>"
+ "%s"
+ "\n <description/>"
+ "\n </entry>",
+ as(<string>, the-entry.variable-name).xml-esc,
+ refman-entry-defn(the-entry.variable-definition));
+end;
+
+
+// Unhandled definitions.
+define method refman-entry-defn (the-entry :: <definition>)
+=> (text :: <string>)
+ // Do nothing.
+ "";
+end;
+
+
+// The <functiondef> tag.
+define method refman-entry-defn (the-entry :: <function-definition>)
+=> (text :: <string>)
+ format-to-string(
+ "\n <functiondef>"
+ "%s"
+ "\n </functiondef>",
+ refman-func-params(the-entry)
+ );
+end;
+
+
+// The <genericdef> tag.
+define method refman-entry-defn (the-entry :: <generic-definition>)
+=> (text :: <string>)
+ let modifiers-text =
+ if (the-entry.generic-defn-sealed?) "sealed" else "open" end;
+ // let more-methods = map(refman-entry-defn, the-entry.generic-defn-methods));
+ format-to-string(
+ "\n <genericdef>"
+ "\n <modifiers>%s</modifiers>"
+ "%s"
+ "\n </genericdef>",
+ modifiers-text, refman-func-params(the-entry)
+ );
+end;
+
+
+// The <variabledef> tag.
+define method refman-entry-defn (the-entry :: <variable-definition>)
+=> (text :: <string>)
+ format-to-string(
+ "\n <variabledef>"
+ "\n <type>%s</type>"
+ "\n <value>%s</value>"
+ "\n </variabledef>",
+ disamb-type-from-ctype(the-entry, the-entry.defn-type),
+ format-to-string("%s", the-entry.defn-init-value | "unknown").xml-esc
+ );
+end;
+
+
+// The <constantdef> tag.
+define method refman-entry-defn (the-entry :: <constant-definition>)
+=> (text :: <string>)
+ format-to-string(
+ "\n <constantdef>"
+ "\n <type>%s</type>"
+ "\n <value>%s</value>"
+ "\n </constantdef>",
+ disamb-type-from-ctype(the-entry, the-entry.defn-type),
+ format-to-string("%s", the-entry.ct-value | "unknown").xml-esc
+ );
+end;
+
+
+// The <classdef> tag. Superclasses of a class are not accessible.
+define method refman-entry-defn (the-entry :: <class-definition>)
+=> (text :: <string>)
+ let class-type = the-entry.class-defn-cclass;
+
+ // Get modifiers.
+ let modifiers-text = concatenate(
+ if (class-type.abstract?) "abstract " else "concrete " end,
+ if (class-type.primary?) "primary " else "free " end,
+ if (class-type.sealed?) "sealed" else "open" end,
+ if (class-type.functional?) " functional" else "" end);
+
+ // Get superclasses.
+ let superclasses-text = reduce1(concatenate,
+ map(curry(format-to-string, "%s "), class-type.direct-superclasses))
+ .cdata;
+
+ // Construct <keyword> tags.
+ let <keyword>-text = "";
+ for (keyword in class-type.keyword-infos)
+
+ // <name> and <type> apply to all keywords.
+ <keyword>-text := concatenate(<keyword>-text, format-to-string(
+ "\n <keyword>"
+ "\n <name>%s:</name>"
+ "\n <type>%s</type>"
+ "\n <description>",
+ as(<string>, keyword.keyword-symbol).xml-esc,
+ disamb-type-from-ctype(the-entry, keyword.keyword-type)));
+
+ // Required and default need to reflected in the description.
+ let description-text = "";
+ if (keyword.keyword-required?)
+ description-text := concatenate(description-text, "Required.");
+ elseif (instance?(keyword.slot-init-value, <ct-value>))
+ description-text := concatenate(description-text, format-to-string(
+ "The default is %s.", keyword.slot-init-value).xml-esc);
+ end if;
+
+ // If there is a description, use <p> tag. <p> is not optional.
+ unless (description-text.empty?)
+ <keyword>-text := concatenate(<keyword>-text, format-to-string(
+ "\n <p>%s</p>", description-text));
+ end unless;
+
+ // Finish up.
+ <keyword>-text := concatenate(<keyword>-text,
+ "\n </description>"
+ "\n </keyword>");
+ end for;
+
+ // Assemble parts.
+ format-to-string(
+ "\n <classdef>"
+ "\n <modifiers>%s</modifiers>"
+ "\n <superclasses>%s</superclasses>"
+ "\n <keywords>"
+ "%s"
+ "\n </keywords>"
+ "\n </classdef>",
+ modifiers-text,
+ superclasses-text,
+ <keyword>-text
+ );
+end;
+
+// No support for <typedef> or <exceptiondef>.
+
+// The <macrodef> tag.
+define method refman-entry-defn (the-entry :: <macro-definition>)
+=> (text :: <string>)
+ format-to-string(
+ "\n <macrodef>"
+ "\n %s"
+ "\n </macrodef>",
+ the-entry.definition-kind
+ );
+end;
+
+
+// The <ins>, <outs>, and <raises> tags.
+define method refman-func-params (the-entry :: <function-definition>)
+=> (text :: <string>)
+ let sig = the-entry.function-defn-signature;
+
+ // Construct <in> tags from any req'd parameters.
+ let <in>-list = sig.specializers;
+ let <in>-types = map(curry(disamb-type-from-ctype, the-entry), <in>-list);
+ let <in>-text = reduce(concatenate, "",
+ map(curry(format-to-string,
+ "\n <in>"
+ "\n <name>arg</name>"
+ "\n <type>%s</type>"
+ "\n <description/>"
+ "\n </in>"), <in>-types));
+
+ // Construct <rest-in> tag if necessary.
+ let <rest-in>-text =
+ if (sig.rest-type)
+ format-to-string(
+ "\n <rest-in>"
+ "\n <name>more</name>"
+ "\n <type>%s</type>"
+ "\n <description/>"
+ "\n </rest-in>",
+ disamb-type-from-ctype(the-entry, sig.rest-type));
+ else
+ ""
+ end if;
+
+ // Construct <keyword-in> tags.
+ let <keyword-in>-text = "";
+ if (sig.key-infos)
+ for (keyword in sig.key-infos)
+
+ // <name> and <type> apply to all keywords.
+ <keyword-in>-text := concatenate(<keyword-in>-text, format-to-string(
+ "\n <keyword-in>"
+ "\n <name>%s:</name>"
+ "\n <type>%s</type>"
+ "\n <description>",
+ as(<string>, keyword.key-name).xml-esc,
+ disamb-type-from-ctype(the-entry, keyword.key-type)));
+
+ // Required and default need to reflected in the description.
+ let description-text = "";
+ if (keyword.required?)
+ description-text := concatenate(description-text, "Required.");
+ elseif (keyword.key-default)
+ description-text := concatenate(description-text, format-to-string(
+ "The default is %s.", keyword.key-default).xml-esc);
+ end if;
+
+ // If there is a description, use <p> tag. <p> is not optional.
+ unless (description-text.empty?)
+ <keyword-in>-text := concatenate(<keyword-in>-text, format-to-string(
+ "\n <p>%s</p>", description-text));
+ end unless;
+
+ // Finish up.
+ <keyword-in>-text := concatenate(<keyword-in>-text,
+ "\n </description>"
+ "\n </keyword-in>");
+ end for;
+ end if;
+
+ // Construct <all-keys> tag.
+ let <all-keys>-text =
+ if (sig.all-keys?)
+ "\n <all-keys/>"
+ else
+ ""
+ end if;
+
+ // Construct <out> tags.
+ let <out>-list = sig.returns.positional-types;
+ let <out>-types = map(curry(disamb-type-from-ctype, the-entry), <out>-list);
+ let <out>-text = reduce(concatenate, "",
+ map(curry(format-to-string,
+ "\n <out>"
+ "\n <name>val</name>"
+ "\n <type>%s</type>"
+ "\n <description/>"
+ "\n </out>"), <out>-types));
+
+ // Construct <rest-out> tag if necessary.
+ let <rest-out>-type = sig.returns.rest-value-type;
+ let <rest-out>-text =
+ if (<rest-out>-type ~== empty-ctype())
+ format-to-string(
+ "\n <rest-out>"
+ "\n <name>more</name>"
+ "\n <type>%s</type>"
+ "\n <description/>"
+ "\n </rest-out>",
+ disamb-type-from-ctype(the-entry, <rest-out>-type));
+ else
+ ""
+ end if;
+
+ // Assemble tag block. No GD support for <raises> tags.
+ format-to-string(
+ "\n <ins>"
+ "%s"
+ "%s"
+ "%s"
+ "%s"
+ "\n </ins>"
+ "\n <outs>"
+ "%s"
+ "%s"
+ "\n </outs>",
+ <in>-text, <rest-in>-text, <keyword-in>-text, <all-keys>-text,
+ <out>-text, <rest-out>-text);
+end;
+
+
+// Wrap a string in XML's CDATA.
+define function cdata (raw :: <string>) => (wrapped :: <string>)
+ concatenate("<![CDATA[", raw, "]]>");
+end;
+
+
+// Escape special XML characters.
+define function xml-esc (raw :: <string>) => (escaped :: <string>)
+ let escaped = substring-replace(raw, "&", "&");
+ escaped := substring-replace(escaped, "<", "<");
+ escaped := substring-replace(escaped, ">", ">");
+end;
+
+
+// Convert a <ctype> to text and add any library/module specifiers necessary.
+define function disamb-type-from-ctype
+ (the-entry :: <definition>, ctype :: <ctype>)
+=> (text :: <string>)
+ let location-string = "";
+ if (instance?(ctype, <defined-cclass>))
+
+ // Location of current definition.
+ let this-module = the-entry.defn-module;
+ let this-library = this-module.module-home;
+
+ // Location of type.
+ let type-var = find-variable(ctype.class-defn.defn-name);
+ let type-module = type-var.variable-home;
+ let type-library = type-module.module-home;
+
+ // Disambiguate like OD does: don't specify library/module if the same.
+ // Also, use the DRM's "dylan:dylan" instead of "Dylan:Dylan-Viscera".
+ if (type-library ~= this-library)
+ location-string := concatenate(location-string,
+ if (type-library ~= $Dylan-Library)
+ as(<string>, type-library.library-name);
+ else
+ "dylan";
+ end, ":");
+ end if;
+ if (type-module ~= this-module)
+ location-string := concatenate(location-string,
+ if (type-module ~= $Dylan-Module)
+ as(<string>, type-module.module-name);
+ else
+ "dylan";
+ end, ":");
+ end if;
+ end if;
+
+ // I use format-to-string here instead of concatenate to textify ctype.
+ format-to-string("%s%s", location-string, ctype).cdata;
+end;
+
+
+// Get the module of a definition.
+define method defn-module (defn :: <definition>) => (module :: <module>)
+ defn.defn-name.any-name-module;
+end;
+
+define method any-name-module (name :: <basic-name>) => (module :: <module>)
+ name.name-module;
+end;
+
+define method any-name-module (name :: <method-name>) => (module :: <module>)
+ name.method-name-generic-function.name-module;
+end;
+
Added: trunk/src/tools/refman/refman.lid
==============================================================================
--- (empty file)
+++ trunk/src/tools/refman/refman.lid Thu Jan 25 03:01:54 2007
@@ -0,0 +1,8 @@
+synopsis: Generates .xml representation of a project, like Open Dylan.
+author: Dustin Voss
+copyright: © 2007 Dustin Voss
+library: refman
+executable: refman
+files: refman-library
+ main
+ refman
More information about the chatter
mailing list