Relicense imported LGPL v3+ files to GPL v3+. master
authorJan (janneke) Nieuwenhuizen <janneke@gnu.org>
Tue, 9 Nov 2021 10:49:41 +0000 (11:49 +0100)
committerJan (janneke) Nieuwenhuizen <janneke@gnu.org>
Tue, 9 Nov 2021 11:01:04 +0000 (12:01 +0100)
Fixes https://savannah.nongnu.org/task/?16067.
Reported via savannah by Ineiev <ineiev@gnu.org>.

* mes/module/mes/lalr.scm,
module/mes/getopt-long.scm,
module/mes/optargs.scm: Change header to GNU Mes header with GPL v3.

mes/module/mes/lalr.scm
module/mes/getopt-long.scm
module/mes/optargs.scm

index 87b63c5674b9d3b8b4a3e14bdeb00c81cafeb481..f52ea0558db7216c6c9866ef2fe67c8314a315e4 100644 (file)
@@ -1,33 +1,39 @@
+;;; GNU Mes --- Maxwell Equations of Software
 ;;;
-;;;; An Efficient and Portable LALR(1) Parser Generator for Scheme
+;;; Copyright © 1993, 2010 Dominique Boucher
+;;; Copyright © 2014  Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
-;; Copyright 2014  Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;; Copyright 1993, 2010 Dominique Boucher
-;;
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public License
-;; as published by the Free Software Foundation, either version 3 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 Lesser General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU Mes 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 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
 
+;;; An Efficient and Portable LALR(1) Parser Generator for Scheme
+
+;;; Code:
 
 (define *lalr-scm-version* "2.5.0")
 
