4db75f9c4b422d0e47d409fd947f1569b7f59b61
[mes.git] / mes / module / mes / type-0.mes
1 ;;; -*-scheme-*-
2
3 ;;; GNU Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; This file is part of GNU Mes.
7 ;;;
8 ;;; GNU Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; GNU Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; Implement core functionality that depends on implementation
24 ;;; specifics of Mes cell types.
25
26 ;;; Code:
27
28 (define cell:type-alist
29   (list (cons <cell:char> (quote <cell:char>))
30         (cons <cell:closure> (quote <cell:closure>))
31         (cons <cell:continuation> (quote <cell:continuation>))
32         (cons <cell:function> (quote <cell:function>))
33         (cons <cell:keyword> (quote <cell:keyword>))
34         (cons <cell:macro> (quote <cell:macro>))
35         (cons <cell:number> (quote <cell:number>))
36         (cons <cell:pair> (quote <cell:pair>))
37         (cons <cell:ref> (quote <cell:ref>))
38         (cons <cell:special> (quote <cell:special>))
39         (cons <cell:string> (quote <cell:string>))
40         (cons <cell:struct> (quote <cell:struct>))
41         (cons <cell:symbol> (quote <cell:symbol>))
42         (cons <cell:values> (quote <cell:values>))
43         (cons <cell:variable> (quote <cell:variable>))
44         (cons <cell:vector> (quote <cell:vector>))
45         (cons <cell:broken-heart> (quote <cell:broken-heart>))))
46
47 (define (cell:type-name x)
48   (cond ((assq (core:type x) cell:type-alist) => cdr)))
49
50 (define (char? x)
51   (and (eq? (core:type x) <cell:char>)
52        (> (char->integer x) -1)))
53
54 (define (eof-object? x)
55   (and (eq? (core:type x) <cell:char>)
56        (= (char->integer x) -1)))
57
58 (define (closure? x)
59   (eq? (core:type x) <cell:closure>))
60
61 (define (continuation? x)
62   (eq? (core:type x) <cell:continuation>))
63
64 (define (function? x)
65   (eq? (core:type x) <cell:function>))
66
67 (define builtin? function?)
68
69 (define (keyword? x)
70   (eq? (core:type x) <cell:keyword>))
71
72 (define (macro? x)
73   (eq? (core:type x) <cell:macro>))
74
75 (define (number? x)
76   (eq? (core:type x) <cell:number>))
77
78 (define (pair? x)
79   (eq? (core:type x) <cell:pair>))
80
81 (define (port? x)
82   (eq? (core:type x) <cell:port>))
83
84 (define (special? x)
85   (eq? (core:type x) <cell:special>))
86
87 (define (string? x)
88   (eq? (core:type x) <cell:string>))
89
90 (define (struct? x)
91   (eq? (core:type x) <cell:struct>))
92
93 (define (symbol? x)
94   (eq? (core:type x) <cell:symbol>))
95
96 (define (values? x)
97   (eq? (core:type x) <cell:values>))
98
99 (define (variable? x)
100   (eq? (core:type x) <cell:variable>))
101
102 (define (variable-global? x)
103   (core:cdr x))
104
105 (define (vector? x)
106   (eq? (core:type x) <cell:vector>))
107
108 ;; Non-types
109 ;; In core
110 ;; (define (null? x)
111 ;;   (eq? x '()))
112
113 (define (atom? x)
114   (not (pair? x)))
115
116 (define (boolean? x)
117   (or (eq? x #f) (eq? x #t)))
118
119 \f
120 ;;; core: accessors
121 (define (string . lst)
122   (core:make-cell <cell:string> lst 0))
123
124 (define (string->symbol s)
125   (if (not (pair? (core:car s))) '()
126       (list->symbol (core:car s))))
127
128 (define (symbol->keyword s)
129   (core:make-cell <cell:keyword> (symbol->list s) 0))
130
131 (define (symbol->list s)
132   (core:car s))
133
134 (define (keyword->list s)
135   (core:car s))
136
137 (define (integer->char x)
138   (core:make-cell <cell:char> 0 x))
139
140 (define (char->integer x)
141   (core:make-cell <cell:number> 0 x))