kylekrein/live-bootstrap
1
0
Fork 0
mirror of https://github.com/fosslinux/live-bootstrap.git synced 2026-03-16 08:15:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add mes and mescc-tools-extra

Browse source 
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.
This commit is contained in:
fosslinux 2020-12-25 18:40:14 +11:00
parent 2706e07556
commit 649d7b68dc
1029 changed files with 120985 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

50
sysa/mes-0.22/scaffold/argv.c Normal file
View file

@ -0,0 +1,50 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,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/>.
*/
#include <mes/lib.h>
#include <string.h>
int
strcmp (char const *a, char const *b)
{
while (*a && *b && *a == *b)
{
a++;
b++;
}
return *a - *b;
}
int
main (int argc, char *argv[])
{
eputs ("Hi Mes!\n");
#if __MESC_MES__
eputs ("MESC.MES\n");
#else
eputs ("MESC.GUILE\n");
#endif
if (argc > 1 && !strcmp (argv[1], "--help"))
{
eputs ("argc > 1 && --help\n");
return argc;
}
return 42;
}

19
sysa/mes-0.22/scaffold/boot/00-zero.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
0

19
sysa/mes-0.22/scaffold/boot/01-true.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
#t

25
sysa/mes-0.22/scaffold/boot/02-identifier.scm Normal file
View file

@ -0,0 +1,25 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
'boo
'4a
12345
-22
+44
(list 0)
'...

19
sysa/mes-0.22/scaffold/boot/02-symbol.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
'mes

56
sysa/mes-0.22/scaffold/boot/03-big-string.scm Normal file
View file

@ -0,0 +1,56 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
"Mes is distributed WITHOUT ANY WARRANTY. The following
sections from the GNU General Public License, version 3, should
make that clear.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
See <http://www.gnu.org/licenses/gpl.html>, for more details.
"

19
sysa/mes-0.22/scaffold/boot/03-string.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
"mes"

19
sysa/mes-0.22/scaffold/boot/04-cons.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cons 0 1)

19
sysa/mes-0.22/scaffold/boot/04-quote.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(quote (0 1))

28
sysa/mes-0.22/scaffold/boot/05-big-list.scm Normal file
View file

@ -0,0 +1,28 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(list 00 01 02 03 04 05 06 07 08 09
10 11 12 13 14 15 16 17 18 19
20 21 22 23 24 25 26 27 28 29
30 31 32 33 34 35 36 37 38 39
40 41 42 43 44 45 46 47 48 49
50 51 52 53 54 55 56 57 58 59
60 61 62 63 64 65 66 67 68 69
70 71 72 73 74 75 76 77 78 79
80 81 82 83 84 85 86 87 88 89
90 91 92 93 94 95 96 97 98 99)

19
sysa/mes-0.22/scaffold/boot/05-list-list.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(list 0 1 (list 20 21) 3)

19
sysa/mes-0.22/scaffold/boot/05-list.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(list 0 1)

19
sysa/mes-0.22/scaffold/boot/06-tick.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
'(0 1)

19
sysa/mes-0.22/scaffold/boot/07-if.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if #t 0 1)

19
sysa/mes-0.22/scaffold/boot/08-if-if.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if #t (if #t 'foo))

19
sysa/mes-0.22/scaffold/boot/10-cons.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cons 0 1)

19
sysa/mes-0.22/scaffold/boot/11-list.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(list 0 1)

19
sysa/mes-0.22/scaffold/boot/11-vector.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
#(0 1 2)

