mirror of
https://github.com/fosslinux/live-bootstrap.git
synced 2026-03-16 00:05:24 +01:00
Add mes and mescc-tools-extra
mescc-tools-extra contains two important tools: - cp - chmod mes first builds itself from a mes 0.21 seed as used by guix, and then builds a mes 0.22 and then mes 0.22 using that created mes 0.22. It does /not/ use bootstrap.sh as we don't have a proper shell at this point, it has been manually adapted for kaem.
This commit is contained in:
parent
2706e07556
commit
649d7b68dc
1029 changed files with 120985 additions and 18 deletions
19
sysa/mes-0.22/scaffold/boot/00-zero.scm
Normal file
19
sysa/mes-0.22/scaffold/boot/00-zero.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/01-true.scm
Normal 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
25
sysa/mes-0.22/scaffold/boot/02-identifier.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/02-symbol.scm
Normal 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
56
sysa/mes-0.22/scaffold/boot/03-big-string.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/03-string.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/04-cons.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/04-quote.scm
Normal 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
28
sysa/mes-0.22/scaffold/boot/05-big-list.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/05-list-list.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/05-list.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/06-tick.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/07-if.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/08-if-if.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/10-cons.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/11-list.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/11-vector.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/12-car.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/13-cdr.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/14-exit.scm
Normal 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
20
sysa/mes-0.22/scaffold/boot/15-display.scm
Normal 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
20
sysa/mes-0.22/scaffold/boot/16-if-eq-quote.scm
Normal 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
25
sysa/mes-0.22/scaffold/boot/17-equal2.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/17-memq-keyword.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/17-memq.scm
Normal 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
36
sysa/mes-0.22/scaffold/boot/17-open-input-string.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/17-string-append.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/17-string-equal.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/20-define-quote.scm
Normal 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
20
sysa/mes-0.22/scaffold/boot/20-define-quoted.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/20-define.scm
Normal 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
20
sysa/mes-0.22/scaffold/boot/21-define-procedure.scm
Normal 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
22
sysa/mes-0.22/scaffold/boot/22-define-procedure-2.scm
Normal 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
20
sysa/mes-0.22/scaffold/boot/23-begin.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/24-begin-define.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/25-begin-define-2.scm
Normal 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
22
sysa/mes-0.22/scaffold/boot/26-begin-define-later.scm
Normal 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
33
sysa/mes-0.22/scaffold/boot/26-define-define.scm
Normal 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
25
sysa/mes-0.22/scaffold/boot/27-lambda-define.scm
Normal 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
25
sysa/mes-0.22/scaffold/boot/28-define-define.scm
Normal 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
27
sysa/mes-0.22/scaffold/boot/29-lambda-define.scm
Normal 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
27
sysa/mes-0.22/scaffold/boot/2a-lambda-lambda.scm
Normal 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
24
sysa/mes-0.22/scaffold/boot/2b-define-lambda.scm
Normal 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
33
sysa/mes-0.22/scaffold/boot/2c-define-lambda-recurse.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/2d-compose.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/2d-define-lambda-set.scm
Normal 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
34
sysa/mes-0.22/scaffold/boot/2e-define-first.scm
Normal 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
48
sysa/mes-0.22/scaffold/boot/2f-define-second-lambda.scm
Normal 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
47
sysa/mes-0.22/scaffold/boot/2f-define-second.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/2g-vector.scm
Normal 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
20
sysa/mes-0.22/scaffold/boot/30-capture.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/31-capture-define.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/32-capture-modify-close.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/33-procedure-override-close.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/34-cdr-override-close.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/35-closure-modify.scm
Normal 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
22
sysa/mes-0.22/scaffold/boot/36-closure-override.scm
Normal 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
62
sysa/mes-0.22/scaffold/boot/37-closure-lambda.scm
Normal 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
70
sysa/mes-0.22/scaffold/boot/38-simple-format.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/39-global-define-override.scm
Normal 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))
|
||||
|
|
@ -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
20
sysa/mes-0.22/scaffold/boot/40-define-macro.scm
Normal 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
24
sysa/mes-0.22/scaffold/boot/41-when.scm
Normal 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
22
sysa/mes-0.22/scaffold/boot/42-if-when.scm
Normal 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
35
sysa/mes-0.22/scaffold/boot/43-or.scm
Normal 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
27
sysa/mes-0.22/scaffold/boot/44-or-if.scm
Normal 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
31
sysa/mes-0.22/scaffold/boot/45-pass-if.scm
Normal 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
61
sysa/mes-0.22/scaffold/boot/46-report.scm
Normal 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
36
sysa/mes-0.22/scaffold/boot/47-pass-if-eq.scm
Normal 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
32
sysa/mes-0.22/scaffold/boot/48-let.scm
Normal 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
22
sysa/mes-0.22/scaffold/boot/49-macro-override.scm
Normal 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
27
sysa/mes-0.22/scaffold/boot/4a-define-macro-define-macro.scm
Normal 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
25
sysa/mes-0.22/scaffold/boot/4b-define-macro-define.scm
Normal 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
161
sysa/mes-0.22/scaffold/boot/4c-quasiquote.scm
Normal 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
39
sysa/mes-0.22/scaffold/boot/4d-let-map.scm
Normal 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
33
sysa/mes-0.22/scaffold/boot/4e-let-global.scm
Normal 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
106
sysa/mes-0.22/scaffold/boot/4f-string-split.scm
Normal 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
23
sysa/mes-0.22/scaffold/boot/50-keyword.scm
Normal 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
50
sysa/mes-0.22/scaffold/boot/50-make-string.scm
Normal 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
35
sysa/mes-0.22/scaffold/boot/50-primitive-load.scm
Normal 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
50
sysa/mes-0.22/scaffold/boot/50-string-join.scm
Normal 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
87
sysa/mes-0.22/scaffold/boot/51-module.scm
Normal 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
77
sysa/mes-0.22/scaffold/boot/52-define-module.scm
Normal 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
58
sysa/mes-0.22/scaffold/boot/53-closure-display.scm
Normal 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
547
sysa/mes-0.22/scaffold/boot/60-let-syntax-expanded.scm
Normal 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
452
sysa/mes-0.22/scaffold/boot/60-let-syntax.scm
Normal 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
60
sysa/mes-0.22/scaffold/boot/call-cc.scm
Normal 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
24
sysa/mes-0.22/scaffold/boot/data/bar.mes
Normal 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
21
sysa/mes-0.22/scaffold/boot/data/i.scm
Normal 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
21
sysa/mes-0.22/scaffold/boot/data/module.mes
Normal 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
41
sysa/mes-0.22/scaffold/boot/memory.scm
Normal 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
19
sysa/mes-0.22/scaffold/boot/numbers.scm
Normal 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))
|
||||
Loading…
Add table
Add a link
Reference in a new issue