core: Remove type.c.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 23 Dec 2016 17:05:45 +0000 (18:05 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 23 Dec 2016 17:05:45 +0000 (18:05 +0100)
* module/mes/type-0.mes: Resurrect.
* module/mes/base-0.mes: Include it.
* module/mes/read-0.mes (not, pair?, atom?): New functions.
* type.c: Remove.
* mes.c: Remove callers.
* GNUmakefile (mes.o): Remove dependency on type.

GNUmakefile
mes.c
module/mes/base-0.mes
module/mes/read-0.mes
module/mes/type-0.mes
type.c [deleted file]

index 51d577b09b1ce62153cf1e6d277d91796c63393c..ca94b2ca1b5afdd9bff715601c74f5c9b6a49944 100644 (file)
@@ -35,7 +35,6 @@ mes.o: math.c math.h math.i math.environment.i
 mes.o: posix.c posix.h posix.i posix.environment.i
 mes.o: reader.c reader.h reader.i reader.environment.i
 mes.o: string.c string.h string.i string.environment.i
-mes.o: type.c type.h type.i type.environment.i
 
 clean:
        rm -f mes mes.o *.environment.i *.symbols.i *.environment.h *.cat a.out
diff --git a/mes.c b/mes.c
index 96dd91b15b4fecc7807ed0e82c9624d92824dfe3..0c0f12c3aa53e76d2a7f0ac00d584d2c408ebb1f 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -36,7 +36,7 @@ int MAX_ARENA_SIZE = 20000000;
 int GC_SAFETY = 100;
 
 typedef int SCM;
-enum type_t {CHAR, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, SPECIAL, STRING, SYMBOL, REF, VALUES, VECTOR, BROKEN_HEART};
+enum type_t {CHAR, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
 typedef SCM (*function0_t) (void);
 typedef SCM (*function1_t) (SCM);
 typedef SCM (*function2_t) (SCM, SCM);
@@ -157,7 +157,6 @@ SCM r3 = 0; // param 3
 #include "posix.h"
 #include "reader.h"
 #include "string.h"
-#include "type.h"
 
 #define CAR(x) g_cells[x].car
 #define CDR(x) g_cells[x].cdr
@@ -190,6 +189,20 @@ SCM r3 = 0; // param 3
 SCM display_ (FILE* f, SCM x);
 SCM vm_call (function0_t f, SCM p1, SCM p2, SCM a);
 
+SCM
+tmp_num_ (int x)
+{
+  g_cells[tmp_num].value = x;
+  return tmp_num;
+}
+
+SCM
+tmp_num2_ (int x)
+{
+  g_cells[tmp_num2].value = x;
+  return tmp_num2;
+}
+
 SCM
 alloc (int n)
 {
@@ -239,6 +252,30 @@ cdr (SCM x)
   return CDR (x);
 }
 
+SCM
+type_ (SCM x)
+{
+  return MAKE_NUMBER (TYPE (x));
+}
+
+SCM
+car_ (SCM x)
+{
+  return (TYPE (CAR (x)) == PAIR
+          || TYPE (CAR (x)) == REF
+          || TYPE (CAR (x)) == SYMBOL
+          || TYPE (CAR (x)) == STRING) ? CAR (x) : MAKE_NUMBER (CAR (x));
+}
+
+SCM
+cdr_ (SCM x)
+{
+  return (TYPE (CDR (x)) == PAIR
+          || TYPE (CDR (x)) == REF
+          || TYPE (CDR (x)) == SYMBOL
+          || TYPE (CDR (x)) == STRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
+}
+
 SCM
 eq_p (SCM x, SCM y)
 {
@@ -298,7 +335,7 @@ pairlis (SCM x, SCM y, SCM a)
 {
   if (x == cell_nil)
     return a;
-  if (pair_p (x) == cell_f)
+  if (TYPE (x) != PAIR)
     return cons (cons (x, y), a);
   return cons (cons (car (x), car (y)),
                pairlis (cdr (x), cdr (y), a));
@@ -681,20 +718,6 @@ append (SCM x) ///((arity . n))
   return append2 (car (x), append (cdr (x)));
  }
 
-SCM
-tmp_num_ (int x)
-{
-  g_cells[tmp_num].value = x;
-  return tmp_num;
-}
-
-SCM
-tmp_num2_ (int x)
-{
-  g_cells[tmp_num2].value = x;
-  return tmp_num2;
-}
-
 SCM
 cstring_to_list (char const* s)
 {
@@ -1061,7 +1084,6 @@ mes_builtins (SCM a)
 #include "posix.i"
 #include "reader.i"
 #include "string.i"
-#include "type.i"
 
 #include "display.environment.i"
 #include "lib.environment.i"
@@ -1070,7 +1092,6 @@ mes_builtins (SCM a)
 #include "posix.environment.i"
 #include "reader.environment.i"
 #include "string.environment.i"
-#include "type.environment.i"
 
   return a;
 }
@@ -1110,7 +1131,7 @@ lookup_macro (SCM x, SCM a)
 {
   if (TYPE (x) != SYMBOL) return cell_f;
   SCM m = assq_ref_cache (x, a);
-  if (macro_p (m) == cell_t) return MACRO (m);
+  if (TYPE (m) == MACRO) return MACRO (m);
   return cell_f;
 }
 
@@ -1187,7 +1208,6 @@ dump ()
   return 0;
 }
 
-#include "type.c"
 #include "display.c"
 #include "lib.c"
 #include "math.c"
index ad449bbb02f7347333e20098f135ada543e316d2..380c61a28c9ee5e02df37bd60a9795ebfd19259f 100644 (file)
 (define-macro (include-from-path file)
   (list 'load (list string-append "module/" file)))
 
+(mes-use-module (mes type-0))
 (mes-use-module (srfi srfi-0))
 (mes-use-module (mes base))
+(mes-use-module (mes quasiquote))
 (mes-use-module (mes scm))
index 93b272a2a0203bcda98c87553cc19b2a423e5279..3d8249614d573bcca48672e21751f455d9fc50ec 100644 (file)
           (car a+)))
 
   (env:define (cons (cons (quote <cell:macro>) 3) (list)) (current-module))
+  (env:define (cons (cons (quote <cell:pair>) 5) (list)) (current-module))
   (env:define (cons (cons (quote sexp:define) #f) (list)) (current-module))
   (env:define (cons (cons (quote env:macro) #f) (list)) (current-module))
   (env:define (cons (cons (quote cons*) #f) (list)) (current-module))
+  (env:define (cons (cons (quote not)
+                          (lambda (x) (if x #f #t)))
+                    (list)) (current-module))
+  (env:define (cons (cons (quote pair?)
+                          (lambda (x) (eq? (core:type x) <cell:pair>)))
+                    (list)) (current-module))
+  (env:define (cons (cons (quote atom?)
+                          (lambda (x) (not (pair? x))))
+                    (list)) (current-module))
 
   (set! sexp:define
         (lambda (e a)
                (quote ((current-module))))))
      (current-module))) (current-module))
 
-  ;; (define car (make-function 'car 0))
-  ;; (define cdr (make-function 'cdr 1))
-  ;; (define cons (make-function 'cons 1))
-
-  ;; TODO:
-  ;; * use case/cond, expand
-  ;; * etc int/char?
-  ;; * lookup in Scheme
-  ;; * read characters, quote, strings
-
   (define <cell:keyword> 2)
+
   (define (read)
     (read-word (read-byte) (list) (current-module)))
 
index 53b0a2d3d7f49e6d414c506cbf682bac6009b8ec..cb17e1c8b9f5e323857b92dc531402b8728ed66c 100644 (file)
 
 ;;; Commentary:
 
-;;; type-0.mes - to be loaded after loop-0.mes if type.i is not
-;;; included in core.
+;;; Code:
 
-;;; This code is only loaded if environment variable TYPE0 is set.
-;;; There are two copies of the type enum, with manual numbering.  Not
-;;; good.
+(define <cell:char> 0)
+(define <cell:function> 1)
+(define <cell:keyword> 2)
+(define <cell:macro> 3)
+(define <cell:number> 4)
+(define <cell:pair> 5)
+(define <cell:ref> 6)
+(define <cell:special> 7)
+(define <cell:string> 8)
+(define <cell:symbol> 9)
+(define <cell:values> 10)
+(define <cell:vector> 11)
+(define <cell:broken-heart> 12)
+
+(define cell:type-alist
+  (list (cons <cell:char> (quote <cell:char>))
+        (cons <cell:function> (quote <cell:function>))
+        (cons <cell:keyword> (quote <cell:keyword>))
+        (cons <cell:macro> (quote <cell:macro>))
+        (cons <cell:number> (quote <cell:number>))
+        (cons <cell:pair> (quote <cell:pair>))
+        (cons <cell:ref> (quote <cell:ref>))
+        (cons <cell:special> (quote <cell:special>))
+        (cons <cell:string> (quote <cell:string>))
+        (cons <cell:symbol> (quote <cell:symbol>))
+        (cons <cell:values> (quote <cell:values>))
+        (cons <cell:vector> (quote <cell:vector>))
+        (cons <cell:broken-heart> (quote <cell:broken-heart>))))
+
+(define (cell:type-name x)
+  (cond ((assq (core:type x) cell:type-alist) => cdr)))
 
+(define (char? x)
+  (eq? (core:type x) <cell:char>))
 
-;;; Code:
+(define (function? x)
+  (eq? (core:type x) <cell:function>))
 
-(define <char> 0)
-(define <function> 1)
-(define <macro> 2)
-(define <number> 3)
-(define <pair> 4)
-(define <scm> 5)
-(define <string> 6)
-(define <symbol> 7)
-(define <values> 8)
-(define <vector> 9)
-
-(define mes-type-alist
-  `((,<char> . <char>)
-    (,<function> . <function>)
-    (,<macro> . <macro>)
-    (,<number> . <number>)
-    (,<pair> . <pair>)
-    (,<scm> . <scm>)
-    (,<string> . <string>)
-    (,<symbol> . <symbol>)
-    (,<char> . <char>)
-    (,<values> . <values>)))
-  
-(define (class-of x)
-  (assq (mes-type-of x) mes-type-alist))
+(define builtin? function?)
 
-(define (atom? x)
-  (not (pair? x)))
+(define (keyword? x)
+  (eq? (core:type x) <cell:keyword>))
 
-(define (boolean? x)
-  (if (eq? x #f) #t
-      (if (eq? x #t) #t
-          #f)))
+(define (macro? x)
+  (eq? (core:type x) <cell:macro>))
 
-(define (char? x)
-  (eq? (mes-type-of x) <char>))
+(define (number? x)
+  (eq? (core:type x) <cell:number>))
 
-;; pair? is not needed as a primitive from C
-;; but it gives a factor 2 speedup
-;; (define (pair? x)
-;;   (eq? (mes-type-of x) <pair>))
+(define (pair? x)
+  (eq? (core:type x) <cell:pair>))
 
-(define (number? x)
-  (eq? (mes-type-of x) <number>))
+(define (pair? x)
+  (and (eq? (core:type x) <cell:pair>)
+       (not (eq? (car x) '*closure*))))
 
-(define (internal? x)
-  (eq? (mes-type-of x) <scm>))
+(define (special? x)
+  (eq? (core:type x) <cell:special>))
 
 (define (string? x)
-  (eq? (mes-type-of x) <string>))
+  (eq? (core:type x) <cell:string>))
 
 (define (symbol? x)
-  (eq? (mes-type-of x) <symbol>))
+  (eq? (core:type x) <cell:symbol>))
+
+;; Hmm?
+(define (values? x)
+  (eq? (core:type x) <cell:values>))
 
 (define (vector? x)
-  (eq? (mes-type-of x) <vector>))
+  (eq? (core:type x) <cell:vector>))
+
+;; Non-types
+;; In core
+;; (define (null? x)
+;;   (eq? x '()))
+
+(define (closure? x)
+  (and (eq? (core:type x) <cell:pair>) (eq? (car x) '*closure*)))
 
-(define (null? x)
-  (eq? x '()))
+(define (atom? x)
+  (not (pair? x)))
+
+(define (boolean? x)
+  (or (eq? x #f) (eq? x #t)))
diff --git a/type.c b/type.c
deleted file mode 100644 (file)
index 21ed9b1..0000000
--- a/type.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/* -*-comment-start: "//";comment-end:""-*-
- * Mes --- Maxwell Equations of Software
- * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
- *
- * This file is part of Mes.
- *
- * Mes is free software; you can redistribute it and/or modify it
- * under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 3 of the License, or (at
- * your option) any later version.
- *
- * Mes is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
- */
-
-#if !TYPE0
-
-SCM
-char_p (SCM x)
-{
-  return TYPE (x) == CHAR ? cell_t : cell_f;
-}
-
-SCM
-closure_p (SCM x)
-{
-  return (TYPE (x) == PAIR && CAR (x) == cell_closure) ? cell_t : cell_f;
-}
-
-SCM
-car_ (SCM x)
-{
-  return CAR (x);
-}
-
-SCM
-cdr_ (SCM x)
-{
-  return CDR (x);
-}
-
-SCM
-keyword_p (SCM x)
-{
-  return TYPE (x) == KEYWORD ? cell_t : cell_f;
-}
-
-SCM
-macro_p (SCM x)
-{
-  return TYPE (x) == MACRO ? cell_t : cell_f;
-}
-
-SCM
-number_p (SCM x)
-{
-  return TYPE (x) == NUMBER ? cell_t : cell_f;
-}
-
-SCM
-pair_p (SCM x)
-{
-  return (TYPE (x) == PAIR && CAR (x) != cell_closure) ? cell_t : cell_f;
-}
-
-SCM
-ref_p (SCM x)
-{
-  return TYPE (x) == REF ? cell_t : cell_f;
-}
-
-SCM
-string_p (SCM x)
-{
-  return TYPE (x) == STRING ? cell_t : cell_f;
-}
-
-SCM
-symbol_p (SCM x)
-{
-  return TYPE (x) == SYMBOL ? cell_t : cell_f;
-}
-
-SCM
-vector_p (SCM x)
-{
-  return TYPE (x) == VECTOR ? cell_t : cell_f;
-}
-
-SCM
-builtin_p (SCM x)
-{
-  return TYPE (x) == FUNCTION ? cell_t : cell_f;
-}
-
-// Non-types
-
-SCM
-atom_p (SCM x)
-{
-  return (TYPE (x) == PAIR ? cell_f : cell_t);
-}
-
-SCM
-boolean_p (SCM x)
-{
-  return (x == cell_t || x == cell_f) ? cell_t : cell_f;
-}
-#endif
-
-SCM
-mes_type_of (SCM x)
-{
-  return MAKE_NUMBER (TYPE (x));
-}