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