Commit 862dc206 authored by Erick's avatar Erick

Added function auto-documentation

parent 42281dcb
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......@@ -292,7 +292,7 @@ doc/skb/stklos-version.stk: $(top_builddir)/config.status $(top_srcdir)/doc/skb/
# (which will cause the Makefiles to be regenerated when you run `make');
# (2) otherwise, pass the desired values on the `make' command line.
$(RECURSIVE_TARGETS):
@failcom='exit 1'; \
@fail= failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
......@@ -317,7 +317,7 @@ $(RECURSIVE_TARGETS):
fi; test -z "$$fail"
$(RECURSIVE_CLEAN_TARGETS):
@failcom='exit 1'; \
@fail= failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
......@@ -481,7 +481,8 @@ distdir: $(DISTFILES)
fi; \
done
-test -n "$(am__skip_mode_fix)" \
|| find "$(distdir)" -type d ! -perm -777 -exec chmod a+rwx {} \; -o \
|| find "$(distdir)" -type d ! -perm -755 \
-exec chmod u+rwx,go+rx {} \; -o \
! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
! -type d ! -perm -400 -exec chmod a+r {} \; -o \
! -type d ! -perm -444 -exec $(install_sh) -c -m a+r {} {} \; \
......@@ -525,17 +526,17 @@ dist dist-all: distdir
distcheck: dist
case '$(DIST_ARCHIVES)' in \
*.tar.gz*) \
GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | $(am__untar) ;;\
GZIP=$(GZIP_ENV) gzip -dc $(distdir).tar.gz | $(am__untar) ;;\
*.tar.bz2*) \
bunzip2 -c $(distdir).tar.bz2 | $(am__untar) ;;\
bzip2 -dc $(distdir).tar.bz2 | $(am__untar) ;;\
*.tar.lzma*) \
unlzma -c $(distdir).tar.lzma | $(am__untar) ;;\
lzma -dc $(distdir).tar.lzma | $(am__untar) ;;\
*.tar.xz*) \
xz -dc $(distdir).tar.xz | $(am__untar) ;;\
*.tar.Z*) \
uncompress -c $(distdir).tar.Z | $(am__untar) ;;\
*.shar.gz*) \
GZIP=$(GZIP_ENV) gunzip -c $(distdir).shar.gz | unshar ;;\
GZIP=$(GZIP_ENV) gzip -dc $(distdir).shar.gz | unshar ;;\
*.zip*) \
unzip $(distdir).zip ;;\
esac
......
# generated automatically by aclocal 1.11 -*- Autoconf -*-
# generated automatically by aclocal 1.11.1 -*- Autoconf -*-
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
# 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
......@@ -13,8 +13,8 @@
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.64],,
[m4_warning([this file was generated for autoconf 2.64.
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.65],,
[m4_warning([this file was generated for autoconf 2.65.
You have another version of autoconf. It may work, but is not guaranteed to.
If you have problems, you may need to regenerate the build system entirely.
To do so, use the procedure documented by the package, typically `autoreconf'.])])
......@@ -34,7 +34,7 @@ AC_DEFUN([AM_AUTOMAKE_VERSION],
[am__api_version='1.11'
dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to
dnl require some minimum version. Point them to the right macro.
m4_if([$1], [1.11], [],
m4_if([$1], [1.11.1], [],
[AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl
])
......@@ -50,7 +50,7 @@ m4_define([_AM_AUTOCONF_VERSION], [])
# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced.
# This function is AC_REQUIREd by AM_INIT_AUTOMAKE.
AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
[AM_AUTOMAKE_VERSION([1.11])dnl
[AM_AUTOMAKE_VERSION([1.11.1])dnl
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))])
......
This diff is collapsed.
......@@ -2,7 +2,7 @@
###
### Author: Erick Gallesio [eg@unice.fr]
### Creation date: 28-Dec-1999 21:19 (eg)
### Last file update: 28-Oct-2009 18:58 (eg)
### Last file update: 20-Dec-2009 18:02 (eg)
AC_PREREQ(2.64)
AC_INIT([stklos], [0.99dev])
......@@ -212,7 +212,7 @@ then
else
echo "... Using system libgc library"
GC=""
if test $PKGCONFIG --exists bdw-gc ;then
if $PKGCONFIG --exists bdw-gc ;then
GCINC=$(pkg-config bdw-gc --cflags)
GCLIB=$(pkg-config bdw-gc --libs)
else
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
......@@ -2,7 +2,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 11-Apr-2000 10:30 (eg)
# Last file update: 18-Oct-2009 00:16 (eg)
# Last file update: 20-Dec-2009 17:56 (eg)
SUBDIRS = Match.d SILex.d Lalr.d ScmPkg.d
......@@ -46,6 +46,7 @@ scheme_SRCS = STklos.init \
full-syntax.stk \
full-conditions.stk \
getopt.stk \
help.stk \
http.stk \
lex-rt.stk \
make-C-boot.stk \
......@@ -87,6 +88,7 @@ scheme_OBJS = compfile.ostk \
describe.ostk \
env.ostk \
getopt.ostk \
help.ostk \
http.ostk \
lex-rt.ostk \
pp.ostk \
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......@@ -19,7 +19,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 11-Apr-2000 10:30 (eg)
# Last file update: 18-Oct-2009 00:16 (eg)
# Last file update: 20-Dec-2009 17:56 (eg)
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
......@@ -287,6 +287,7 @@ scheme_SRCS = STklos.init \
full-syntax.stk \
full-conditions.stk \
getopt.stk \
help.stk \
http.stk \
lex-rt.stk \
make-C-boot.stk \
......@@ -328,6 +329,7 @@ scheme_OBJS = compfile.ostk \
describe.ostk \
env.ostk \
getopt.ostk \
help.ostk \
http.ostk \
lex-rt.ostk \
pp.ostk \
......@@ -432,7 +434,7 @@ uninstall-schemeDATA:
# (which will cause the Makefiles to be regenerated when you run `make');
# (2) otherwise, pass the desired values on the `make' command line.
$(RECURSIVE_TARGETS):
@failcom='exit 1'; \
@fail= failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
......@@ -457,7 +459,7 @@ $(RECURSIVE_TARGETS):
fi; test -z "$$fail"
$(RECURSIVE_CLEAN_TARGETS):
@failcom='exit 1'; \
@fail= failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
;;;;
;;;; assembler.stk -- Assember stuff
;;;;
;;;; Copyright 2000-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright 2000-2009 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: 14-Mar-2001 13:49 (eg)
;;;; Last file update: 10-May-2007 15:48 (eg)
;;;; Last file update: 20-Dec-2009 12:20 (eg)
;;;;
;;;
......@@ -130,9 +130,10 @@
(MAKE-EXPANDER 1)
(SET-CUR-MOD 0)
(UNUSED-1 0)
(UNUSED-2 0)
;; Documentation string
(DOCSTRG 1)
(UNUSED-2 0)
;; The following instructions are not generated by the compiler
;; but by the peephole optimizer
......@@ -238,6 +239,7 @@
(IN-SINT-FXSUB2 1)
(IN-SINT-FXMUL2 1)
(IN-SINT-FXDIV2 1)
))))
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 14-Jun-2000 17:24 (eg)
;;;; Last file update: 18-Oct-2009 00:49 (eg)
;;;; Last file update: 20-Dec-2009 17:43 (eg)
;;;;
......@@ -867,6 +867,18 @@ doc>
(code (car args)))))
(else (error 'ansi-color "bad command ~S" args)))))
(define do-color
(if (and (not (key-get *%program-args* :interactive #f))
(member (getenv "TERM")
'("rxvt" "xterm" "xterm-color" "linux" "cygwin")))
;; Terminal accepts color
ansi-color
;; Provide a procedure which ignore color indications
(lambda args
(apply string-append
(map (lambda (x) (if (string? x) x ""))
args)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Port conversions
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 01-Jan-2000 15:04 (eg)
;;;; Last file update: 20-Dec-2009 11:57 (eg)
;;;; Last file update: 20-Dec-2009 17:47 (eg)
;;;;
(include "runtime.stk") ; Definition necessary for the bootstrap
......@@ -54,6 +54,7 @@
(autoload "pp" pp pretty-print)
(autoload "env" null-environment scheme-report-environment
interaction-environment)
(autoload "help" help)
(autoload "http" http-open http-parse-status-line
http-parse-header http-find-body http-download)
(autoload "lex-rt" lexer-next-token)
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Feb-2000 10:47 (eg)
;;;; Last file update: 20-Dec-2009 12:00 (eg)
;;;; Last file update: 20-Dec-2009 14:57 (eg)
;;;;
(define-module STKLOS-COMPILER
......@@ -568,12 +568,21 @@ doc>
(define (compile-user-lambda formals body arity env) ; i.e R5RS ones
(let ((env (extend-env env formals))
(lab (new-label)))
(let* ((env (extend-env env formals))
(lab (new-label))
(doc (if (and (> (length body) 1) (string? (car body)))
(car body)
#f))
(body (if doc (cdr body) body)))
(emit 'CREATE-CLOSURE lab arity)
(compile-body body env body #t)
(emit 'RETURN)
(emit-label lab)))
(emit-label lab)
(when doc
;; emit the docstring
(emit 'DOCSTRG (fetch-constant doc)))))
;;; EXTENDED LAMBDAS
......@@ -789,20 +798,28 @@ doc>
(if (null? req) ; FIXME: simpl
(set! req rest-name)
(set-cdr! (last-pair req) rest-name))
`(,req ,(build-let* opt key rest-name rest body)))
`(,req ,(build-let* opt key rest-name rest body)))
;; "Normal" lambda
(begin (if rest
(if (null? req)
(set! req rest)
(set-cdr! (last-pair req) rest)))
`(,req ,@body)))))
`(,req ,@body)))))
(define (extended-lambda->lambda el) ;; STklos lambda => R5RS lambda
(if (> (length el) 2)
(let ((method? (eq? (car el) 'method))
(formals (cadr el))
(body (cddr el)))
(cons 'lambda (rewrite-params-and-body method? formals body)))
(let* ((method? (eq? (car el) 'method))
(formals (cadr el))
(body (cddr el))
(doc (and (> (length body) 1) (string? (car body)) (car body)))
(new (rewrite-params-and-body method?
formals
(if doc (cdr body) body))))
(if doc
`(lambda ,(car new)
,doc
,@(cdr new))
`(lambda ,@new)))
(compiler-error 'lambda el "bad definition ~S" el)))
......
;;;;
;;;; help.stk -- Interactive help
;;;;
;;;; Copyright © 2009 Erick Gallesio - Polytech'Nice-Sophia <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
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 20-Dec-2009 18:26 (eg)
;;;; Last file update: 20-Dec-2009 18:29 (eg)
;;;;
;; ----------------------------------------------------------------------
;; Database reading
;; ----------------------------------------------------------------------
(define (read-database name)
(let ((f (open-file name "r")))
(if f
(let Loop ((res '())
(item (read f)))
(if (eof-object? item)
(begin (close-port f) res)
(Loop (cons item res) (read f))))
;; file cannot be opened
(begin
(eprintf "Warning: cannot open ~S.\n" name)
'()))))
(define *the-doc*
(read-database (make-path (%library-prefix) "share" "stklos" (version) "DOCDB")))
;; ----------------------------------------------------------------------
;; pretty-doc ...
;; ----------------------------------------------------------------------
(define (pretty-doc str)
;; suppress some common Skribe things from the doc string
(set! str (regexp-replace-all "£" str ""))
(set! str (regexp-replace-all "@lisp" str (do-color 'blue)))
(set! str (regexp-replace-all "@end lisp" str (do-color 'normal)))
str)
;; ----------------------------------------------------------------------
;; find-documentation
;; ----------------------------------------------------------------------
(define-generic find-documentation)
(define-method find-documentation ((self <symbol>))
(let* ((doc (assoc self *the-doc*))
(see (and doc (key-get (cdr doc) :see #f))))
(cond
(see
;; the symbol is indirectly documented
(find-documentation see))
(doc
;; found documentation. Format it a little bit
(pretty-doc (string-append (key-get (cdr doc) :synopsis)
"\n\n"
(key-get (cdr doc) :description)
"\n")))
(else
;; no documentation
(do-color 'red (format "no documentation found for ~S" self))))))
(define-method find-documentation ((self <procedure>))
(let ((doc (%procedure-doc self)))
(or doc
(let ((name (%procedure-name self)))
(and (string? name)
(find-documentation (string->symbol name)))))))
(define-method find-documentation (self obj)
#f)
;; ----------------------------------------------------------------------
;; help
;; ----------------------------------------------------------------------
(define-method help (obj)
(let ((doc (find-documentation obj)))
(if doc
(printf "~a\n" doc)
(printf "no documentation for ~s\n" obj))))
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -2,7 +2,7 @@
*
* p r o c . c -- Things about procedures
*
* Copyright 1993-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright 1993-2009 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
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 15-Nov-1993 22:02
* Last file update: 28-Jun-2007 18:23 (eg)
* Last file update: 20-Dec-2009 15:10 (eg)
*/
#include "stklos.h"
......@@ -56,6 +56,7 @@ SCM STk_make_closure(STk_instr *code, int size, int arity, SCM *cst, SCM env)
CLOSURE_CONST(z) = cst;
CLOSURE_BCODE(z) = code;
CLOSURE_SIZE(z) = size;
CLOSURE_DOC(z) = STk_false;
return z;
}
......@@ -252,6 +253,11 @@ DEFINE_PRIMITIVE("%procedure-code", proc_code, subr1, (SCM proc))
return v;
}
DEFINE_PRIMITIVE("%procedure-doc", proc_doc, subr1, (SCM proc))
{
if (!CLOSUREP(proc)) return STk_false;
return CLOSURE_DOC(proc);
}
/*===========================================================================*\
......@@ -380,6 +386,7 @@ int STk_init_proc(void)
ADD_PRIMITIVE(proc_plist);
ADD_PRIMITIVE(set_proc_plist);
ADD_PRIMITIVE(proc_code);
ADD_PRIMITIVE(proc_doc);
ADD_PRIMITIVE(proc_arity);
ADD_PRIMITIVE(procedure_name);
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 3-Oct-2009 21:46 (eg)
* Last file update: 20-Dec-2009 15:10 (eg)
*/
......@@ -1008,7 +1008,7 @@ extern int STk_interactive; /* We are in intearctive mode */
------------------------------------------------------------------------------
*/
void STk_print(SCM exp, SCM port, int mode);
void STk_print_star(SCM exp, SCM port);
void STk_print_star(SCM exp, SCM port);
#define DSP_MODE 0
#define WRT_MODE 1
......@@ -1054,6 +1054,7 @@ struct closure_obj {
SCM plist;
SCM name;
SCM* constants;
SCM doc;
STk_instr *bcode;
};
......@@ -1068,6 +1069,7 @@ struct closure_obj {
#define CLOSURE_PLIST(p) (((struct closure_obj *) (p))->plist)
#define CLOSURE_NAME(p) (((struct closure_obj *) (p))->name)
#define CLOSURE_CONST(p) (((struct closure_obj *) (p))->constants)
#define CLOSURE_DOC(p) (((struct closure_obj *) (p))->doc)
#define CLOSURE_BCODE(p) (((struct closure_obj *) (p))->bcode)
#define CLOSUREP(p) (BOXED_TYPE_EQ((p), tc_closure))
......
......@@ -77,7 +77,7 @@
# define IN_APPLY 72
# define MAKE_EXPANDER 73
# define SET_CUR_MOD 74
# define UNUSED_1 75
# define DOCSTRG 75
# define UNUSED_2 76
# define FALSE_PUSH 77
# define TRUE_PUSH 78
......@@ -245,7 +245,7 @@ static void *jump_table[] = {
&&lab_IN_APPLY ,
&&lab_MAKE_EXPANDER ,
&&lab_SET_CUR_MOD ,
&&lab_UNUSED_1 ,
&&lab_DOCSTRG ,
&&lab_UNUSED_2 ,
&&lab_FALSE_PUSH ,
&&lab_TRUE_PUSH ,
......@@ -413,7 +413,7 @@ static char *name_table[] = {
"IN_APPLY ",
"MAKE_EXPANDER ",
"SET_CUR_MOD ",
"UNUSED_1 ",
"DOCSTRG ",
"UNUSED_2 ",
"FALSE_PUSH ",
"TRUE_PUSH ",
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 25-Oct-2009 09:29 (eg)
* Last file update: 20-Dec-2009 15:11 (eg)
*/
// INLINER values
......@@ -1477,11 +1477,18 @@ CASE(MAKE_EXPANDER) {
NEXT;
}
CASE(DOCSTRG) {
SCM str = fetch_const();
if (vm->valc == 1 && CLOSUREP(vm->val))
CLOSURE_DOC(vm->val) = str;
NEXT;
}
CASE(END_OF_CODE) {
return;
}
CASE(UNUSED_1)
CASE(UNUSED_2)
CASE(UNUSED_3)
CASE(UNUSED_4)
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
# Makefile.in generated by automake 1.11 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
......
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