-(cond-expand 
+(cond-expand
 
  ;; -- Gambit-C
  (gambit
 
    (display "Gambit-C!")
    (newline)
-   
+
   (define-macro (def-macro form . body)
     `(define-macro ,form (let () ,@body)))
 
@@ -38,8 +44,8 @@
   (define pprint pretty-print)
   (define lalr-keyword? keyword?)
   (define (note-source-location lvalue tok) lvalue))
- ;; -- 
+
+ ;; --
  (bigloo
   (define-macro (def-macro form . body)
     `(define-macro ,form (let () ,@body)))
   (def-macro (logical-or x . y) `(bit-or ,x ,@y))
   (def-macro (lalr-error msg obj) `(error "lalr-parser" ,msg ,obj))
   (define (note-source-location lvalue tok) lvalue))
+
  ;; -- Chicken
  (chicken
-  
+
   (define-macro (def-macro form . body)
     `(define-macro ,form (let () ,@body)))
 
    (define-macro (lalr-error msg obj) `(error ,msg ,obj))
    (define (note-source-location lvalue tok) lvalue)
    (define *eoi* -1))
-  
+
  ;; -- Kawa
  (kawa
   (require 'pretty-print)
  (sisc
   (import logicops)
   (import record)
-       
+
   (define pprint pretty-print)
   (define lalr-keyword? symbol?)
   (define-macro BITS-PER-WORD (lambda () 32))
   (define-macro logical-or (lambda (x . y) `(logor ,x ,@y)))
   (define-macro (lalr-error msg obj) `(error "~a ~S:" ,msg ,obj))
   (define (note-source-location lvalue tok) lvalue))
-       
+
  ;; -- Gauche
  (gauche
   (use gauche.record)
   (define STATE-TABLE-SIZE 1009)
 
 
-  ;; - Tableaux 
+  ;; - Tableaux
   (define rrhs         #f)
   (define rlhs         #f)
   (define ritem        #f)
   ;; ----------------------------------------------------------------------
   ;; operator precedence management
   ;; ----------------------------------------------------------------------
-      
+
   ;; a vector of precedence descriptors where each element
   ;; is of the form (terminal type precedence)
-  (define the-terminals/prec #f)   ; terminal symbols with precedence 
+  (define the-terminals/prec #f)   ; terminal symbols with precedence
                                        ; the precedence is an integer >= 0
   (define (get-symbol-precedence sym)
     (caddr (vector-ref the-terminals/prec sym)))
        (if (pair? actions)
            (let ((current-action (cadr actions)))
              (if (not (= new-action current-action))
-                 ;; -- there is a conflict 
+                 ;; -- there is a conflict
                  (begin
                    (if (and (<= current-action 0) (<= new-action 0))
                        ;; --- reduce/reduce conflict
                        (begin
                          (add-conflict-message
-                          "%% Reduce/Reduce conflict (reduce " (- new-action) ", reduce " (- current-action) 
+                          "%% Reduce/Reduce conflict (reduce " (- new-action) ", reduce " (- current-action)
                           ") on '" (get-symbol (+ symbol nvars)) "' in state " state)
                          (if (glr-driver?)
                              (set-cdr! (cdr actions) (cons new-action (cddr actions)))
                                     (if (glr-driver?)
                                         (set-cdr! (cdr actions) (cons new-action (cddr actions)))
                                         (set-car! (cdr actions) new-action))))))))
-          
+
            (vector-set! action-table state (cons (list symbol new-action) state-actions)))
        ))
 
     (symbol? x))
 
   (define (valid-terminal? x)
-    (symbol? x))                       ; DB 
+    (symbol? x))                       ; DB
 
   ;; ----------------------------------------------------------------------
   ;; Miscellaneous
            (if (p x)
                (cons x (loop y))
                (loop y))))))
-      
+
   ;; ----------------------------------------------------------------------
   ;; Debugging tools ...
   ;; ----------------------------------------------------------------------
 
 
   ;; ----------------------------------------------------------------------
-      
+
   (define build-goto-table
     (lambda ()
       `(vector
                                   '()))
                        ,(if (= nt 0)
                             '$1
-                            `(___push ,n ,nt ,(cdr p) ,@(if (eq? driver-name 'lr-driver) '() '(___sp)) 
+                            `(___push ,n ,nt ,(cdr p) ,@(if (eq? driver-name 'lr-driver) '() '(___sp))
                                        ,(if (eq? driver-name 'lr-driver)
                                             `(vector-ref ___stack (- ___sp ,(length rhs)))
                                             `(list-ref ___sp ,(length rhs))))))))))
     (set-driver-name! options)
     (let* ((gram/actions (gen-tables! tokens rules))
           (code         `(,driver-name ',action-table ,(build-goto-table) ,(build-reduction-table gram/actions))))
-    
+
       (output-table! options)
       (output-parser! options code)
       code))
 
   (extract-arguments arguments build-driver))
-   
+
 
 
 ;;;
 
 
 ;; This function assumes that src-location-1 and src-location-2 are source-locations
-;; Returns #f if they are not locations for the same input 
+;; Returns #f if they are not locations for the same input
 (define (combine-locations src-location-1 src-location-2)
   (let ((offset-1 (source-location-offset src-location-1))
         (offset-2 (source-location-offset src-location-2))
 
   (define ___lexerp #f)
   (define ___errorp #f)
-  
+
   (define ___stack  #f)
   (define ___sp     0)
-  
+
   (define ___curr-input #f)
   (define ___reuse-input #f)
-  
+
   (define ___input #f)
   (define (___consume)
     (set! ___input (if ___reuse-input ___curr-input (___lexerp)))
     (set! ___reuse-input #f)
     (set! ___curr-input ___input))
-  
+
   (define (___pushback)
     (set! ___reuse-input #t))
-  
+
   (define (___initstack)
     (set! ___stack (make-vector *max-stack-size* 0))
     (set! ___sp 0))
-  
+
   (define (___growstack)
     (let ((new-stack (make-vector (* 2 (vector-length ___stack)) 0)))
       (let loop ((i (- (vector-length ___stack) 1)))
              (vector-set! new-stack i (vector-ref ___stack i))
              (loop (- i 1)))))
       (set! ___stack new-stack)))
-  
+
   (define (___checkstack)
     (if (>= ___sp (vector-length ___stack))
         (___growstack)))
-  
+
   (define (___push delta new-category lvalue tok)
     (set! ___sp (- ___sp (* delta 2)))
     (let* ((state     (vector-ref ___stack ___sp))
       (___checkstack)
       (vector-set! ___stack ___sp new-state)
       (vector-set! ___stack (- ___sp 1) (note-source-location lvalue tok))))
-  
+
   (define (___reduce st)
     ((vector-ref ___rtable st) ___stack ___sp ___gtable ___push ___pushback))
-  
+
   (define (___shift token attribute)
     (set! ___sp (+ ___sp 2))
     (___checkstack)
     (vector-set! ___stack (- ___sp 1) attribute)
     (vector-set! ___stack ___sp token))
-  
+
   (define (___action x l)
     (let ((y (assoc x l)))
       (if y (cadr y) (cadar l))))
-  
+
   (define (___recover tok)
     (let find-state ((sp ___sp))
       (if (< sp 0)
                   (set! ___sp sp)
                   (___sync (cadr act) tok))
                 (find-state (- sp 2)))))))
-  
+
   (define (___sync state tok)
     (let ((sync-set (map car (cdr (vector-ref ___atable state)))))
       (set! ___sp (+ ___sp 4))
                   (begin
                     (___consume)
                     (skip))))))))
-  
+
   (define (___category tok)
     (if (lexical-token? tok)
         (lexical-token-category tok)
           (let* ((state (vector-ref ___stack ___sp))
                  (i     (___category ___input))
                  (act   (___action i (vector-ref ___atable state))))
-            
+
             (cond ((not (symbol? i))
                    (___errorp "Syntax error: invalid token: " ___input)
                    #f)
-             
+
                   ;; Input succesfully parsed
                   ((eq? act 'accept)
                    (vector-ref ___stack 1))
-                  
+
                   ;; Syntax error in input
                   ((eq? act '*error*)
                    (if (eq? i '*eoi*)
                                (set! ___sp 0)
                                (set! ___input '*eoi*)))
                          (loop))))
-             
+
                   ;; Shift current token on top of the stack
                   ((>= act 0)
                    (___shift act ___input)
                    (set! ___input (if (eq? i '*eoi*) '*eoi* #f))
                    (loop))
-             
+
                   ;; Reduce by rule (- act)
                   (else
                    (___reduce (- act))
                    (loop))))
-          
+
           ;; no lookahead, so check if there is a default action
           ;; that does not require the lookahead
           (let* ((state  (vector-ref ___stack ___sp))
                 (___reduce (- defact))
                 (___consume))
             (loop)))))
-  
+
 
   (lambda (lexerp errorp)
     (set! ___errorp errorp)
 
   (define ___lexerp #f)
   (define ___errorp #f)
-  
-  ;; -- Input handling 
-  
+
+  ;; -- Input handling
+
   (define *input* #f)
   (define (initialize-lexer lexer)
     (set! ___lexerp lexer)
     (set! *input* #f))
   (define (consume)
     (set! *input* (___lexerp)))
-  
+
   (define (token-category tok)
     (if (lexical-token? tok)
         (lexical-token-category tok)
         tok))
 
   ;; -- Processes (stacks) handling
-  
+
   (define *processes* '())
-  
+
   (define (initialize-processes)
     (set! *processes* '()))
   (define (add-process process)
     (set! *processes* (cons process *processes*)))
   (define (get-processes)
     (reverse *processes*))
-  
+
   (define (for-all-processes proc)
     (let ((processes (get-processes)))
       (initialize-processes)
       (for-each proc processes)))
-  
+
   ;; -- parses
   (define *parses* '())
   (define (get-parses)
     (set! *parses* '()))
   (define (add-parse parse)
     (set! *parses* (cons parse *parses*)))
-    
+
 
   (define (push delta new-category lvalue stack tok)
     (let* ((stack     (drop stack (* delta 2)))
            (state     (car stack))
            (new-state (cdr (assv new-category (vector-ref ___gtable state)))))
         (cons new-state (cons (note-source-location lvalue tok) stack))))
-  
+
   (define (reduce state stack)
     ((vector-ref ___rtable state) stack ___gtable push))
-  
+
   (define (shift state symbol stack)
     (cons state (cons symbol stack)))
-  
+
   (define (get-actions token action-list)
     (let ((pair (assoc token action-list)))
-      (if pair 
+      (if pair
           (cdr pair)
           (cdar action-list)))) ;; get the default action
-  
+
 
   (define (run)
     (let loop-tokens ()
       (if (pair? (get-processes))
           (loop-tokens))))
 
-  
+
   (lambda (lexerp errorp)
     (set! ___errorp errorp)
     (initialize-lexer lexerp)
index 71e0443892e08c1faf42b26e61c7b957f2047f08..65355d9568d48be64190a5f8422ccb03364413de 100644 (file)
@@ -1,24 +1,25 @@
-;;; Copyright (C) 1998, 2001, 2006 Free Software Foundation, Inc.
-;;; Copyright (C) 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; GNU Mes --- Maxwell Equations of Software
+;;;
+;;; Copyright © 1998, 2001, 2006 Free Software Foundation, Inc.
+;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU Mes 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 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+;;;
+;;; Taken from GNU Guile-1.8
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;;
-;; This library 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
-;; Lesser General Public License for more details.
-;;
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Author: Russ McManus (rewritten by Thien-Thi Nguyen)
-;;;                      (regexps removed by Jan (janneke) Nieuwenhuizen)
-;;;                      (srfi-9 backport by Jan (janneke) Nieuwenhuizen)
-
 ;;; Commentary:
 
 ;;; This module implements some complex command line option parsing, in
index 148c986aca6ea864bc260172a69c21a261185d85..cd3a946e4305727ed0eaa70510f1ce0d2dc55dac 100644 (file)
@@ -1,24 +1,25 @@
-;;;; optargs.scm -- support for optional arguments
-;;;;
-;;;;   Copyright (C) 1997, 1998, 1999, 2001, 2002, 2004, 2006 Free Software Foundation, Inc.
-;;;;
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library 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
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;;
-;;;; Contributed by Maciej Stachowiak <mstachow@alum.mit.edu>
-
-\f
+;;; GNU Mes --- Maxwell Equations of Software
+;;;
+;;; Copyright © 1997, 1998, 1999, 2001, 2002, 2004, 2006 Free Software Foundation, Inc.
+;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU Mes 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 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Mes 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+;;;
+;;; Taken from GNU Guile-1.8
+;;; Contributed by Maciej Stachowiak <mstachow@alum.mit.edu>
 
 ;;; Commentary: