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