19
sysa/mes-0.22/scaffold/boot/12-car.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(car '(0 1))

19
sysa/mes-0.22/scaffold/boot/13-cdr.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cdr '(0 . 1))

19
sysa/mes-0.22/scaffold/boot/14-exit.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(exit 0)

20
sysa/mes-0.22/scaffold/boot/15-display.scm Normal file
View file

@ -0,0 +1,20 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(core:display "t00\n")

20
sysa/mes-0.22/scaffold/boot/16-if-eq-quote.scm Normal file
View file

@ -0,0 +1,20 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if (if #t (eq? 0 '0)) (exit 0))
(exit 1)

25
sysa/mes-0.22/scaffold/boot/17-equal2.scm Normal file
View file

@ -0,0 +1,25 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(core:write (if (equal2? "" "") #t (exit 1)))
(core:write "\n")
(core:write (if (equal2? '("foo" "") '("foo" "")) #t (exit 1)))
(core:write "\n")
(core:write (if (equal2? '("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" "") '("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" "")) #t (exit 1)))
(core:write "\n")
(exit 0)

21
sysa/mes-0.22/scaffold/boot/17-memq-keyword.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if (memq '#:bar '(foo #:bar baz))
(exit 0))
(exit 1)

21
sysa/mes-0.22/scaffold/boot/17-memq.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if (memq 'bar '(foo bar baz))
(exit 0))
(exit 1)

36
sysa/mes-0.22/scaffold/boot/17-open-input-string.scm Normal file
View file

@ -0,0 +1,36 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
((lambda (port)
(core:display-error "port:")
(core:write-error port)
(core:display-error "\n")
(set-current-input-port port)
(core:display-error "current:")
(core:write-error (current-input-port))
(core:display-error "\n")
(core:display-error "read:")
((lambda (string)
(core:write-error string)
(core:display-error "\n")
(core:display-error "empty:")
(core:write-error port)
(core:display-error "\n")
(exit (if (equal2? string "foo bar\n") 0 1)))
((if (pair? (current-module)) read-string (@ (ice-9 rdelim) read-string)) port)))
(open-input-string "foo bar\n"))

21
sysa/mes-0.22/scaffold/boot/17-string-append.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if (string=? (string-append "foo" "/" "bar") "foo/bar")
(exit 0))
(exit 1)

23
sysa/mes-0.22/scaffold/boot/17-string-equal.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(core:write (if (string=? "" "") #t (exit 1)))
(core:write (if (string=? "foo" "foo") #t (exit 1)))
(core:write (if (string=? "" "foo") (exit 1)))
(core:write "\n")
(exit 0)

21
sysa/mes-0.22/scaffold/boot/20-define-quote.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define cell:type-alist
(list (cons <cell:char> (quote <cell:char>))))
cell:type-alist

20
sysa/mes-0.22/scaffold/boot/20-define-quoted.scm Normal file
View file

@ -0,0 +1,20 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define mes '(0 1))
mes

19
sysa/mes-0.22/scaffold/boot/20-define.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define t #t)

20
sysa/mes-0.22/scaffold/boot/21-define-procedure.scm Normal file
View file

@ -0,0 +1,20 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (not x) (if x #f #t))
(if (not #f) (exit 0) (exit 1))

22
sysa/mes-0.22/scaffold/boot/22-define-procedure-2.scm Normal file
View file

@ -0,0 +1,22 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (not x) (if x #f #t))
(define (not2 x) (if x #f #t))
(if (not #f) (exit 0) (exit 1))
(if (not2 #f) (exit 0) (exit 1))

20
sysa/mes-0.22/scaffold/boot/23-begin.scm Normal file
View file

@ -0,0 +1,20 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(begin
#t)

21
sysa/mes-0.22/scaffold/boot/24-begin-define.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(begin
(define (not x) (if x #f #t)))
(if (not #f) (exit 0) (exit 1))

23
sysa/mes-0.22/scaffold/boot/25-begin-define-2.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(begin
(define (not x) (if x #f #t))
(define (not2 x) (if x #f #t)))
(not #t)
(not2 #t)

22
sysa/mes-0.22/scaffold/boot/26-begin-define-later.scm Normal file
View file

@ -0,0 +1,22 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(begin
(define (foo) (bar))
(define (bar) 0)
(exit (bar)))

33
sysa/mes-0.22/scaffold/boot/26-define-define.scm Normal file
View file

@ -0,0 +1,33 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (x x1 x2)
(define b 1)
(define b1 1)
(define b2 1)
(define (y) b)
(define (y1) b)
(define (y2) b)
(set! b 0)
(list b (y)))
(core:display "x:")
(core:display x)
(core:display "\n")
(core:display (x 1 2))
(core:display "\n")

25
sysa/mes-0.22/scaffold/boot/27-lambda-define.scm Normal file
View file

@ -0,0 +1,25 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
((lambda (foo bar lst)
(define (next)
foo
bar
lst)
(next))
'foo 'bar '(0 1 2))

25
sysa/mes-0.22/scaffold/boot/28-define-define.scm Normal file
View file

@ -0,0 +1,25 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (f foo lst)
(define (next)
lst)
(next))
(if (eq? (f 'foo '24) 24) (exit 0))
(exit 1)

27
sysa/mes-0.22/scaffold/boot/29-lambda-define.scm Normal file
View file

@ -0,0 +1,27 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if (eq?
((lambda (foo lst)
(define (next)
foo)
(next))
'12 '(0 1 2))
12)
(exit 0))
(exit 1)

27
sysa/mes-0.22/scaffold/boot/2a-lambda-lambda.scm Normal file
View file

@ -0,0 +1,27 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(if (eq?
((lambda (foo lst)
((lambda (bar)
lst)
42))
'12 '24)
24)
(exit 0))
(exit 1)

24
sysa/mes-0.22/scaffold/boot/2b-define-lambda.scm Normal file
View file

@ -0,0 +1,24 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define f (lambda (t) t))
(f 0)
;;f

33
sysa/mes-0.22/scaffold/boot/2c-define-lambda-recurse.scm Normal file
View file

@ -0,0 +1,33 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (foo x pair?)
(core:display "foo x=") (core:display x) (core:display "\n")
(core:display " pair?=") (core:display pair?) (core:display "\n")
(if pair? ((lambda (a d)
(cons a d))
(begin
(core:display "BEFORE x=") (core:display x) (core:display "\n")
(foo (car x) #f))
(begin
(core:display "EFTER x=") (core:display x) (core:display "\n")
(foo (cdr x) #f)))
x))
(if (null? (cdr (foo '(42) #t))) (exit 0))
(exit 1)

23
sysa/mes-0.22/scaffold/boot/2d-compose.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (compose proc . rest)
(if (null? rest) proc
(lambda args
(proc (core:apply (core:apply compose rest) args)))))
(exit ((compose car cdr car) '((1 0 2))))

23
sysa/mes-0.22/scaffold/boot/2d-define-lambda-set.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define foo #f)
((lambda (bar)
(set! foo (lambda () bar)))
0)
(exit (foo))

34
sysa/mes-0.22/scaffold/boot/2e-define-first.scm Normal file
View file

@ -0,0 +1,34 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define display core:display)
(define write core:write)
(define (foo doit bar)
(display "foo doit=")
(write doit)
(display "\n")
(display " bar=")
(write bar)
(display "\n")
(doit bar))
(foo display 1)
(foo exit 0)
(exit 1)

48
sysa/mes-0.22/scaffold/boot/2f-define-second-lambda.scm Normal file
View file

@ -0,0 +1,48 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define display core:display)
(define write core:write)
;; unmemoize removes formal caching...but only one level
(define (foo doit bar)
(define baz
(lambda (doit)
(display " baz:doit=")
(write doit)
(display " baz:bar=")
(write bar)
(display "\n")
(doit bar)))
(display "foo doit=")
(write doit)
(display "\n")
(display " bar=")
(write bar)
(display "\n")
(display " baz=")
(write baz)
(display "\n")
(baz doit))
(foo display 1)
(display "foo=")
(write foo)
(display "\n")
(foo exit 0)
(exit 1)

47
sysa/mes-0.22/scaffold/boot/2f-define-second.scm Normal file
View file

@ -0,0 +1,47 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define display core:display)
(define write core:write)
;; unmemoize removes formal caching...but only one level
(define (foo doit bar)
(define (baz doit)
(display " baz:doit=")
(write doit)
(display " baz:bar=")
(write bar)
(display "\n")
(doit bar))
(display "foo doit=")
(write doit)
(display "\n")
(display " bar=")
(write bar)
(display "\n")
(display " baz=")
(write baz)
(display "\n")
(baz doit))
(foo display 1)
(display "foo=")
(write foo)
(display "\n")
(foo exit 0)
(exit 1)

23
sysa/mes-0.22/scaffold/boot/2g-vector.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (remainder x y)
(- x (* (/ x y) y)))
(define (even? x)
(= 0 (remainder x 2)))
#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8)

20
sysa/mes-0.22/scaffold/boot/30-capture.scm Normal file
View file

@ -0,0 +1,20 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (x) 0)
(exit (x))

21
sysa/mes-0.22/scaffold/boot/31-capture-define.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (x) 0)
(define y (x))
(exit y)

21
sysa/mes-0.22/scaffold/boot/32-capture-modify-close.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (x) 0)
(exit (x))
(set! x (lambda () 1))

23
sysa/mes-0.22/scaffold/boot/33-procedure-override-close.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define core:exit exit)
(define (x) 0)
(core:display "x=") (core:display (x)) (core:display "\n")
(exit (x))
(define (exit x) (core:exit 1))

21
sysa/mes-0.22/scaffold/boot/34-cdr-override-close.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (x) 0)
(exit (x))
(define (x) 1)

23
sysa/mes-0.22/scaffold/boot/35-closure-modify.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define x 1)
(define (f) x)
(set! x 0)
(exit (f))

22
sysa/mes-0.22/scaffold/boot/36-closure-override.scm Normal file
View file

@ -0,0 +1,22 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (x) 1)
(define (f) (x))
(define (x) 0)
(exit (f))

62
sysa/mes-0.22/scaffold/boot/37-closure-lambda.scm Normal file
View file

@ -0,0 +1,62 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (atom? x)
(if (pair? x) #f
(if (null? x) #f
#t)))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (loop first rest accum)
(core:display-error "\nloop\n first=")
(core:write-error first)
(core:display-error "\n")
(core:display-error " rest=")
(core:write-error rest)
(core:display-error "\n")
(core:display-error " accum=")
(core:write-error accum)
(core:display-error "\n")
((lambda (next)
(if (atom? first)
(next (cons (cons first
(car rest)) accum))
(if (null? rest)
accum
(next accum))))
(lambda (a)
(core:display-error "\nnext a=")
(core:write-error a)
(core:display-error "\n")
(core:display-error " rest=")
(core:write-error rest)
(core:display-error "\n")
(if (null? (cdr rest))
a
(loop (cadr rest) (cddr rest) a)))))
(loop 'functions '(() 'globals ()) '())

70
sysa/mes-0.22/scaffold/boot/38-simple-format.scm Normal file
View file

@ -0,0 +1,70 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (not x) (if x #f #t))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define (boolean? x)
(or (eq? x #f) (eq? x #t)))
(define (display x . rest)
(if (null? rest) (core:display x)
(core:display-port x (car rest))))
(define (write x . rest)
(if (null? rest) (core:write x)
(core:write-port x (car rest))))
(define (cadr x) (car (cdr x)))
(define (cddr x) (cdr (cdr x)))
;;(define (current-output-port) 1)
(define (simple-format destination format . rest)
((lambda (port lst)
(define (simple-format lst args)
(if (pair? lst)
((lambda (c)
(if (not (eq? c #\~)) (begin (write-char (car lst) port)
(simple-format (cdr lst) args))
((lambda (c)
(if (or (eq? c #\A)
(eq? c #\a))
(display (car args) port)
(if (or (eq? c #\S)
(eq? c #\s))
(write (car args) port)
(write (car args) port)))
(simple-format (cddr lst) (cdr args)))
(cadr lst))))
(car lst))))
(if destination (simple-format lst rest)
(with-output-to-string
(lambda () (simple-format lst rest)))))
(if (boolean? destination) (current-output-port) destination)
;;(string->list format)
format))
;;(simple-format 2 "~A:~A: parse failed at state ~A, on input ~S\n" "<stdin>" 1 59 "(")
(simple-format #t '(#\~ #\A #\: #\~ #\A #\: #\space #\p #\a #\r #\s #\e #\space #\f #\a #\i #\l #\e #\d #\space #\a #\t #\space #\s #\t #\a #\t #\e #\space #\~ #\A #\, #\space #\o #\n #\space #\i #\n #\p #\u #\t #\space #\~ #\S #\newline) "<stdin>" 1 59 "(")

21
sysa/mes-0.22/scaffold/boot/39-global-define-override.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (read) 1)
(define read (lambda () 0))
(exit (read))

23
sysa/mes-0.22/scaffold/boot/3a-global-define-lambda-override.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (read) 1)
(exit
((lambda ()
(define read (lambda () 0))
(read))))

20
sysa/mes-0.22/scaffold/boot/40-define-macro.scm Normal file
View file

@ -0,0 +1,20 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (when exp . body)
(list 'if exp (cons 'begin body)))

24
sysa/mes-0.22/scaffold/boot/41-when.scm Normal file
View file

@ -0,0 +1,24 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (when exp . body)
(list 'if exp (cons 'begin body)))
(when #t
(exit 0))
(exit 1)

22
sysa/mes-0.22/scaffold/boot/42-if-when.scm Normal file
View file

@ -0,0 +1,22 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (foo bar)
(list 'begin bar))
(if #t (foo 3))

35
sysa/mes-0.22/scaffold/boot/43-or.scm Normal file
View file

@ -0,0 +1,35 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define (f a)
(or #t a))
(define-macro (foo bar)
(list 'f bar))
(foo 3)
(if #t (foo 3))

27
sysa/mes-0.22/scaffold/boot/44-or-if.scm Normal file
View file

@ -0,0 +1,27 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(or #t (if #t 'false))

31
sysa/mes-0.22/scaffold/boot/45-pass-if.scm Normal file
View file

@ -0,0 +1,31 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define result
(lambda (. t)
(core:display "result: t=")
(core:display t)
(core:display "\n")))
(define-macro (pass-if name t)
(list
'begin
(list core:display "test: ") (list core:display name)
(list (quote result) t)))
(pass-if "first dummy" #t)

61
sysa/mes-0.22/scaffold/boot/46-report.scm Normal file
View file

@ -0,0 +1,61 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define display core:display)
(define write core:write)
(define (newline) (display "\n"))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define (cadr x) (car (cdr x)))
(define (not x) (if x #f #t))
(define result
((lambda (pass fail)
(lambda (. t)
(if (or (null? t) (eq? (car t) 'result)) (list pass fail)
(if (eq? (car t) 'report)
(begin
((lambda (expect)
(newline)
(display "passed: ") (display pass) (newline)
(display "failed: ") (display fail) (newline)
(if (not (eq? expect 0)) (begin (display "expect: ") (write expect) (newline)))
(display "total: ") (display (+ pass fail)) (newline)
(exit (if (eq? expect fail) 0 fail)))
(begin
(if (null? (cdr t)) 0 (cadr t)))))
(if (car t) (begin (display ": pass") (newline) (set! pass (+ pass 1)))
(begin (display ": fail") (newline) (set! fail (+ fail 1))))))))
0 0))
(define-macro (pass-if name t)
(list
'begin
(list display "test: ") (list display name)
(list (quote result) t)))
(pass-if "first dummy" #t)
(result 'report 1)

36
sysa/mes-0.22/scaffold/boot/47-pass-if-eq.scm Normal file
View file

@ -0,0 +1,36 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define result
(lambda (. t)
(core:display "result: t=")
(core:display t)
(core:display "\n")))
(define-macro (pass-if name t)
(list
'begin
(list core:display "test: ") (list core:display name)
(list (quote result) t)))
(define-macro (pass-if-eq name expect . body)
(list 'pass-if name (list eq? expect (cons 'begin body))))
(pass-if-eq "if" 'true (if #t 'foo))
(result 'report)

32
sysa/mes-0.22/scaffold/boot/48-let.scm Normal file
View file

@ -0,0 +1,32 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define (cadr x) (car (cdr x)))
(define-macro (let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(let ((x 0)) x)
(let ((y 0)) y)
(exit (let ((xx 0)) xx))
(exit 1)

22
sysa/mes-0.22/scaffold/boot/49-macro-override.scm Normal file
View file

@ -0,0 +1,22 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (when exp . body)
#t)
(define-macro (when test . rest)
(list 'if test (cons 'begin rest)))

27
sysa/mes-0.22/scaffold/boot/4a-define-macro-define-macro.scm Normal file
View file

@ -0,0 +1,27 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (foo)
(list 'define-macro (list 'bar)
(list 'define-macro (list 'append)
42)
#t))
(foo)
(bar)
(append)

25
sysa/mes-0.22/scaffold/boot/4b-define-macro-define.scm Normal file
View file

@ -0,0 +1,25 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (foo)
(list 'lambda (list 'exp 'r)
(list 'define '%input (list 'r ''*input*))
'exp))
((foo) 'bla (lambda (x0) x0))

161
sysa/mes-0.22/scaffold/boot/4c-quasiquote.scm Normal file
View file

@ -0,0 +1,161 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (vector? x)
(eq? (core:type x) <cell:vector>))
(define-macro (cond . clauses)
(list 'if (pair? clauses)
(list (cons
'lambda
(cons
'(test)
(list (list 'if 'test
(if (pair? (cdr (car clauses)))
(if (eq? (car (cdr (car clauses))) '=>)
(append2 (cdr (cdr (car clauses))) '(test))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(if (pair? (cdr clauses))
(cons 'cond (cdr clauses)))))))
(car (car clauses)))))
(define else #t)
(define append append2)
(define (not x) (if x #f #t))
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (cons (quote and) (cdr x))
#f))))
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
;; (define (quasiquote-expand x)
;; (core:display "quasiquote-expand x=") (core:display x) (core:display "\n")
;; (cond ((null? x)
;; (core:display "NULL\n")
;; '())
;; ((vector? x)
;; (core:display "vector\n")
;; (list 'list->vector (quasiquote-expand (vector->list x))))
;; ((not (pair? x))
;; (core:display "NOT a pair\n")
;; (cons 'quote (cons x '())))
;; ((eq? (car x) 'quasiquote) (quasiquote-expand (quasiquote-expand
;; (if (null? (cddr x)) (cadr x)
;; (cons 'list (cdr x))))))
;; ((eq? (car x) 'unquote) (if (null? (cddr x)) (cadr x)
;; (cons 'list (cdr x))))
;; ((and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
;; ((lambda (d)
;; (if (null? (cddar x)) (list 'append (cadar x) d)
;; (list 'quote (append (cdar x) d))))
;; (quasiquote-expand (cdr x))))
;; (else
;; (core:display "ELSje\n")
;; (core:display "CAR x=") (core:display (car x))
;; (core:display "\n")
;; (core:display "CDR x=") (core:display (cdr x))
;; (core:display "\n")
;; ((lambda (a d)
;; (core:display " a=") (core:display a) (core:display "\n")
;; (core:display " d=") (core:display d)
;; (if (pair? d)
;; (if (eq? (car d) 'quote)
;; (if (and (pair? a) (eq? (car a) 'quote))
;; (list 'quote (cons (cadr a) (cadr d)))
;; (if (null? (cadr d))
;; (list 'list a)
;; (list 'cons* a d)))
;; (if (memq (car d) '(list cons*))
;; (cons (car d) (cons a (cdr d)))
;; (list 'cons* a d)))
;; (list 'cons* a d)))
;; (quasiquote-expand (car x))
;; (list 'quasiquote-expand (list 'cdr x))))))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (cadar x) (car (cdr (car x))))
(define (cddar x) (cdr (cdr (car x))))
(define (quasiquote-expand x)
(core:display "quasiquote-expand x=") (core:display x) (core:display "\n")
(cond ((vector? x) (list 'list->vector (quasiquote-expand (vector->list x))))
((not (pair? x)) (cons 'quote (cons x '())))
((eq? (car x) 'quasiquote) (quasiquote-expand (quasiquote-expand
(if (null? (cddr x)) (cadr x)
(cons 'list (cdr x))))))
((eq? (car x) 'unquote) (if (null? (cddr x)) (cadr x)
(cons 'list (cdr x))))
((and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
((lambda (d)
(if (null? (cddar x)) (list 'append (cadar x) d)
(list 'quote (append (cdar x) d))))
(quasiquote-expand (cdr x))))
(else
(core:display "ELSje\n")
(core:display "CAR x=") (core:display (car x))
(core:display "\n")
(core:display "CDR x=") (core:display (cdr x))
(core:display "\n")
((lambda (a d)
(core:display "CAR a=") (core:display a)
(core:display "\n")
(core:display "CDR d=") (core:display d)
(core:display "\n")
(if (pair? d)
(if (eq? (car d) 'quote)
(if (and (pair? a) (eq? (car a) 'quote))
(list 'quote (cons (cadr a) (cadr d)))
(if (null? (cadr d))
(list 'list a)
(list 'cons* a d)))
(if (memq (car d) '(list cons*))
(cons (car d) (cons a (cdr d)))
(list 'cons* a d)))
(list 'cons* a d)))
(quasiquote-expand (car x))
(quasiquote-expand (cdr x))
))))
(define-macro (quasiquote x)
(quasiquote-expand x))
;; (define (remainder x y)
;; (- x (* (/ x y) y)))
;; (define (even? x)
;; (eq? 0 (remainder x v2)))
;; (pass-if-equal "qq 4" '#(10 5 #t #t #f #f #f 8)
;; `#(10 5 ,(even? 4) ,@(map even? '(2 3 5 7)) 8))
;;(core:display (quasiquote #(42)))
(core:display (quasiquote-expand #(42)))

39
sysa/mes-0.22/scaffold/boot/4d-let-map.scm Normal file
View file

@ -0,0 +1,39 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define map 'boo)
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define (cadr x) (car (cdr x)))
(define-macro (let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(let ((a 0)
(b 1)
(c 2)
(d 3)
(e 4)
(f 5)
(g 6)
(h 7)
(i 8))
(+ a b))

33
sysa/mes-0.22/scaffold/boot/4e-let-global.scm Normal file
View file

@ -0,0 +1,33 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (cadr x) (car (cdr x)))
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define-macro (let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(define (list-length list)
(let ((length (length list)))
(- length 2)))
(exit (list-length '(bar baz)))

106
sysa/mes-0.22/scaffold/boot/4f-string-split.scm Normal file
View file

@ -0,0 +1,106 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (symbol? x)
(eq? (core:type x) <cell:symbol>))
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define-macro (simple-let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
;; (define-macro (xsimple-let bindings rest)
;; `(,`(lambda ,(map car bindings) ,@rest)
;; ,@(map cadr bindings)))
(define-macro (xsimple-let bindings rest)
(cons* (cons* (quote lambda)
(map car bindings) (append2 rest (quote ())))
(append2 (map cadr bindings) (quote ()))))
;; (define-macro (xnamed-let name bindings rest)
;; `(simple-let ((,name *unspecified*))
;; (set! ,name (lambda ,(map car bindings) ,@rest))
;; (,name ,@(map cadr bindings))))
(define-macro (xnamed-let name bindings rest)
(list (quote simple-let)
(list (cons* name (quote (*unspecified*))))
(list (quote set!)
name
(cons* (quote lambda)
(map car bindings)
(append2 rest (quote ()))))
(cons* name (append2 (map cadr bindings) (quote ())))))
;; (define-macro (let bindings-or-name . rest)
;; (if (symbol? bindings-or-name)
;; `(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
;; `(xsimple-let ,bindings-or-name ,rest)))
(define-macro (let bindings-or-name . rest)
(if (symbol? bindings-or-name) (list (quote xnamed-let) bindings-or-name (car rest) (cdr rest))
(list (quote xsimple-let) bindings-or-name rest)))
(define ss-memq-inner #f)
(define (ss-memq x lst)
(if (null? lst) #f ;; IF
(if (eq? x (car lst)) lst
(ss-memq-inner x (cdr lst)))))
(define (ss-memq-inner x lst)
(if (null? lst) #f ;; IF
(if (eq? x (car lst)) lst
(ss-memq-inner x (cdr lst)))))
(define (ss-list-head x n)
(if (= 0 n) '()
(cons (car x) (ss-list-head (cdr x) (- n 1)))))
;; (define (foo x y)
;; (cons x y))
;; (define (ss-list-head x n)
;; (if (= 0 n) '()
;; (foo (car x) (ss-list-head (cdr x) (- n 1)))))
(define (not x) (if x #f #t))
(define (string-split s c)
(let loop ((lst (string->list s)) (result '()))
(let ((rest (ss-memq c lst)))
(if (not rest) (append2 result (list (list->string lst)))
(loop (cdr rest)
(append2 result
(list (list->string (ss-list-head lst (- (length lst) (length rest)))))))))))
(core:display-error "*START*\n")
(string-split "foo bar" #\space)
(string-split "baz bla" #\space)

23
sysa/mes-0.22/scaffold/boot/50-keyword.scm Normal file
View file

@ -0,0 +1,23 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(core:display-error "symbol->keyword\n")
(core:write (symbol->keyword 'foo))
(core:display-error "\n")
(core:write (keyword->string #:bar))
(core:display-error "dun\n")

50
sysa/mes-0.22/scaffold/boot/50-make-string.scm Normal file
View file

@ -0,0 +1,50 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cond-expand
(guile)
(mes
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define (string . lst)
(list->string lst))))
(define (make-list n . fill)
fill)
(define (make-string n . fill)
(list->string (apply make-list n fill)))
;;(make-string 1 (option-spec->single-char spec))
(core:write-error (make-string 1 #\a))
;;(core:write-error (list->string '(#\a #\b #\c)))
;; (if (string=? (string-append "foo" "/" "bar") "foo/bar")
;; (exit 0))
;; (exit 1)

35
sysa/mes-0.22/scaffold/boot/50-primitive-load.scm Normal file
View file

@ -0,0 +1,35 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cond-expand
(guile)
(mes
(define-macro (include-from-path file)
(list
'begin
(list 'primitive-load file)))))
(include-from-path "scaffold/boot/data/i.scm")
(core:display "from-i:")
(core:display from-i)
(core:display "\n")
(core:display "from-i-macro")
(core:display (from-i-macro))
(core:display "\n")

50
sysa/mes-0.22/scaffold/boot/50-string-join.scm Normal file
View file

@ -0,0 +1,50 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cond-expand
(guile)
(mes
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define (string . lst)
(list->string lst))
(define (map1 f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst)))))
(define map map1)))
(define (string-join lst infix)
(if (null? (cdr lst)) (car lst)
(string-append (car lst) infix (string-join (cdr lst) infix))))
(if (string=? (string-join '("foo" "bar") "/") "foo/bar")
(exit 0))
(exit 1)

87
sysa/mes-0.22/scaffold/boot/51-module.scm Normal file
View file

@ -0,0 +1,87 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cond-expand
(guile)
(mes
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(core:display-error "append rest=")
(core:write-error rest)
(core:display-error "\n")
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (cons (quote and) (cdr x))
#f))))
(define (string . lst)
(list->string lst))
(define (not x) (if x #f #t))
(define (map1 f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst)))))
(define map map1)
(define %moduledir (string-append %datadir "/module/"))
(define-macro (load file)
(list 'begin
(list 'if (list getenv "MES_DEBUG")
(list 'begin
(list core:display-error ";;; read ")
(list core:display-error file)
(list core:display-error "\n")))
(list 'primitive-load file)))
(define-macro (include-from-path file)
(list 'load (list string-append %moduledir file)))
(define (getcwd) ".")
(define (display x . rest)
(if (null? rest) (core:display x)
(core:display-port x (car rest))))))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
(define (string-join lst infix)
(if (null? (cdr lst)) (car lst)
(string-append (car lst) infix (string-join (cdr lst) infix))))
(include-from-path "mes/module.mes")
(core:display-error module->file) (core:display-error "\n")
(define %moduledir (string-append (getcwd) "/"))
(mes-use-module (scaffold boot data module))
;; (mes-use-module (scaffold boot data module))

77
sysa/mes-0.22/scaffold/boot/52-define-module.scm Normal file
View file

@ -0,0 +1,77 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cond-expand
(guile
)
(mes
;;;;;;;;;;;;;;;
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (cons (quote and) (cdr x))
#f))))
(define (string . lst)
(list->string lst))
(define (map1 f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst)))))
(define map map1)
;;;;;;;;;;;;;;;;;;
(define (string-join lst infix)
(if (null? (cdr lst)) (car lst)
(string-append (car lst) infix (string-join (cdr lst) infix))))
;;;;;;;;;;;;;;;;;;
(define-macro (load file)
(list 'primitive-load file))
(define (not x) (if x #f #t))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
))
(define %moduledir "./")
(core:display-error "reading...\n")
(primitive-load "mes/module/mes/module.mes")
(core:display-error "dun\n")
(core:write-error (map symbol->string '(scaffold boot data bar)))
(core:display-error "\n")
(core:write-error (string-join (map symbol->string '(scaffold boot data bar)) "/"))
(core:display-error "\n")
(mes-use-module (scaffold boot data bar))

58
sysa/mes-0.22/scaffold/boot/53-closure-display.scm Normal file
View file

@ -0,0 +1,58 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cond-expand
(guile
(define closure identity))
(mes
(define display core:display)
(define write core:write)
(define (newline) (display "\n"))
(define (cadr x) (car (cdr x)))
(define (map f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst)))))
(define (closure x)
(map car (cdr (core:cdr (core:car (core:cdr (cdr (module-variable (current-module) 'x))))))))))
(define (x t) #t)
(define (xx x1 x2)
(define blabla 4)
(define (blubblub) 5)
#t)
(newline)
(display "x:")
(display x)
(newline)
(newline)
(display "xx:")
(display xx)
(newline)
(display "closure:")
(display closure)
(newline)
(display "closure xx:")
(write (closure xx))
(display "\n")
(xx 0 1)
(display " => closure xx:")
(write (closure xx))
(display "\n")

547
sysa/mes-0.22/scaffold/boot/60-let-syntax-expanded.scm Normal file
View file

@ -0,0 +1,547 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
;; boot-00.scm
(define mes %version)
(define (defined? x)
(module-variable (current-module) x))
(define (cond-expand-expander clauses)
(if (defined? (car (car clauses)))
(cdr (car clauses))
(cond-expand-expander (cdr clauses))))
(define-macro (cond-expand . clauses)
(cons 'begin (cond-expand-expander clauses)))
;; end boot-00.scm
;; boot-01.scm
(define <cell:character> 0)
(define <cell:pair> 7)
(define <cell:string> 10)
(define (not x) (if x #f #t))
(define (display x . rest)
(if (null? rest) (core:display x)
(core:display-port x (car rest))))
(define (write x . rest)
(if (null? rest) (core:write x)
(core:write-port x (car rest))))
(define (integer->char x)
(core:make-cell <cell:character> 0 x))
(define (newline . rest)
(core:display (list->string (list (integer->char 10)))))
(define (string->list s)
(core:car s))
(define (cadr x) (car (cdr x)))
(define (map1 f lst)
(if (null? lst) (list)
(cons (f (car lst)) (map1 f (cdr lst)))))
(define map map1)
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
;; end boot-01.scm
;;((lambda (*program*) *program*) (primitive-load 0))
;;(primitive-load 0)
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (cons (quote and) (cdr x))
#f))))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define else #t)
(define-macro (cond . clauses)
(list 'if (pair? clauses)
(list (cons
'lambda
(cons
'(test)
(list (list 'if 'test
(if (pair? (cdr (car clauses)))
(if (eq? (car (cdr (car clauses))) '=>)
(append2 (cdr (cdr (car clauses))) '(test))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(if (pair? (cdr clauses))
(cons 'cond (cdr clauses)))))))
(car (car clauses)))))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
(define <cell:symbol> 11)
(define (symbol? x)
(eq? (core:type x) <cell:symbol>))
(define <cell:string> 10)
(define (string? x)
(eq? (core:type x) <cell:string>))
(define <cell:vector> 14)
(define (vector? x)
(eq? (core:type x) <cell:vector>))
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define-macro (quasiquote x)
(define (loop x)
(if (vector? x) (list 'list->vector (loop (vector->list x)))
(if (not (pair? x)) (cons 'quote (cons x '()))
(if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))
(if (eq? (car x) 'unquote) (cadr x)
(if (and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
((lambda (d)
(list 'append (car (cdr (car x))) d))
(loop (cdr x)))
((lambda (a d)
(if (pair? d)
(if (eq? (car d) 'quote)
(if (and (pair? a) (eq? (car a) 'quote))
(list 'quote (cons (cadr a) (cadr d)))
(if (null? (cadr d))
(list 'list a)
(list 'cons* a d)))
(if (memq (car d) '(list cons*))
(cons (car d) (cons a (cdr d)))
(list 'cons* a d)))
(list 'cons* a d)))
(loop (car x))
(loop (cdr x)))))))))
(loop x))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define-macro (simple-let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(define-macro (xsimple-let bindings rest)
`(,`(lambda ,(map car bindings) ,@rest)
,@(map cadr bindings)))
(define-macro (xnamed-let name bindings rest)
`(simple-let ((,name *unspecified*))
(set! ,name (lambda ,(map car bindings) ,@rest))
(,name ,@(map cadr bindings))))
(define-macro (let bindings-or-name . rest)
(if (symbol? bindings-or-name) ;; IF
`(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
`(xsimple-let ,bindings-or-name ,rest)))
(define (expand-let* bindings body)
(if (null? bindings)
`((lambda () ,@body))
`((lambda (,(caar bindings))
,(expand-let* (cdr bindings) body))
,@(cdar bindings))))
(define-macro (let* bindings . body)
(expand-let* bindings body))
(define (equal2? a b)
(if (and (null? a) (null? b)) #t
(if (and (pair? a) (pair? b))
(and (equal2? (car a) (car b))
(equal2? (cdr a) (cdr b)))
(if (and (string? a) (string? b))
(string=? a b)
(if (and (vector? a) (vector? b))
(equal2? (vector->list a) (vector->list b))
(eq? a b))))))
(define equal? equal2?)
(define (member x lst)
(if (null? lst) #f
(if (equal2? x (car lst)) lst
(member x (cdr lst)))))
(define (<= . rest)
(or (apply < rest)
(apply = rest)))
(define (>= . rest)
(or (apply > rest)
(apply = rest)))
(define (list? x)
(or (null? x)
(and (pair? x) (list? (cdr x)))))
(cond-expand
(guile)
(mes
(define (boolean? x)
(or (eq? x #f) (eq? x #t)))
(define (char? x)
(and (eq? (core:type x) <cell:char>)
(> (char->integer x) -1)))))
;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
;;; Copyright © 2016 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:
;;; syntax.mes is loaded after scm.mes. It provides the R5RS hygienic
;;; macros define-syntax, syntax-rules and define-syntax-rule.
;;; syntax-rules is adapted from scheme48-1.1/scheme/alt/syntax.scm
;;; Code:
;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
;;; scheme48-1.1/COPYING
;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; 3. The name of the authors may not be used to endorse or promote products
;; derived from this software without specific prior written permission.
;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(cond-expand
(guile)
(mes
(define-macro (define-syntax macro-name transformer . stuff)
`(define-macro (,macro-name . args)
(,transformer (cons ',macro-name args)
(lambda (x0) x0)
eq?)))))
;; Rewrite-rule compiler (a.k.a. "extend-syntax")
;; Example:
;;
;; (define-syntax or
;; (syntax-rules ()
;; ((or) #f)
;; ((or e) e)
;; ((or e1 e ...) (let ((temp e1))
;; (if temp temp (or e ...))))))
(cond-expand
(guile)
(mes
(define-syntax syntax-rules
(let ()
(define name? symbol?)
(define (segment-pattern? pattern)
(and (segment-template? pattern)
(or (null? (cddr pattern))
(syntax-error0 "segment matching not implemented" pattern))))
(define (segment-template? pattern)
(and (pair? pattern)
(pair? (cdr pattern))
(memq (cadr pattern) indicators-for-zero-or-more)))
(define indicators-for-zero-or-more (list (string->symbol "...") '---))
(lambda (exp r c)
(define %input (r '%input)) ;Gensym these, if you like.
(define %compare (r '%compare))
(define %rename (r '%rename))
(define %tail (r '%tail))
(define %temp (r '%temp))
(define rules (cddr exp))
(define subkeywords (cadr exp))
(define (make-transformer rules)
;;(core:display-error "make-transformer:") (core:write-error rules) (core:display-error "\n")
`(lambda (,%input ,%rename ,%compare)
(let ((,%tail (cdr ,%input)))
(cond ,@(map process-rule rules)
(else
(syntax-error1
"use of macro doesn't match definition"
,%input))))))
(define (process-rule rule)
;;(core:display-error "process-rule:") (core:write-error rule) (core:display-error "\n")
(if (and (pair? rule)
(pair? (cdr rule))
(null? (cddr rule)))
(let ((pattern (cdar rule))
(template (cadr rule)))
`((and ,@(process-match %tail pattern))
(let* ,(process-pattern pattern
%tail
(lambda (x) x))
,(process-template template
0
(meta-variables pattern 0 '())))))
(syntax-error2 "ill-formed syntax rule" rule)))
;; Generate code to test whether input expression matches pattern
(define (process-match input pattern)
;;(core:display-error "process-match:") (core:write-error input) (core:display-error "\n")
;;(core:display-error " pattern:") (core:write-error pattern) (core:display-error "\n")
(cond ((name? pattern)
(if (member pattern subkeywords)
`((,%compare ,input (,%rename ',pattern)))
`()))
((segment-pattern? pattern)
(process-segment-match input (car pattern)))
((pair? pattern)
`((let ((,%temp ,input))
(and (pair? ,%temp)
,@(process-match `(car ,%temp) (car pattern))
,@(process-match `(cdr ,%temp) (cdr pattern))))))
((or (null? pattern) (boolean? pattern) (char? pattern))
`((eq? ,input ',pattern)))
(else
`((equal? ,input ',pattern)))))
(define (process-segment-match input pattern)
;;(core:display-error "process-segment-match:") (core:write-error input) (core:display-error "\n")
;;(core:display-error " pattern:") (core:write-error pattern) (core:display-error "\n")
(let ((conjuncts (process-match '(car l) pattern)))
(if (null? conjuncts)
`((list? ,input)) ;+++
`((let loop ((l ,input))
(or (null? l)
(and (pair? l)
,@conjuncts
(loop (cdr l)))))))))
;; Generate code to take apart the input expression
;; This is pretty bad, but it seems to work (can't say why).
(define (process-pattern pattern path mapit)
;;(core:display-error "process-pattern:") (core:write-error pattern) (core:display-error "\n")
;;(core:display-error " path:") (core:write-error path) (core:display-error "\n")
(cond ((name? pattern)
(if (memq pattern subkeywords)
'()
(list (list pattern (mapit path)))))
((segment-pattern? pattern)
(process-pattern (car pattern)
%temp
(lambda (x) ;temp is free in x
(mapit (if (eq? %temp x)
path ;+++
`(map (lambda (,%temp) ,x)
,path))))))
((pair? pattern)
(append (process-pattern (car pattern) `(car ,path) mapit)
(process-pattern (cdr pattern) `(cdr ,path) mapit)))
(else '())))
;; Generate code to compose the output expression according to template
(define (process-template template rank env)
;;(core:display-error "process-template:") (core:write-error template) (core:display-error "\n")
(cond ((name? template)
(let ((probe (assq template env)))
(if probe
(if (<= (cdr probe) rank)
template
(syntax-error3 "template rank error (too few ...'s?)"
template))
`(,%rename ',template))))
((segment-template? template)
(let ((vars
(free-meta-variables (car template) (+ rank 1) env '())))
(if (null? vars)
(silent-syntax-error4 "too many ...'s" template)
(let* ((x (process-template (car template)
(+ rank 1)
env))
(gen (if (equal? (list x) vars)
x ;+++
`(map (lambda ,vars ,x)
,@vars))))
(if (null? (cddr template))
gen ;+++
`(append ,gen ,(process-template (cddr template)
rank env)))))))
((pair? template)
`(cons ,(process-template (car template) rank env)
,(process-template (cdr template) rank env)))
(else `(quote ,template))))
;; Return an association list of (var . rank)
(define (meta-variables pattern rank vars)
;;(core:display-error "meta-variables:") (core:write-error pattern) (core:display-error "\n")
(cond ((name? pattern)
(if (memq pattern subkeywords)
vars
(cons (cons pattern rank) vars)))
((segment-pattern? pattern)
(meta-variables (car pattern) (+ rank 1) vars))
((pair? pattern)
(meta-variables (car pattern) rank
(meta-variables (cdr pattern) rank vars)))
(else vars)))
;; Return a list of meta-variables of given higher rank
(define (free-meta-variables template rank env free)
;;(core:display-error "meta-variables:") (core:write-error template) (core:display-error "\n")
(cond ((name? template)
(if (and (not (memq template free))
(let ((probe (assq template env)))
(and probe (>= (cdr probe) rank))))
(cons template free)
free))
((segment-template? template)
(free-meta-variables (car template)
rank env
(free-meta-variables (cddr template)
rank env free)))
((pair? template)
(free-meta-variables (car template)
rank env
(free-meta-variables (cdr template)
rank env free)))
(else free)))
c ;ignored
;; Kludge for Scheme48 linker.
;; `(cons ,(make-transformer rules)
;; ',(find-free-names-in-syntax-rules subkeywords rules))
(make-transformer rules))))))
(cond-expand
(guile)
(mes
(define-macro (let-syntax bindings . rest)
`((lambda ()
,@(map (lambda (binding)
`(define-macro (,(car binding) . args)
(,(cadr binding) (cons ',(car binding) args)
(lambda (x0) x0)
eq?)))
bindings)
,@rest)))))
(core:display
(let-syntax ((xwhen (syntax-rules ()
((xwhen condition exp ...)
(if (not condition)
(begin exp ...))))))
(xwhen #f 42)))

452
sysa/mes-0.22/scaffold/boot/60-let-syntax.scm Normal file
View file

@ -0,0 +1,452 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (and . x)
(if (null? x) #t
(if (null? (cdr x)) (car x)
(list (quote if) (car x) (cons (quote and) (cdr x))
#f))))
(define-macro (or . x)
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list (list (quote lambda) (list (quote r))
(list (quote if) (quote r) (quote r)
(cons (quote or) (cdr x))))
(car x)))))
(define else #t)
(define-macro (cond . clauses)
(list 'if (pair? clauses)
(list (cons
'lambda
(cons
'(test)
(list (list 'if 'test
(if (pair? (cdr (car clauses)))
(if (eq? (car (cdr (car clauses))) '=>)
(append2 (cdr (cdr (car clauses))) '(test))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
(if (pair? (cdr clauses))
(cons 'cond (cdr clauses)))))))
(car (car clauses)))))
(define (memq x lst)
(if (null? lst) #f
(if (eq? x (car lst)) lst
(memq x (cdr lst)))))
(define (symbol? x)
(eq? (core:type x) <cell:symbol>))
(define (string? x)
(eq? (core:type x) <cell:string>))
(define (vector? x)
(eq? (core:type x) <cell:vector>))
(define (cons* . rest)
(if (null? (cdr rest)) (car rest)
(cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
(define (apply f h . t)
(if (null? t) (core:apply f h (current-module))
(apply f (apply cons* (cons h t)))))
(define (append . rest)
(if (null? rest) '()
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(define-macro (quasiquote x)
(define (loop x)
(if (vector? x) (list 'list->vector (loop (vector->list x)))
(if (not (pair? x)) (cons 'quote (cons x '()))
(if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))
(if (eq? (car x) 'unquote) (cadr x)
(if (and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
((lambda (d)
(list 'append (car (cdr (car x))) d))
(loop (cdr x)))
((lambda (a d)
(if (pair? d)
(if (eq? (car d) 'quote)
(if (and (pair? a) (eq? (car a) 'quote))
(list 'quote (cons (cadr a) (cadr d)))
(if (null? (cadr d))
(list 'list a)
(list 'cons* a d)))
(if (memq (car d) '(list cons*))
(cons (car d) (cons a (cdr d)))
(list 'cons* a d)))
(list 'cons* a d)))
(loop (car x))
(loop (cdr x)))))))))
(loop x))
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define-macro (simple-let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(define-macro (xsimple-let bindings rest)
`(,`(lambda ,(map car bindings) ,@rest)
,@(map cadr bindings)))
(define-macro (xnamed-let name bindings rest)
`(simple-let ((,name *unspecified*))
(set! ,name (lambda ,(map car bindings) ,@rest))
(,name ,@(map cadr bindings))))
(define-macro (let bindings-or-name . rest)
(if (symbol? bindings-or-name) ;; IF
`(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
`(xsimple-let ,bindings-or-name ,rest)))
(define (expand-let* bindings body)
(if (null? bindings)
`((lambda () ,@body))
`((lambda (,(caar bindings))
,(expand-let* (cdr bindings) body))
,@(cdar bindings))))
(define-macro (let* bindings . body)
(expand-let* bindings body))
(define (equal2? a b)
(if (and (null? a) (null? b)) #t
(if (and (pair? a) (pair? b))
(and (equal2? (car a) (car b))
(equal2? (cdr a) (cdr b)))
(if (and (string? a) (string? b))
(eq? (string->symbol a) (string->symbol b))
(if (and (vector? a) (vector? b))
(equal2? (vector->list a) (vector->list b))
(eq? a b))))))
(define equal? equal2?)
(define (member x lst)
(if (null? lst) #f
(if (equal2? x (car lst)) lst
(member x (cdr lst)))))
(define (<= . rest)
(or (apply < rest)
(apply = rest)))
(define (>= . rest)
(or (apply > rest)
(apply = rest)))
(define (list? x)
(or (null? x)
(and (pair? x) (list? (cdr x)))))
;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
;;; Copyright © 2016 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:
;;; syntax.mes is loaded after scm.mes. It provides the R5RS hygienic
;;; macros define-syntax, syntax-rules and define-syntax-rule.
;;; syntax-rules is adapted from scheme48-1.1/scheme/alt/syntax.scm
;;; Code:
;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
;;; scheme48-1.1/COPYING
;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.
;; 3. The name of the authors may not be used to endorse or promote products
;; derived from this software without specific prior written permission.
;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(cond-expand
(guile)
(mes
(define-macro (define-syntax macro-name transformer . stuff)
`(define-macro (,macro-name . args)
(,transformer (cons ',macro-name args)
(lambda (x0) x0)
eq?)))))
;; Rewrite-rule compiler (a.k.a. "extend-syntax")
;; Example:
;;
;; (define-syntax or
;; (syntax-rules ()
;; ((or) #f)
;; ((or e) e)
;; ((or e1 e ...) (let ((temp e1))
;; (if temp temp (or e ...))))))
(cond-expand
(guile)
(mes
(define-syntax syntax-rules
(let ()
(define name? symbol?)
(define (segment-pattern? pattern)
(and (segment-template? pattern)
(or (null? (cddr pattern))
(syntax-error "segment matching not implemented" pattern))))
(define (segment-template? pattern)
(and (pair? pattern)
(pair? (cdr pattern))
(memq (cadr pattern) indicators-for-zero-or-more)))
(define indicators-for-zero-or-more (list (string->symbol "...") '---))
(lambda (exp r c)
(define %input (r '%input)) ;Gensym these, if you like.
(define %compare (r '%compare))
(define %rename (r '%rename))
(define %tail (r '%tail))
(define %temp (r '%temp))
(define rules (cddr exp))
(define subkeywords (cadr exp))
(define (make-transformer rules)
;;(core:display-error "make-transformer:") (core:write-error rules) (core:display-error "\n")
`(lambda (,%input ,%rename ,%compare)
(let ((,%tail (cdr ,%input)))
(cond ,@(map process-rule rules)
(else
(syntax-error
"use of macro doesn't match definition"
,%input))))))
(define (process-rule rule)
;;(core:display-error "process-rule:") (core:write-error rule) (core:display-error "\n")
(if (and (pair? rule)
(pair? (cdr rule))
(null? (cddr rule)))
(let ((pattern (cdar rule))
(template (cadr rule)))
`((and ,@(process-match %tail pattern))
(let* ,(process-pattern pattern
%tail
(lambda (x) x))
,(process-template template
0
(meta-variables pattern 0 '())))))
(syntax-error "ill-formed syntax rule" rule)))
;; Generate code to test whether input expression matches pattern
(define (process-match input pattern)
;;(core:display-error "process-match:") (core:write-error input) (core:display-error "\n")
;;(core:display-error " pattern:") (core:write-error pattern) (core:display-error "\n")
(cond ((name? pattern)
(if (member pattern subkeywords)
`((,%compare ,input (,%rename ',pattern)))
`()))
((segment-pattern? pattern)
(process-segment-match input (car pattern)))
((pair? pattern)
`((let ((,%temp ,input))
(and (pair? ,%temp)
,@(process-match `(car ,%temp) (car pattern))
,@(process-match `(cdr ,%temp) (cdr pattern))))))
((or (null? pattern) (boolean? pattern) (char? pattern))
`((eq? ,input ',pattern)))
(else
`((equal? ,input ',pattern)))))
(define (process-segment-match input pattern)
;;(core:display-error "process-segment-match:") (core:write-error input) (core:display-error "\n")
;;(core:display-error " pattern:") (core:write-error pattern) (core:display-error "\n")
(let ((conjuncts (process-match '(car l) pattern)))
(if (null? conjuncts)
`((list? ,input)) ;+++
`((let loop ((l ,input))
(or (null? l)
(and (pair? l)
,@conjuncts
(loop (cdr l)))))))))
;; Generate code to take apart the input expression
;; This is pretty bad, but it seems to work (can't say why).
(define (process-pattern pattern path mapit)
;;(core:display-error "process-pattern:") (core:write-error pattern) (core:display-error "\n")
;;(core:display-error " path:") (core:write-error path) (core:display-error "\n")
(cond ((name? pattern)
(if (memq pattern subkeywords)
'()
(list (list pattern (mapit path)))))
((segment-pattern? pattern)
(process-pattern (car pattern)
%temp
(lambda (x) ;temp is free in x
(mapit (if (eq? %temp x)
path ;+++
`(map (lambda (,%temp) ,x)
,path))))))
((pair? pattern)
(append (process-pattern (car pattern) `(car ,path) mapit)
(process-pattern (cdr pattern) `(cdr ,path) mapit)))
(else '())))
;; Generate code to compose the output expression according to template
(define (process-template template rank env)
;;(core:display-error "process-template:") (core:write-error template) (core:display-error "\n")
(cond ((name? template)
(let ((probe (assq template env)))
(if probe
(if (<= (cdr probe) rank)
template
(syntax-error "template rank error (too few ...'s?)"
template))
`(,%rename ',template))))
((segment-template? template)
(let ((vars
(free-meta-variables (car template) (+ rank 1) env '())))
(if (null? vars)
(silent-syntax-error "too many ...'s" template)
(let* ((x (process-template (car template)
(+ rank 1)
env))
(gen (if (equal? (list x) vars)
x ;+++
`(map (lambda ,vars ,x)
,@vars))))
(if (null? (cddr template))
gen ;+++
`(append ,gen ,(process-template (cddr template)
rank env)))))))
((pair? template)
`(cons ,(process-template (car template) rank env)
,(process-template (cdr template) rank env)))
(else `(quote ,template))))
;; Return an association list of (var . rank)
(define (meta-variables pattern rank vars)
;;(core:display-error "meta-variables:") (core:write-error pattern) (core:display-error "\n")
(cond ((name? pattern)
(if (memq pattern subkeywords)
vars
(cons (cons pattern rank) vars)))
((segment-pattern? pattern)
(meta-variables (car pattern) (+ rank 1) vars))
((pair? pattern)
(meta-variables (car pattern) rank
(meta-variables (cdr pattern) rank vars)))
(else vars)))
;; Return a list of meta-variables of given higher rank
(define (free-meta-variables template rank env free)
;;(core:display-error "meta-variables:") (core:write-error template) (core:display-error "\n")
(cond ((name? template)
(if (and (not (memq template free))
(let ((probe (assq template env)))
(and probe (>= (cdr probe) rank))))
(cons template free)
free))
((segment-template? template)
(free-meta-variables (car template)
rank env
(free-meta-variables (cddr template)
rank env free)))
((pair? template)
(free-meta-variables (car template)
rank env
(free-meta-variables (cdr template)
rank env free)))
(else free)))
c ;ignored
;; Kludge for Scheme48 linker.
;; `(cons ,(make-transformer rules)
;; ',(find-free-names-in-syntax-rules subkeywords rules))
(make-transformer rules))))))
(cond-expand
(guile)
(mes
(define-macro (let-syntax bindings . rest)
`((lambda ()
,@(map (lambda (binding)
`(define-macro (,(car binding) . args)
(,(cadr binding) (cons ',(car binding) args)
(lambda (x0) x0)
eq?)))
bindings)
,@rest)))))
(core:display
(let-syntax ((xwhen (syntax-rules ()
((xwhen condition exp ...)
(if (not condition)
(begin exp ...))))))
(xwhen #f 42)))

60
sysa/mes-0.22/scaffold/boot/call-cc.scm Normal file
View file

@ -0,0 +1,60 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
;; ,expand (let loop ((i 10)) (if (eq? i 0) 0 (begin (core:display-error i) (core:display-error "\n") (loop (- i 1)))))
;; (let loop ((i 10)) (if (eq? i 0) 0 (begin (display i) (display "\n") (loop (- i 1)))))
(define global "global\n")
(define v #(0 1 2))
(define vv #(#(0 1 2) 0 1 2))
((lambda (loop)
(set! loop
(lambda (i)
(core:display global)
(core:display (values 'foobar global))
(core:display v)
(core:display vv)
(core:display "i=")
(core:display i)
(core:display "\n")
(if (eq? i 0) 0
(begin
((lambda (cont seen?)
(+ 1 (call-with-current-continuation (lambda (c) (set! cont c) 1)))
(core:display " seen?=")
(core:display seen?)
(core:display "\n")
(if seen? 0
(begin
(set! seen? #t)
(cont 2))))
#f #f)
(loop (- i 1))))))
(loop 10000))
*unspecified*)
;; ((lambda (cont seen?)
;; (+ 1 (call-with-current-continuation (lambda (c) (set! cont c) 1)))
;; (core:display "seen?=")
;; (core:display seen?)
;; (core:display "\n")
;; (if seen? 0
;; (begin
;; (set! seen? #t)
;; (cont 2))))
;; #f #f)

24
sysa/mes-0.22/scaffold/boot/data/bar.mes Normal file
View file

@ -0,0 +1,24 @@
;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(define-macro (define-module module . rest) #t)
(define-module (ice-9 optargs)
#t)
(core:display-error "bar!\n")

21
sysa/mes-0.22/scaffold/boot/data/i.scm Normal file
View file

@ -0,0 +1,21 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(core:display "hello i.scm\n")
(define (from-i) "*from-i*")
(define-macro (from-i-macro) "*from-i-macro*")

21
sysa/mes-0.22/scaffold/boot/data/module.mes Normal file
View file

@ -0,0 +1,21 @@
;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(display "hallo\n")

41
sysa/mes-0.22/scaffold/boot/memory.scm Normal file
View file

@ -0,0 +1,41 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
;; ,expand (let loop ((i 10)) (if (eq? i 0) 0 (begin (core:display-error i) (core:display-error "\n") (loop (- i 1)))))
;; (let loop ((i 10)) (if (eq? i 0) 0 (begin (display i) (display "\n") (loop (- i 1)))))
((lambda (loop)
(set! loop
(lambda (i)
(if (eq? i 0) 0
(begin
(core:display i)
(core:display "\n")
(loop (- i 1))))))
(loop 10))
*unspecified*)
;; ((lambda (loop)
;; (set! loop
;; (lambda (i)
;; (if (eq? i 0) 0
;; (begin (display i)
;; (display "\n")
;; (loop (- i 1))))))
;; (loop 10))
;; *unspecified*)

19
sysa/mes-0.22/scaffold/boot/numbers.scm Normal file
View file

@ -0,0 +1,19 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 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/>.
(cdr '(0 . 1))

995
sysa/mes-0.22/scaffold/cons-mes.c Normal file
View file

@ -0,0 +1,995 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,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/>.
*/
#if SYSTEM_LIBC
#error "SYSTEM_LIBC not supported"
#endif
#include <stdio.h>
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <mes/lib.h>
char arena[2000];
typedef int SCM;
int g_debug = 0;
int g_free = 0;
SCM g_continuations = 0;
SCM g_symbols = 0;
SCM g_stack = 0;
SCM r0 = 0; // a/env
SCM r1 = 0; // param 1
SCM r2 = 0; // save 2+load/dump
SCM r3 = 0; // continuation
enum type_t
{ TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING,
TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART };
struct scm
{
enum type_t type;
SCM car;
SCM cdr;
};
struct function
{
int (*function) (void);
int arity;
char *name;
};
#if __MESC__
struct scm *g_cells = arena;
#else
struct scm *g_cells = (struct scm *) arena;
#endif
#define cell_nil 1
#define cell_f 2
#define cell_t 3
#define cell_dot 4
// #define cell_arrow 5
#define cell_undefined 6
#define cell_unspecified 7
#define cell_closure 8
#define cell_circular 9
#define cell_begin 10
#define cell_symbol_dot 11
#define cell_symbol_lambda 12
#define cell_symbol_begin 13
#define cell_symbol_if 14
#define cell_symbol_quote 15
#define cell_symbol_set_x 16
#define cell_vm_apply 45
#define cell_vm_apply2 46
#define cell_vm_eval 47
#define cell_vm_begin 56
//#define cell_vm_begin_read_input_file 57
#define cell_vm_begin2 58
#define cell_vm_return 63
SCM tmp;
SCM tmp_num;
SCM tmp_num2;
int ARENA_SIZE = 200;
struct function g_functions[5];
int g_function = 0;
SCM make_cell_ (SCM type, SCM car, SCM cdr);
struct function fun_make_cell_ = { &make_cell_, 3, "core:make-cell" };
struct scm scm_make_cell_ = { TFUNCTION, 0, 0 };
//, "core:make-cell", 0};
SCM cell_make_cell_;
SCM cons (SCM x, SCM y);
struct function fun_cons = { &cons, 2, "cons" };
struct scm scm_cons = { TFUNCTION, 0, 0 };
// "cons", 0};
SCM cell_cons;
SCM car (SCM x);
struct function fun_car = { &car, 1, "car" };
struct scm scm_car = { TFUNCTION, 0, 0 };
// "car", 0};
SCM cell_car;
SCM cdr (SCM x);
struct function fun_cdr = { &cdr, 1, "cdr" };
struct scm scm_cdr = { TFUNCTION, 0, 0 };
// "cdr", 0};
SCM cell_cdr;
// SCM eq_p (SCM x, SCM y);
// struct function fun_eq_p = {&eq_p,2,"eq?"};
// scm scm_eq_p = {TFUNCTION,0,0};
// SCM cell_eq_p;
#define TYPE(x) (g_cells[x].type)
#define CAR(x) g_cells[x].car
#define LENGTH(x) g_cells[x].car
#define STRING(x) g_cells[x].car
#define CDR(x) g_cells[x].cdr
#define CONTINUATION(x) g_cells[x].cdr
#define FUNCTION(x) g_functions[g_cells[x].cdr]
#define VALUE(x) g_cells[x].cdr
#define VECTOR(x) g_cells[x].cdr
#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
#define CAAR(x) CAR (CAR (x))
#define CADAR(x) CAR (CDR (CAR (x)))
#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
#define CADR(x) CAR (CDR (x))
#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
SCM
alloc (int n)
{
assert (g_free + n < ARENA_SIZE);
SCM x = g_free;
g_free += n;
return x;
}
SCM
make_cell_ (SCM type, SCM car, SCM cdr)
{
SCM x = alloc (1);
assert (TYPE (type) == TNUMBER);
TYPE (x) = VALUE (type);
if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER)
{
if (car)
CAR (x) = CAR (car);
if (cdr)
CDR (x) = CDR (cdr);
}
else if (VALUE (type) == TFUNCTION)
{
if (car)
CAR (x) = car;
if (cdr)
CDR (x) = CDR (cdr);
}
else
{
CAR (x) = car;
CDR (x) = cdr;
}
return x;
}
SCM
tmp_num_ (int x)
{
VALUE (tmp_num) = x;
return tmp_num;
}
SCM
tmp_num2_ (int x)
{
VALUE (tmp_num2) = x;
return tmp_num2;
}
SCM
cons (SCM x, SCM y)
{
VALUE (tmp_num) = TPAIR;
return make_cell_ (tmp_num, x, y);
}
SCM
car (SCM x)
{
return CAR (x);
}
SCM
cdr (SCM x)
{
return CDR (x);
}
SCM
gc_push_frame ()
{
SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
g_stack = cons (frame, g_stack);
return g_stack;
}
SCM
append2 (SCM x, SCM y)
{
if (x == cell_nil)
return y;
assert (TYPE (x) == TPAIR);
return cons (car (x), append2 (cdr (x), y));
}
SCM
pairlis (SCM x, SCM y, SCM a)
{
if (x == cell_nil)
return a;
if (TYPE (x) != TPAIR)
return cons (cons (x, y), a);
return cons (cons (car (x), car (y)), pairlis (cdr (x), cdr (y), a));
}
SCM
assq (SCM x, SCM a)
{
while (a != cell_nil && x == CAAR (a))
a = CDR (a);
return a != cell_nil ? car (a) : cell_f;
}
SCM
push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
{
puts ("push cc\n");
SCM x = r3;
r3 = c;
r2 = p2;
gc_push_frame ();
r1 = p1;
r0 = a;
r3 = x;
return cell_unspecified;
}
SCM
caar (SCM x)
{
return car (car (x));
}
SCM
cadr (SCM x)
{
return car (cdr (x));
}
SCM
cdar (SCM x)
{
return cdr (car (x));
}
SCM
cddr (SCM x)
{
return cdr (cdr (x));
}
#if __GNUC__
//FIXME
SCM call (SCM, SCM);
SCM gc_pop_frame ();
#endif
SCM
eval_apply ()
{
eval_apply:
switch (r3)
{
case cell_vm_apply:
{
goto apply;
}
case cell_unspecified:
{
return r1;
}
}
SCM x = cell_nil;
SCM y = cell_nil;
apply:
switch (TYPE (car (r1)))
{
case TFUNCTION:
{
puts ("apply.function\n");
r1 = call (car (r1), cdr (r1));
goto vm_return;
}
}
vm_return:
x = r1;
gc_pop_frame ();
r1 = x;
goto eval_apply;
}
SCM
call (SCM fn, SCM x)
{
puts ("call\n");
if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1) && x != cell_nil && TYPE (CAR (x)) == TVALUES)
x = cons (CADAR (x), CDR (x));
if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
&& x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
switch (FUNCTION (fn).arity)
{
case 0:
{
return (FUNCTION (fn).function) ();
}
case 1:
{
return ((SCM (*)(SCM)) (FUNCTION (fn).function)) (car (x));
}
case 2:
{
return ((SCM (*)(SCM, SCM)) (FUNCTION (fn).function)) (car (x), cadr (x));
}
case 3:
{
return ((SCM (*)(SCM, SCM, SCM)) (FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));
}
case -1:
{
return ((SCM (*)(SCM)) (FUNCTION (fn).function)) (x);
}
}
return cell_unspecified;
}
SCM
gc_peek_frame ()
{
SCM frame = car (g_stack);
r1 = car (frame);
r2 = cadr (frame);
r3 = car (cddr (frame));
r0 = cadr (cddr (frame));
return frame;
}
SCM
gc_pop_frame ()
{
SCM frame = gc_peek_frame (g_stack);
g_stack = cdr (g_stack);
return frame;
}
SCM
mes_g_stack (SCM a) ///((internal))
{
r0 = a;
r1 = MAKE_CHAR (0);
r2 = MAKE_CHAR (0);
r3 = MAKE_CHAR (0);
g_stack = cons (cell_nil, cell_nil);
return r0;
}
// Environment setup
SCM
make_tmps (struct scm * cells)
{
tmp = g_free++;
cells[tmp].type = TCHAR;
tmp_num = g_free++;
cells[tmp_num].type = TNUMBER;
tmp_num2 = g_free++;
cells[tmp_num2].type = TNUMBER;
return 0;
}
SCM
make_symbol_ (SCM s)
{
VALUE (tmp_num) = TSYMBOL;
SCM x = make_cell_ (tmp_num, s, 0);
g_symbols = cons (x, g_symbols);
return x;
}
SCM
make_symbol (SCM s)
{
SCM x = 0;
return x ? x : make_symbol_ (s);
}
SCM
acons (SCM key, SCM value, SCM alist)
{
return cons (cons (key, value), alist);
}
// Jam Collector
SCM g_symbol_max;
SCM
gc_init_cells ()
{
return 0;
}
// INIT NEWS
SCM
mes_symbols () ///((internal))
{
gc_init_cells ();
// gc_init_news ();
#if __GNUC__ && 0
//#include "mes.symbols.i"
#else
g_free++;
// g_cells[cell_nil] = scm_nil;
g_free++;
// g_cells[cell_f] = scm_f;
g_free++;
// g_cells[cell_t] = scm_t;
g_free++;
// g_cells[cell_dot] = scm_dot;
g_free++;
// g_cells[cell_arrow] = scm_arrow;
g_free++;
// g_cells[cell_undefined] = scm_undefined;
g_free++;
// g_cells[cell_unspecified] = scm_unspecified;
g_free++;
// g_cells[cell_closure] = scm_closure;
g_free++;
// g_cells[cell_circular] = scm_circular;
g_free++;
// g_cells[cell_begin] = scm_begin;
///
g_free = 44;
g_free++;
// g_cells[cell_vm_apply] = scm_vm_apply;
g_free++;
// g_cells[cell_vm_apply2] = scm_vm_apply2;
g_free++;
// g_cells[cell_vm_eval] = scm_vm_eval;
///
g_free = 55;
g_free++;
// g_cells[cell_vm_begin] = scm_vm_begin;
g_free++;
// g_cells[cell_vm_begin_read_input_file] = scm_vm_begin_read_input_file;
g_free++;
// g_cells[cell_vm_begin2] = scm_vm_begin2;
///
g_free = 62;
g_free++;
// g_cells[cell_vm_return] = scm_vm_return;
#endif
g_symbol_max = g_free;
make_tmps (g_cells);
g_symbols = 0;
for (int i = 1; i < g_symbol_max; i++)
g_symbols = cons (i, g_symbols);
SCM a = cell_nil;
a = acons (cell_symbol_dot, cell_dot, a);
a = acons (cell_symbol_begin, cell_begin, a);
a = acons (cell_closure, a, a);
return a;
}
SCM
make_closure (SCM args, SCM body, SCM a)
{
return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
}
SCM
mes_environment () ///((internal))
{
SCM a = 0;
a = mes_symbols ();
a = mes_g_stack (a);
return a;
}
SCM
mes_builtins (SCM a)
{
#if 0
//__GNUC__
//#include "mes.i"
// #include "lib.i"
// #include "math.i"
// #include "posix.i"
// #include "reader.i"
// #include "lib.environment.i"
// #include "math.environment.i"
// #include "mes.environment.i"
// #include "posix.environment.i"
// #include "reader.environment.i"
#else
scm_make_cell_.cdr = g_function;
g_functions[g_function++] = fun_make_cell_;
cell_make_cell_ = g_free++;
g_cells[cell_make_cell_] = scm_make_cell_;
scm_cons.cdr = g_function;
g_functions[g_function++] = fun_cons;
cell_cons = g_free++;
g_cells[cell_cons] = scm_cons;
scm_car.cdr = g_function;
g_functions[g_function++] = fun_car;
cell_car = g_free++;
g_cells[cell_car] = scm_car;
scm_cdr.cdr = g_function;
g_functions[g_function++] = fun_cdr;
cell_cdr = g_free++;
g_cells[cell_cdr] = scm_cdr;
#endif
return a;
}
SCM
bload_env (SCM a) ///((internal))
{
__stdin = open ("module/mes/read-0.mo", 0);
char *p = (char *) g_cells;
assert (getchar () == 'M');
assert (getchar () == 'E');
assert (getchar () == 'S');
g_stack = getchar () << 8;
g_stack += getchar ();
int c = getchar ();
while (c != EOF)
{
*p++ = c;
c = getchar ();
}
g_free = (p - (char *) g_cells) / sizeof (struct scm);
gc_peek_frame ();
g_symbols = r1;
__stdin = STDIN;
r0 = mes_builtins (r0);
return r2;
}
SCM
fill ()
{
TYPE (0) = 0x6c6c6168;
CAR (0) = 0x6a746f6f;
CDR (0) = 0x00002165;
TYPE (1) = TSYMBOL;
CAR (1) = 0x2d2d2d2d;
CDR (1) = 0x3e3e3e3e;
TYPE (9) = 0x2d2d2d2d;
CAR (9) = 0x2d2d2d2d;
CDR (9) = 0x3e3e3e3e;
// (cons 0 1)
TYPE (10) = TPAIR;
CAR (10) = 11;
CDR (10) = 12;
TYPE (11) = TFUNCTION;
CAR (11) = 0x58585858;
// 0 = make_cell_
// 1 = cons
// 2 = car
CDR (11) = 1;
TYPE (12) = TPAIR;
CAR (12) = 13;
//CDR (12) = 1;
CDR (12) = 14;
TYPE (13) = TNUMBER;
CAR (13) = 0x58585858;
CDR (13) = 0;
TYPE (14) = TPAIR;
CAR (14) = 15;
CDR (14) = 1;
TYPE (15) = TNUMBER;
CAR (15) = 0x58585858;
CDR (15) = 1;
return 0;
}
SCM
display_ (SCM x)
{
//puts ("<display>\n");
switch (TYPE (x))
{
case TCHAR:
{
//puts ("<char>\n");
puts ("#\\");
putchar (VALUE (x));
break;
}
case TFUNCTION:
{
//puts ("<function>\n");
if (VALUE (x) == 0)
puts ("core:make-cell");
if (VALUE (x) == 1)
puts ("cons");
if (VALUE (x) == 2)
puts ("car");
if (VALUE (x) == 3)
puts ("cdr");
break;
}
case TNUMBER:
{
//puts ("<number>\n");
#if __GNUC__
puts (itoa (VALUE (x)));
#else
int i;
i = VALUE (x);
i = i + 48;
putchar (i);
#endif
break;
}
case TPAIR:
{
//puts ("<pair>\n");
//if (cont != cell_f) puts "(");
puts ("(");
if (x && x != cell_nil)
display_ (CAR (x));
if (CDR (x) && CDR (x) != cell_nil)
{
#if __GNUC__
if (TYPE (CDR (x)) != TPAIR)
puts (" . ");
#else
int c;
c = CDR (x);
c = TYPE (c);
if (c != TPAIR)
puts (" . ");
#endif
display_ (CDR (x));
}
//if (cont != cell_f) puts (")");
puts (")");
break;
}
case TSPECIAL:
{
switch (x)
{
case 1:
{
puts ("()");
break;
}
case 2:
{
puts ("#f");
break;
}
case 3:
{
puts ("#t");
break;
}
default:
{
#if __GNUC__
puts ("<x:");
puts (itoa (x));
puts (">");
#else
puts ("<x>");
#endif
}
}
break;
}
case TSYMBOL:
{
switch (x)
{
case 11:
{
puts (" . ");
break;
}
case 12:
{
puts ("lambda");
break;
}
case 13:
{
puts ("begin");
break;
}
case 14:
{
puts ("if");
break;
}
case 15:
{
puts ("quote");
break;
}
case 37:
{
puts ("car");
break;
}
case 38:
{
puts ("cdr");
break;
}
case 39:
{
puts ("null?");
break;
}
case 40:
{
puts ("eq?");
break;
}
case 41:
{
puts ("cons");
break;
}
default:
{
#if __GNUC__
puts ("<s:");
puts (itoa (x));
puts (">");
#else
puts ("<s>");
#endif
}
}
break;
}
default:
{
//puts ("<default>\n");
#if __GNUC__
puts ("<");
puts (itoa (TYPE (x)));
puts (":");
puts (itoa (x));
puts (">");
#else
puts ("_");
#endif
break;
}
}
return 0;
}
SCM
simple_bload_env (SCM a) ///((internal))
{
puts ("reading: ");
char *mo = "module/mes/tiny-0-32.mo";
puts (mo);
puts ("\n");
__stdin = open (mo, 0);
if (__stdin < 0)
{
eputs ("no such file: module/mes/tiny-0-32.mo\n");
return 1;
}
char *p = (char *) g_cells;
int c;
assert (getchar () == 'M');
assert (getchar () == 'E');
assert (getchar () == 'S');
puts (" *GOT MES*\n");
g_stack = getchar () << 8;
g_stack += getchar ();
puts ("stack: ");
puts (itoa (g_stack));
puts ("\n");
c = getchar ();
while (c != -1)
{
*p++ = c;
c = getchar ();
}
puts ("read done\n");
g_free = (p - (char *) g_cells) / sizeof (struct scm);
if (g_free != 15)
exit (33);
g_symbols = 1;
__stdin = STDIN;
r0 = mes_builtins (r0);
if (g_free != 19)
exit (34);
puts ("cells read: ");
puts (itoa (g_free));
puts ("\n");
puts ("symbols: ");
puts (itoa (g_symbols));
puts ("\n");
// display_ (g_symbols);
// puts ("\n");
display_ (10);
puts ("\n");
fill ();
r2 = 10;
if (TYPE (12) != TPAIR)
exit (33);
puts ("program[");
puts (itoa (r2));
puts ("]: ");
display_ (r2);
//display_ (14);
puts ("\n");
r0 = 1;
//r2 = 10;
return r2;
}
int
main (int argc, char *argv[])
{
puts ("Hello cons-mes!\n");
if (argc > 1 && !strcmp (argv[1], "--help"))
return eputs ("Usage: mes [--dump|--load] < FILE");
#if __GNUC__
if (argc > 1 && !strcmp (argv[1], "--version"))
{
eputs ("Mes ");
return eputs (MES_VERSION);
};
#else
if (argc > 1 && !strcmp (argv[1], "--version"))
{
eputs ("Mes ");
return eputs ("0.4");
};
#endif
__stdin = STDIN;
r0 = mes_environment ();
SCM program = simple_bload_env (r0);
puts ("g_free=");
puts (itoa (g_free));
puts ("\n");
push_cc (r2, cell_unspecified, r0, cell_unspecified);
puts ("g_free=");
puts (itoa (g_free));
puts ("\n");
puts ("g_stack=");
puts (itoa (g_stack));
puts ("\n");
puts ("r0=");
puts (itoa (r0));
puts ("\n");
puts ("r1=");
puts (itoa (r1));
puts ("\n");
puts ("r2=");
puts (itoa (r2));
puts ("\n");
puts ("r3=");
puts (itoa (r3));
puts ("\n");
r3 = cell_vm_apply;
r1 = eval_apply ();
display_ (r1);
eputs ("\n");
return 0;
}

27
sysa/mes-0.22/scaffold/gc-test.scm Normal file
View file

@ -0,0 +1,27 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2018,2019 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/>.
(gc)
;; (display (gc-stats))
;; (newline)
(define (loop n)
(if (> n 0) (loop (- n 1))))
(loop 100000)
(gc)
;; (display (gc-stats))
;; (newline)

309
sysa/mes-0.22/scaffold/gc.scm Normal file
View file

@ -0,0 +1,309 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,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/>.
(define-module (guile gc))
(define (R) (reload-module (current-module)))
(define gc-size 10)
(define the-cars (make-vector gc-size '(* . *)))
(define the-cdrs (make-vector gc-size '(* . *)))
(define gc-free 0)
(define (gc-show)
(display "\nfree:") (display gc-free) (newline)
(display " 0 1 2 3 4 5 6 7 8 9\n")
(display "cars:") (display the-cars) (newline)
(display "cdrs:") (display the-cdrs) (newline))
(define (gc-show-new)
(display "\nfree:") (display gc-free) (newline)
(display " 0 1 2 3 4 5 6 7 8 9\n")
(display "ncar:") (display new-cars) (newline)
(display "ncdr:") (display new-cdrs) (newline))
(gc-show)
(define (gc-car c)
(vector-ref the-cars (cell-index c)))
(define (gc-cdr c)
(vector-ref the-cdrs (cell-index c)))
(define (gc-set-car! c x)
(if (gc-pair? c) (vector-set! the-cars (cell-index c) x)))
(define (gc-set-cdr! c x)
(if (gc-pair? c) (vector-set! the-cdrs (cell-index c) x)))
(define (gc-null? x) (eq? (car x) 'e))
(define (gc-pair? c)
(and (pair? c) (eq? (car c) 'p)))
(define (cell-index c)
(if (eq? (car c) 'p)
(cdr c)))
(define (cell-value c)
(if (member (car c) '(n s))
(cdr c)))
(define (make-cell type . x)
(cons type (if (pair? x) (car x) '*)))
(define (gc-alloc)
(if (= gc-free gc-size) (gc))
((lambda (index)
(set! gc-free (+ gc-free 1))
(make-cell 'p index))
gc-free))
(define (make-number x)
((lambda (cell)
(vector-set! the-cars (cell-index cell) (make-cell 'n x))
(gc-car cell))
(gc-alloc)))
(define (make-symbol x)
((lambda (cell)
(vector-set! the-cars (cell-index cell) (make-cell 's x))
(gc-car cell))
(gc-alloc)))
(define (gc-cons x y)
((lambda (cell)
(vector-set! the-cars (cell-index cell) x)
(vector-set! the-cdrs (cell-index cell) y)
cell)
(gc-alloc)))
(define gc-nil (make-cell 'e 0))
(define (gc-list . rest)
(if (null? rest) gc-nil
(gc-cons (car rest) (apply gc-list (cdr rest)))))
(define (gc-display x . cont?)
(if (gc-pair? x) (begin (if (null? cont?) (display "("))
(gc-display (gc-car x))
(if (gc-pair? (gc-cdr x)) (display " "))
(if (not (gc-null? (gc-cdr x)))
(gc-display (gc-cdr x) #t))
(if (null? cont?) (display ")")))
(if (gc-null? x) (if (not cont?) (display "()"))
(display (cell-value x)))))
(define (gc-root)
(filter gc-pair? (module-map (lambda (x y) (variable-ref y)) (current-module)))
list1234)
(define new-cars (make-vector gc-size '(* . *)))
(define new-cdrs (make-vector gc-size '(* . *)))
#!
begin-garbage-collection
(assign free (const 0))
(assign scan (const 0))
(assign old (reg root))
(assign relocate-continue
(label reassign-root))
(goto (label relocate-old-result-in-new))
reassign-root
(assign root (reg new))
(goto (label gc-loop))
gc-loop
(test (op =) (reg scan) (reg free))
(branch (label gc-flip))
(assign old
(op vector-ref)
(reg new-cars)
(reg scan))
(assign relocate-continue
(label update-car))
(goto (label relocate-old-result-in-new))
update-car
(perform (op vector-set!)
(reg new-cars)
(reg scan)
(reg new))
(assign old
(op vector-ref)
(reg new-cdrs)
(reg scan))
(assign relocate-continue
(label update-cdr))
(goto (label relocate-old-result-in-new))
update-cdr
(perform (op vector-set!)
(reg new-cdrs)
(reg scan)
(reg new))
(assign scan (op +) (reg scan) (const 1))
(goto (label gc-loop))
relocate-old-result-in-new
(test (op pointer-to-pair?) (reg old))
(branch (label pair))
(assign new (reg old))
(goto (reg relocate-continue))
pair
(assign oldcr
(op vector-ref)
(reg the-cars)
(reg old))
(test (op broken-heart?) (reg oldcr))
(branch (label already-moved))
(assign new (reg free)) ; new location for pair
;; Update ‘free’ pointer.
(assign free (op +) (reg free) (const 1))
;; Copy the ‘car’ and ‘cdr’ to new memory.
(perform (op vector-set!)
(reg new-cars)
(reg new)
(reg oldcr))
(assign oldcr
(op vector-ref)
(reg the-cdrs)
(reg old))
(perform (op vector-set!)
(reg new-cdrs)
(reg new)
(reg oldcr))
;; Construct the broken heart.
(perform (op vector-set!)
(reg the-cars)
(reg old)
(const broken-heart))
(perform (op vector-set!)
(reg the-cdrs)
(reg old)
(reg new))
(goto (reg relocate-continue))
already-moved
(assign new
(op vector-ref)
(reg the-cdrs)
(reg old))
(goto (reg relocate-continue))
gc-flip
(assign temp (reg the-cdrs))
(assign the-cdrs (reg new-cdrs))
(assign new-cdrs (reg temp))
(assign temp (reg the-cars))
(assign the-cars (reg new-cars))
(assign new-cars (reg temp))
!#
(define (gc)
(let ((root (gc-root)))
(display "gc root=") (display root) (newline)
(set! gc-free 0)
(gc-relocate root)
(gc-loop 0)))
(define (gc-loop scan)
(gc-show)
(gc-show-new)
(display "gc-loop scan=") (display scan) (newline)
(display "gc-loop free=") (display gc-free) (newline)
(if (eq? scan gc-free) (gc-flip)
(let ((old (vector-ref new-cars scan)))
(let ((new (gc-relocate old)))
(let ((old (gc-update-car scan new)))
(let ((new (gc-relocate old)))
(let ((scan (gc-update-cdr scan new)))
(gc-loop scan))))))))
(define (gc-update-car scan new) ; -> old
(vector-set! new-cars scan new)
(vector-ref new-cdrs scan))
(define (gc-update-cdr scan new)
(vector-set! new-cdrs scan new)
(+ 1 scan))
(define (broken-heart? c) (eq? (car c) '<))
(define gc-broken-heart '(< . 3))
(define (gc-relocate old) ; old -> new
(display "gc-relocate old=") (display old) (newline)
(display "gc-relocate old is pair?=") (display (gc-pair? old)) (newline)
(if (not (gc-pair? old)) old
(let ((oldcr (vector-ref the-cars (cell-index old))))
(display "gc-relocate oldcr=") (display oldcr) (newline)
(if (broken-heart? oldcr) old
(let ((new (cons 'p gc-free)))
(set! gc-free (+ 1 gc-free))
(vector-set! new-cars (cell-index new) oldcr)
(let ((oldcr (vector-ref the-cdrs (cell-index old))))
(display "gc-relocate oldcr=") (display oldcr) (newline)
(vector-set! new-cdrs (cell-index new) oldcr)
(vector-set! the-cars (cell-index old) gc-broken-heart)
(vector-set! the-cdrs (cell-index old) new))
new)))))
(define (gc-flip)
(let ((cars the-cars)
(cdrs the-cdrs))
(set! the-cars new-cars)
(set! the-cdrs new-cdrs)
(set! new-cars cars)
(set! new-cdrs cdrs))
(gc-show))
(define first (make-symbol 'F)) (newline)
(define one (make-number 1))
(display "\n one=") (display one) (newline)
(define two (make-number 2))
(define pair2-nil (gc-cons two gc-nil))
(display "\npair2-nil=") (display pair2-nil) (newline)
(gc-show)
(define list1-2 (gc-cons one pair2-nil))
(display "\nlist1-2=") (display list1-2) (newline)
(gc-show)
(define three (make-number 3))
(define four (make-number 4))
(define pair4-nil (gc-cons four gc-nil))
(define list3-4 (gc-cons three pair4-nil))
(define list1234 (gc-cons list1-2 list3-4))
(gc-show)
(display "\nlist1-2=") (display list1-2) (newline)
(display "\nlist3-4=") (display list3-4) (newline)
(display "lst=") (display list1234) (newline)
(gc-show)
(display "sicp-lst:") (gc-display list1234) (newline)
(gc-show)
(display "\n**** trigger gc ****\n")
(define next (gc-list (make-symbol 'N) (make-symbol 'X)))
(set! list1234 '(p . 0))
(display "sicp-lst:") (gc-display list1234) (newline)
(gc-show)
(display "next=") (display next) (newline)
(display "gc-next=") (gc-display next) (newline)
(gc-show)

28
sysa/mes-0.22/scaffold/hello.c Normal file
View file

@ -0,0 +1,28 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 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/>.
*/
#include <stdio.h>
int
main (int argc, char *argv[])
{
eputs ("Hello, Mescc!\n");
return 42;
}

56
sysa/mes-0.22/scaffold/lib/stdlib/malloc.c Normal file
View file

@ -0,0 +1,56 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 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/>.
*/
#if SYSTEM_LIBC
#error "SYSTEM_LIBC not supported"
#endif
#include <mes/lib.h>
#include <stdio.h>
#include <stdlib.h>
int
main (int argc, char *argv[])
{
int size = 5000;
puts ("m!\n");
//int *p = 0;
char *p = 0;
p = malloc (size);
size = 5000;
puts ("p=");
puts (itoa (p));
puts ("\n");
for (int i = 0; i < size; i++)
{
puts ("set ");
puts (itoa (i));
puts ("\n");
p[i] = i;
}
for (int i = 0; i < size; i++)
{
puts (itoa (i));
puts (": ");
puts (itoa (p[i]));
puts ("\n");
}
return 0;
}

29
sysa/mes-0.22/scaffold/main.c Normal file
View file

@ -0,0 +1,29 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 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/>.
*/
//V=2 CC32=i686-unknown-linux-gnu-gcc build-aux/cc32-mes.sh scaffold/main
//V=2 CC64=gcc build-aux/cc64-mes.sh scaffold/main
int
main (int argc, char *argv[])
{
argc = 42;
return argc;
}

74
sysa/mes-0.22/scaffold/micro-mes.c Normal file
View file

@ -0,0 +1,74 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017 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/>.
*/
#if SYSTEM_LIBC
#error "SYSTEM_LIBC not supported"
#endif
#include <stdio.h>
#include <stdlib.h>
typedef int SCM;
#if __GNUC__
int g_debug = 0;
#endif
int g_free = 0;
SCM g_symbols = 0;
SCM g_stack = 0;
SCM r0 = 0; // a/env
SCM r1 = 0; // param 1
SCM r2 = 0; // save 2+load/dump
SCM r3 = 0; // continuation
SCM
mes_environment ()
{
return 0;
}
SCM
bload_env (SCM a) ///((internal))
{
eputs ("bload_env\n");
return 0;
}
int
main (int argc, char *argv[])
{
#if __GNUC__
g_debug = (int) getenv ("MES_DEBUG");
#endif
//if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
// FIXME
//if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
//if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
r0 = mes_environment ();
puts ("Hello micro-mes!\n");
SCM program = bload_env (r0);
int i = argc;
return i;
}

Some files were not shown because too many files have changed in this diff Show more