Add mes and mescc-tools-extra

mescc-tools-extra contains two important tools:
- cp
- chmod

mes first builds itself from a mes 0.21 seed as used by guix, and then
builds a mes 0.22 and then mes 0.22 using that created mes 0.22.

It does /not/ use bootstrap.sh as we don't have a proper shell at this
point, it has been manually adapted for kaem.

sysa/mes-0.22/mes/module/srfi/srfi-9-struct.mes

@@ -0,0 +1,145 @@
+;;; -*-scheme-*-
+
+;;; GNU Mes --- Maxwell Equations of Software
+;;; 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/>.
+
+;;; Commentary:
+
+;;; srfi-9.mes - records, based on struct.
+
+(define-macro (define-record-type name constructor+params predicate . fields)
+  (let ((type (make-record-type name (map car fields))))
+   `(begin
+      (define ,name ,type)
+      (define ,(car constructor+params) ,(record-constructor type name (cdr constructor+params)))
+      (define ,predicate ,(record-predicate type))
+      (define-record-accessors ,type ,@fields))))
+
+(define (make-record-type type fields . printer)
+  (let ((printer (if (pair? printer) (car printer))))
+    (make-struct '<record-type> (cons type (list fields)) printer)))
+
+(define (record-type? o)
+  (eq? (struct-vtable o) '<record-type>))
+
+(define (struct-vtable o)
+  (struct-ref o 0))
+
+(define (record-type o)
+  (struct-ref o 2))
+
+(define (record-predicate type)
+  (lambda (o)
+    (and (record? o)
+         (eq? (record-type o) (record-type type)))))
+
+(define (record? o)
+  (and (struct? o)
+       (record-type? (struct-vtable o))))
+
+(define (record-constructor type name params)
+  (let ((fields (record-fields type))
+        (record-type (record-type type)))
+    (lambda (. o)
+      (if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
+          (let ((rest (make-list (- (length fields) (length params)))))
+            (make-struct type (cons name (append o rest)) record-printer))))))
+
+(define record-printer *unspecified*)   ; TODO
+(define (record-printer o)
+  (display "#<")
+  (display (record-type o))
+  (let* ((vtable (struct-vtable o))
+         (fields (record-fields vtable)))
+    (for-each (lambda (field)
+                (display " ")
+                (display field)
+                (display ": ")
+                (display ((record-getter vtable field) o)))
+              fields))
+  (display ">"))
+
+(define (record-fields o)
+  (struct-ref o 3))
+
+(define-macro (define-record-accessors type . fields)
+  `(begin
+     ,@(map (lambda (field)
+              `(define-record-accessor ,type ,field))
+            fields)))
+
+(define-macro (define-record-accessor type field)
+  `(begin
+     (define ,(cadr field) ,(record-getter type (car field)))
+     (if ,(pair? (cddr field))
+         (define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
+
+(define (record-getter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o . field?)
+      (if (not (eq? (record-type o) (record-type type))) (error "record getter: record expected" type o)
+          (if (pair? field?) field
+              (struct-ref o i))))))
+
+(define (record-setter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o v)
+      (if (not (eq? (record-type o) (record-type type))) (error "record setter: record expected" type o)
+          (struct-set! o i v)))))
+
+(define (record-field-index type field)
+  (+ 3 (or (lst-index (record-fields type) field)
+           (error "no such field" type field))))
+
+(define (lst-index lst o)
+  (let loop ((lst lst) (i 0))
+    (and (pair? lst)
+         (if (eq? o (car lst)) i
+             (loop (cdr lst) (1+ i))))))
+
+;; (define-record-type <employee>
+;;   (make-employee name age salary)
+;;   employee?
+;;   (name employe-name)
+;;   (age employee-age set-employee-age!)
+;;   (salary employee-salary))
+
+;; (display <employee>)
+;; (newline)
+
+;; (display make-employee)
+;; (newline)
+;; (display "employee-age ")
+;; (display employee-age)
+;; (newline)
+
+;; (display "set-employee-age! ")
+;; (display set-employee-age!)
+;; (newline)
+
+;; (define janneke (make-employee "janneke" 49 42))
+;; (display janneke)
+;; (newline)
+
+;; (display (employee-age janneke))
+;; (newline)
+
+;; (display (set-employee-age! janneke 33))
+;; (newline)
+;; (display (employee-age janneke))
+;; (newline)