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))