core: typo: Remove trailing 1.
[mes.git] / module / mes / type-0.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; This file is part of Mes.
7 ;;;
8 ;;; 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 ;;; 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 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:symbol> (quote <cell:symbol>))
41         (cons <cell:values> (quote <cell:values>))
42         (cons <cell:variable> (quote <cell:variable>))
43         (cons <cell:vector> (quote <cell:vector>))
44         (cons <cell:broken-heart> (quote <cell:broken-heart>))))
45
46 (define (cell:type-name x)
47   (cond ((assq (core:type x) cell:type-alist) => cdr)))
48
49 (define (char? x)
50   (and (eq? (core:type x) <cell:char>)
51        (> (char->integer x) -1)))
52
53 (define (eof-object? x)
54   (and (eq? (core:type x) <cell:char>)
55        (= (char->integer x) -1)))
56
57 (define (closure? x)
58   (eq? (core:type x) <cell:closure>))
59
60 (define (continuation? x)
61   (eq? (core:type x) <cell:continuation>))
62
63 (define (function? x)
64   (eq? (core:type x) <cell:function>))
65
66 (define builtin? function?)
67
68 (define (keyword? x)
69   (eq? (core:type x) <cell:keyword>))
70
71 (define (macro? x)
72   (eq? (core:type x) <cell:macro>))
73
74 (define (number? x)
75   (eq? (core:type x) <cell:number>))
76
77 (define (pair? x)
78   (eq? (core:type x) <cell:pair>))
79
80 (define (port? x)
81   (eq? (core:type x) <cell:port>))
82
83 (define (special? x)
84   (eq? (core:type x) <cell:special>))
85
86 (define (string? x)
87   (eq? (core:type x) <cell:string>))
88
89 (define (symbol? x)
90   (eq? (core:type x) <cell:symbol>))
91
92 (define (values? x)
93   (eq? (core:type x) <cell:values>))
94
95 (define (variable? x)
96   (eq? (core:type x) <cell:variable>))
97
98 (define (variable-global? x)
99   (core:cdr x))
100
101 (define (vector? x)
102   (eq? (core:type x) <cell:vector>))
103
104 ;; Non-types
105 ;; In core
106 ;; (define (null? x)
107 ;;   (eq? x '()))
108
109 (define (atom? x)
110   (not (pair? x)))
111
112 (define (boolean? x)
113   (or (eq? x #f) (eq? x #t)))
114
115 \f
116 ;;; core: accessors
117 (define (string . lst)
118   (core:make-cell <cell:string> lst 0))
119
120 (define (string->symbol s)
121   (if (not (pair? (core:car s))) '()
122       (core:lookup-symbol (core:car s))))
123
124 (define (symbol->keyword s)
125   (core:make-cell <cell:keyword> (symbol->list s) 0))
126
127 (define (list->symbol lst)
128   (core:lookup-symbol lst))
129
130 (define (symbol->list s)
131   (core:car s))
132
133 (define (keyword->list s)
134   (core:car s))
135
136 (define (integer->char x)
137   (core:make-cell <cell:char> 0 x))
138
139 (define (char->integer x)
140   (core:make-cell <cell:number> 0 x))