Commit b341be4e authored by Erick Gallesio's avatar Erick Gallesio

Added code rewriting in pkgman

parent 997b6413
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 11-Dec-2006 14:39 (eg)
;;;; Last file update: 13-Mar-2007 16:22 (eg)
;;;; Last file update: 21-Mar-2007 15:07 (eg)
;;;;
......@@ -59,8 +59,11 @@
(define *ignored-interface-clauses*
'(maintainer author description keywords license homepage snow))
(append
;; meta-informations
'(maintainer author description keywords license homepage snow)
;; Language specifics meta-informations
(map car *scmpkg-languages*)))
;; ======================================================================
;; interface ...
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 7-Feb-2007 13:39 (eg)
;;;; Last file update: 11-Mar-2007 23:49 (eg)
;;;; Last file update: 21-Mar-2007 14:28 (eg)
;;;;
(define *scmpkg-languages*
......@@ -32,11 +32,7 @@
(bigloo :suffix "scm")
;; Snow
(snow :suffix "scm")
;; ScmPkg
(scmpkg :suffix "scm")
;; R5RS (the default)
(r5rs :suffix "scm")))
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 01-Jan-2000 15:04 (eg)
;;;; Last file update: 8-Mar-2007 13:57 (eg)
;;;; Last file update: 21-Mar-2007 14:57 (eg)
;;;;
(include "runtime.stk") ; Definition necessary for the bootstrap
......@@ -53,6 +53,7 @@
(autoload "pp" pp pretty-print)
(autoload "env" null-environment scheme-report-environment
interaction-environment)
(autoload "lex-rt" lexer-next-token)
;(syntax-autoload "snow-support" package*)
(syntax-autoload "scmpkg-support" interface)
(autoload "srfi-27" random-integer random-real)
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Manuel Serrano
;;;; Creation date: 16-Mar-2007 15:59 (eg)
;;;; Last file update: 16-Mar-2007 16:28 (eg)
;;;; Last file update: 19-Mar-2007 14:40 (eg)
;;;;
(require "pp")
......@@ -64,6 +64,8 @@
(set! failure (cons name failure))
(display "error.\n")
(printf " ==> provided: [~S]\n" provided)
(when (condition? provided)
(describe provided))
(printf " expected: [~S]\n" (if (procedure? res)
(res 'result)
res))))))
......
# Makefile for stklos-pkgman
# Author: Erick Gallesio [eg@essi.fr]
# Creation date: 22-Dec-2006 12:00 (eg)
# Last file update: 14-Mar-2007 12:41 (eg)
# Last file update: 21-Mar-2007 14:33 (eg)
makefiledir= $(prefix)/etc/stklos
......@@ -9,18 +9,26 @@ makefile_DATA= etc/Makefile-scmpkg.tmpl
bin_SCRIPTS = stklos-pkg
SRC = main.stk add.stk extract.stk http.stk params.stk pkgball.stk \
repository.stk misc.stk tune.stk types.stk
LEX = lang-bigloo.l
LEXOBJS = lang-bigloo.inc
SRC = main.stk add.stk extract.stk http.stk lang.stk lang-bigloo.stk \
params.stk pkgball.stk \
repository.stk rewrite.stk misc.stk tune.stk types.stk
SFLAGS = -l
RM = /bin/rm
SCC = ../utils/stklos-compile
$(bin_SCRIPTS): $(SRC)
lang-bigloo.inc: lang-bigloo.l
stklos-genlex lang-bigloo.l lang-bigloo.inc lang-bigloo
$(bin_SCRIPTS): $(LEXOBJS) $(SRC)
../utils/tmpcomp main.stk $(bin_SCRIPTS)
# $(SCC) $(SFLAGS) -o $(bin_SCRIPTS) main.stk
clean:
$(RM) -f $(bin_SCRIPTS) *~
$(RM) -f $(bin_SCRIPTS) $(LEXOBJS) *~
distclean: clean
......@@ -17,7 +17,7 @@
# Makefile for stklos-pkgman
# Author: Erick Gallesio [eg@essi.fr]
# Creation date: 22-Dec-2006 12:00 (eg)
# Last file update: 14-Mar-2007 12:41 (eg)
# Last file update: 21-Mar-2007 14:33 (eg)
VPATH = @srcdir@
......@@ -188,8 +188,11 @@ top_srcdir = @top_srcdir@
makefiledir = $(prefix)/etc/stklos
makefile_DATA = etc/Makefile-scmpkg.tmpl
bin_SCRIPTS = stklos-pkg
SRC = main.stk add.stk extract.stk http.stk params.stk pkgball.stk \
repository.stk misc.stk tune.stk types.stk
LEX = lang-bigloo.l
LEXOBJS = lang-bigloo.inc
SRC = main.stk add.stk extract.stk http.stk lang.stk lang-bigloo.stk \
params.stk pkgball.stk \
repository.stk rewrite.stk misc.stk tune.stk types.stk
SFLAGS = -l
RM = /bin/rm
......@@ -391,12 +394,15 @@ uninstall-am: uninstall-binSCRIPTS uninstall-makefileDATA
uninstall-makefileDATA
$(bin_SCRIPTS): $(SRC)
lang-bigloo.inc: lang-bigloo.l
stklos-genlex lang-bigloo.l lang-bigloo.inc lang-bigloo
$(bin_SCRIPTS): $(LEXOBJS) $(SRC)
../utils/tmpcomp main.stk $(bin_SCRIPTS)
# $(SCC) $(SFLAGS) -o $(bin_SCRIPTS) main.stk
clean:
$(RM) -f $(bin_SCRIPTS) *~
$(RM) -f $(bin_SCRIPTS) $(LEXOBJS) *~
distclean: clean
# Tell versions [3.59,3.63) of GNU make to not export all variables.
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 15-Jan-2007 12:10 (eg)
;;;; Last file update: 16-Mar-2007 17:08 (eg)
;;;; Last file update: 22-Mar-2007 11:40 (eg)
;;;;
;; ----------------------------------------------------------------------
......@@ -53,16 +53,18 @@
(define (build-test-target)
(let ((spi (format "~a-test.spi" package)))
(when (file-exists? (make-path package "test" spi))
(printf "test: $(OBJS)\n")
(printf "\t(cd ~a; $(SCC) $(SFLAGS) -L ../.. -o ../../~a.ostk ~a)\n"
(make-path package "test")
(format "~a-test" package)
spi)
(printf "\techo 'Running test'\n")
(printf "\tstklos -l ~a -e '(begin (import ~a-test) (run-tests))'\n\n"
(format "~a-test.ostk" package)
package))))
(printf "test: $(OBJS)\n")
(if (file-exists? (make-path package "test" spi))
(begin
(printf "\t(cd ~a; $(SCC) $(SFLAGS) -L ../.. -o ../../~a.ostk ~a)\n"
(make-path package "test")
(format "~a-test" package)
spi)
(printf "\techo 'Running test'\n")
(printf "\tstklos -l ~a -e '(begin (import ~a-test) (run-tests))'\n\n"
(format "~a-test.ostk" package)
package))
(printf "\t@echo '**** No test provided with package ~A'\n" package))))
;;;
;;; write-extract-file starts here
......@@ -108,6 +110,8 @@
(unless (file-exists? pkgball)
(die (format "cannot find pkgball in cache ~s" (basename pkgball))))
(untar pkgball dir)
;; Eventually rewrite package with its specialized preprocessor
(rewrite-package pkg dir)
;; if the package has a tuning extract it too.
(when tuning
(let ((tuneball (tuning-path tuning)))
......
;;; Author: Erick Gallesio [eg@essi.fr]
;;; Creation date: 21-Mar-2007 13:45 (eg)
;;; Last file update: 22-Mar-2007 13:56 (eg)
%%
;; Strings
\"[^\"]*\" yytext
;;Comment
\;.* yytext
;; #undefined
#unspecified "#void"
;; Ascii characters notation #aXXX
#a[0-9][0-9][0-9] (format "(integer->char ~a)"
(substring yytext 2 5))
;; Other characters
[^#\"\;]+ yytext
;; A # which is not undefined or #aXXX
\# "#"
<<EOF>> 'eof
<<ERROR>> (error 'bigloo-preprocessor "Parse error" yytext)
;;;;
;;;; lang-bigloo.stk -- Bigloo language support
;;;;
;;;; Copyright 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.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@essi.fr]
;;;; Creation date: 21-Mar-2007 13:57 (eg)
;;;; Last file update: 22-Mar-2007 11:44 (eg)
;;;;
(include "lang-bigloo.inc")
;; ----------------------------------------------------------------------
;; bigloo-rewrite ...
;; ----------------------------------------------------------------------
(define (bigloo-rewrite src dir)
(define (do-rewrite in tmp)
(with-output-to-file tmp
(lambda ()
(let ((lex (lang-bigloo in)))
(let loop ((token (lexer-next-token lex)))
(unless (eq? token 'eof)
(display token)
(loop (lexer-next-token lex))))))))
(let ((tmp (temporary-file-name)))
(do-rewrite src tmp)
(copy-file tmp src)
(remove-file tmp)))
;;;
;;; Register this language
;;;
(add-rewriter! 'bigloo bigloo-rewrite)
;;;;
;;;; lang.stk -- ScmPkg languages
;;;;
;;;; Copyright © 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.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@essi.fr]
;;;; Creation date: 21-Mar-2007 14:31 (eg)
;;;; Last file update: 21-Mar-2007 14:31 (eg)
;;;;
(include "lang-bigloo.stk")
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 22-Dec-2006 11:32 (eg)
;;;; Last file update: 8-Mar-2007 20:03 (eg)
;;;; Last file update: 21-Mar-2007 14:32 (eg)
;;;;
(require "getopt")
......@@ -35,6 +35,8 @@
(include "repository.stk")
(include "pkgball.stk")
(include "add.stk")
(include "rewrite.stk")
(include "lang.stk")
(include "tune.stk")
(include "extract.stk")
(include "misc.stk")
......
;;;;
;;;; rewrite.stk -- ScmPkg package rewriting
;;;;
;;;; Copyright 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.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@essi.fr]
;;;; Creation date: 20-Mar-2007 15:13 (eg)
;;;; Last file update: 22-Mar-2007 11:44 (eg)
;;;;
(define *code-rewriters* '())
;; ----------------------------------------------------------------------
;; add-rewriter! ...
;; ----------------------------------------------------------------------
(define (add-rewriter! lang proc)
(set! *code-rewriters* (cons (cons lang proc) *code-rewriters*)))
;; ----------------------------------------------------------------------
;; rewrite-package ...
;; ----------------------------------------------------------------------
(define (rewrite-package pkg dir)
(let* ((name (package-name pkg))
(suff (package-suffix pkg))
(lang (car (package-language pkg)))
(rwt (assoc lang *code-rewriters*)))
(when rwt
;; Rewriting body
(let ((src (make-path dir name (string-append name suff))))
(when (> (stklos-pkg-verbosity) 0)
(eprintf " - Rewriting package body for ~S\n" name))
( (cdr rwt) src dir ))
;; Rewriting tests
(let ((tst (make-path dir name "test" (string-append name "-test" suff))))
(when (> (stklos-pkg-verbosity) 0)
(eprintf " - Rewriting package tests for ~S\n" name))
( (cdr rwt) tst dir )))))
......@@ -21,40 +21,16 @@
;;;;
;;;; Author: Manuel Serrano
;;;; Creation date: 18-Jan-2007 16:44 (eg)
;;;; Last file update: 12-Mar-2007 09:25 (eg)
;;;; Last file update: 20-Mar-2007 16:26 (eg)
;;;;
;; Most of the code her was given by Manuel Serrano.
(define (file->string path)
(with-input-from-file path
(lambda ()
(port->string (current-input-port)))))
;; ----------------------------------------------------------------------
;; tune-package ...
;; ----------------------------------------------------------------------
;;//(define (tune-package pkg dir)
;;//
;;// (define (maybe-overwrite suffix)
;;// (let* ((name (package-name pkg))
;;// (pdir (make-path dir name))
;;// (tundir (make-path pdir "stklos")))
;;// (when (file-is-directory? tundir)
;;// ;; If the tune directory has a file with given suffix, use it
;;// (let* ((src (format "~a.~a" name suffix))
;;// (tuning (make-path tundir src)))
;;// (when (file-exists? tuning)
;;// (when (> (stklos-pkg-verbosity) 0)
;;// (eprintf " Overwriting ~s with tuning file\n" (basename tuning)))
;;// (copy-file tuning (make-path pdir src)))))))
;;//
;;// (maybe-overwrite "spi")
;;// (maybe-overwrite "scm"))
;;//
(define (tune-package pkg dir)
(let* ((name (package-name pkg))
......
This diff is collapsed.
This diff is collapsed.
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