core: Remove type.c.
* 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.
This commit is contained in:
Jan Nieuwenhuizen
parent
13dd5a1013
commit
10235efe7e
|
|
@ -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
|
||||
|
|
|
|||
62
mes.c
62
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"
|
||||
|
|
|
|||
|
|
@ -152,6 +152,8 @@
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -44,9 +44,19 @@
|
|||
(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)
|
||||
|
|
@ -94,17 +104,8 @@
|
|||
(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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -20,72 +20,90 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;;; type-0.mes - to be loaded after loop-0.mes if type.i is not
|
||||
;;; included in core.
|
||||
|
||||
;;; This code is only loaded if environment variable TYPE0 is set.
|
||||
;;; There are two copies of the type enum, with manual numbering. Not
|
||||
;;; good.
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
(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 <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 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 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>))
|
||||
|
||||
(define (function? x)
|
||||
(eq? (core:type x) <cell:function>))
|
||||
|
||||
(define builtin? function?)
|
||||
|
||||
(define (keyword? x)
|
||||
(eq? (core:type x) <cell:keyword>))
|
||||
|
||||
(define (macro? x)
|
||||
(eq? (core:type x) <cell:macro>))
|
||||
|
||||
(define (number? x)
|
||||
(eq? (core:type x) <cell:number>))
|
||||
|
||||
(define (pair? x)
|
||||
(eq? (core:type x) <cell:pair>))
|
||||
|
||||
(define (pair? x)
|
||||
(and (eq? (core:type x) <cell:pair>)
|
||||
(not (eq? (car x) '*closure*))))
|
||||
|
||||
(define (special? x)
|
||||
(eq? (core:type x) <cell:special>))
|
||||
|
||||
(define (string? x)
|
||||
(eq? (core:type x) <cell:string>))
|
||||
|
||||
(define (symbol? x)
|
||||
(eq? (core:type x) <cell:symbol>))
|
||||
|
||||
;; Hmm?
|
||||
(define (values? x)
|
||||
(eq? (core:type x) <cell:values>))
|
||||
|
||||
(define (vector? x)
|
||||
(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 (atom? x)
|
||||
(not (pair? x)))
|
||||
|
||||
(define (boolean? x)
|
||||
(if (eq? x #f) #t
|
||||
(if (eq? x #t) #t
|
||||
#f)))
|
||||
|
||||
(define (char? x)
|
||||
(eq? (mes-type-of x) <char>))
|
||||
|
||||
;; 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 (number? x)
|
||||
(eq? (mes-type-of x) <number>))
|
||||
|
||||
(define (internal? x)
|
||||
(eq? (mes-type-of x) <scm>))
|
||||
|
||||
(define (string? x)
|
||||
(eq? (mes-type-of x) <string>))
|
||||
|
||||
(define (symbol? x)
|
||||
(eq? (mes-type-of x) <symbol>))
|
||||
|
||||
(define (vector? x)
|
||||
(eq? (mes-type-of x) <vector>))
|
||||
|
||||
(define (null? x)
|
||||
(eq? x '()))
|
||||
(or (eq? x #f) (eq? x #t)))
|
||||
|
|
|
|||
120
type.c
120
type.c
|
|
@ -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));
|
||||
}
|
||||
Loading…
Reference in a new issue