From 58b05c50af6c6d64057576678ba133d43f0c4e48 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 11 Jun 2011 16:26:30 +0900 Subject: [PATCH] using titlecase names for types --- lib/chibi/ast.c | 54 +++++++++++++++--------------- lib/chibi/ast.module | 11 +++--- lib/chibi/ast.scm | 3 ++ lib/chibi/type-inference.scm | 44 ++++++++++++------------ lib/srfi/99/records/inspection.scm | 2 +- 5 files changed, 58 insertions(+), 56 deletions(-) diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index a6f74069..6b57b4bd 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -232,32 +232,32 @@ static sexp sexp_string_contains (sexp ctx sexp_api_params(self, n), sexp x, sex sexp_env_define(ctx, env, sexp_intern(ctx, name, -1), sexp_type_by_index(ctx, tag)); sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { - sexp_define_type(ctx, "", SEXP_OBJECT); - sexp_define_type(ctx, "", SEXP_NUMBER); - sexp_define_type(ctx, "", SEXP_BIGNUM); - sexp_define_type(ctx, "", SEXP_FLONUM); - sexp_define_type(ctx, "", SEXP_FIXNUM); - sexp_define_type(ctx, "", SEXP_SYMBOL); - sexp_define_type(ctx, "", SEXP_CHAR); - sexp_define_type(ctx, "", SEXP_BOOLEAN); - sexp_define_type(ctx, "", SEXP_STRING); - sexp_define_type(ctx, "", SEXP_BYTES); - sexp_define_type(ctx, "", SEXP_PAIR); - sexp_define_type(ctx, "", SEXP_VECTOR); - sexp_define_type(ctx, "", SEXP_OPCODE); - sexp_define_type(ctx, "", SEXP_PROCEDURE); - sexp_define_type(ctx, "", SEXP_BYTECODE); - sexp_define_type(ctx, "", SEXP_ENV); - sexp_define_type(ctx, "", SEXP_MACRO); - sexp_define_type(ctx, "", SEXP_LAMBDA); - sexp_define_type(ctx, "", SEXP_CND); - sexp_define_type(ctx, "", SEXP_SET); - sexp_define_type(ctx, "", SEXP_REF); - sexp_define_type(ctx, "", SEXP_SEQ); - sexp_define_type(ctx, "", SEXP_LIT); - sexp_define_type(ctx, "", SEXP_SYNCLO); - sexp_define_type(ctx, "", SEXP_CONTEXT); - sexp_define_type(ctx, "", SEXP_EXCEPTION); + sexp_define_type(ctx, "Object", SEXP_OBJECT); + sexp_define_type(ctx, "Number", SEXP_NUMBER); + sexp_define_type(ctx, "Bignum", SEXP_BIGNUM); + sexp_define_type(ctx, "Flonum", SEXP_FLONUM); + sexp_define_type(ctx, "Integer", SEXP_FIXNUM); + sexp_define_type(ctx, "Symbol", SEXP_SYMBOL); + sexp_define_type(ctx, "Char", SEXP_CHAR); + sexp_define_type(ctx, "Boolean", SEXP_BOOLEAN); + sexp_define_type(ctx, "String", SEXP_STRING); + sexp_define_type(ctx, "Byte-Vector", SEXP_BYTES); + sexp_define_type(ctx, "Pair", SEXP_PAIR); + sexp_define_type(ctx, "Vector", SEXP_VECTOR); + sexp_define_type(ctx, "Opcode", SEXP_OPCODE); + sexp_define_type(ctx, "Procedure", SEXP_PROCEDURE); + sexp_define_type(ctx, "Bytecode", SEXP_BYTECODE); + sexp_define_type(ctx, "Env", SEXP_ENV); + sexp_define_type(ctx, "Macro", SEXP_MACRO); + sexp_define_type(ctx, "Lam", SEXP_LAMBDA); + sexp_define_type(ctx, "Cnd", SEXP_CND); + sexp_define_type(ctx, "Set", SEXP_SET); + sexp_define_type(ctx, "Ref", SEXP_REF); + sexp_define_type(ctx, "Seq", SEXP_SEQ); + sexp_define_type(ctx, "Lit", SEXP_LIT); + sexp_define_type(ctx, "Sc", SEXP_SYNCLO); + sexp_define_type(ctx, "Context", SEXP_CONTEXT); + sexp_define_type(ctx, "Exception", SEXP_EXCEPTION); sexp_define_type_predicate(ctx, env, "environment?", SEXP_ENV); sexp_define_type_predicate(ctx, env, "bytecode?", SEXP_BYTECODE); sexp_define_type_predicate(ctx, env, "macro?", SEXP_MACRO); @@ -298,7 +298,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { sexp_define_accessors(ctx, env, SEXP_LIT, 0, "lit-value", "lit-value-set!"); sexp_define_accessors(ctx, env, SEXP_PROCEDURE, 1, "procedure-code", NULL); sexp_define_accessors(ctx, env, SEXP_PROCEDURE, 2, "procedure-vars", NULL); - sexp_define_accessors(ctx, env, SEXP_BYTECODE, 1, "bytecode-name", NULL); + sexp_define_accessors(ctx, env, SEXP_BYTECODE, 1, "bytecode-name", "bytecode-name-set!"); sexp_define_accessors(ctx, env, SEXP_BYTECODE, 2, "bytecode-literals", NULL); sexp_define_accessors(ctx, env, SEXP_BYTECODE, 3, "bytecode-source", NULL); sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 0, "exception-kind", NULL); diff --git a/lib/chibi/ast.module b/lib/chibi/ast.module index 3b7a58e9..03469479 100644 --- a/lib/chibi/ast.module +++ b/lib/chibi/ast.module @@ -2,10 +2,10 @@ (module (chibi ast) (export analyze optimize env-cell ast->sexp macroexpand type-of - - - - + Object Opcode Procedure Bytecode Macro Env + Number Bignum Flonum Integer Char Boolean + Symbol String Byte-Vector Vector Pair + Context Lam Cnd Set Ref Seq Lit Sc Exception syntactic-closure? lambda? cnd? set? ref? seq? lit? type? environment? bytecode? exception? macro? context? syntactic-closure-expr syntactic-closure-env syntactic-closure-vars @@ -25,7 +25,7 @@ opcode-name opcode-num-params opcode-return-type opcode-param-type opcode-variadic? macro-procedure macro-env macro-source - procedure-code procedure-vars procedure-name + procedure-code procedure-vars procedure-name procedure-name-set! bytecode-name bytecode-literals bytecode-source pair-source pair-source-set! port-line port-line-set! @@ -35,4 +35,3 @@ (import (scheme)) (include-shared "ast") (include "ast.scm")) - diff --git a/lib/chibi/ast.scm b/lib/chibi/ast.scm index 93fb5b36..4834c302 100644 --- a/lib/chibi/ast.scm +++ b/lib/chibi/ast.scm @@ -212,6 +212,9 @@ (define (procedure-name x) (bytecode-name (procedure-code x))) +(define (procedure-name-set! x name) + (bytecode-name-set! (procedure-code x) name)) + ;;> @subsubsubsection{Macros} ;;> @itemlist[ diff --git a/lib/chibi/type-inference.scm b/lib/chibi/type-inference.scm index 70a07d8f..c5931111 100644 --- a/lib/chibi/type-inference.scm +++ b/lib/chibi/type-inference.scm @@ -23,17 +23,17 @@ (not (unfinalized-type? a))) (define (numeric-type? a) - (or (eq? a ) (eq? a ) (eq? a ))) + (or (eq? a Number) (eq? a Flonum) (eq? a Integer))) (define (procedure-type? a) - (or (eq? a ) - (eq? a ) + (or (eq? a Opcode) + (eq? a Procedure) (and (pair? a) (eq? (car a) 'lambda)))) (define (type-subset? a b) (or (equal? a b) - (equal? a ) - (equal? b ) + (equal? a Object) + (equal? b Object) (and (numeric-type? a) (numeric-type? b)) (and (procedure-type? a) (procedure-type? b)) (if (union-type? a) @@ -46,7 +46,7 @@ (define (type-union a b) (cond ((equal? a b) a) - ((or (equal? a ) (equal? b )) ) + ((or (equal? a Object) (equal? b Object)) Object) ((union-type? a) (if (union-type? b) (cons (car a) (lset-union equal? (cdr a) (cdr b))) @@ -57,8 +57,8 @@ (define (type-intersection a b) (cond ((equal? a b) a) - ((or (equal? a ) (unfinalized-type? a)) b) - ((or (equal? b ) (unfinalized-type? b)) a) + ((or (equal? a Object) (unfinalized-type? a)) b) + ((or (equal? b Object) (unfinalized-type? b)) a) ((intersection-type? a) (if (intersection-type? b) (lset-intersection equal? (cdr a) (cdr b)) @@ -90,7 +90,7 @@ (define (type-analyze-expr x) (match x - (($ name params body defs) + (($ Lam name params body defs) (cond ((not (lambda-return-type x)) (lambda-return-type-set! x (list 'return-type x)) @@ -98,10 +98,10 @@ (let ((ret-type (type-analyze-expr body))) (lambda-return-type-set! x ret-type) (cons 'lambda (cons ret-type (lambda-param-types x))))))) - (($ ref value) + (($ Set ref value) (type-analyze-expr value) (if #f #f)) - (($ name (value . loc) source) + (($ Ref name (value . loc) source) (cond ((lambda? loc) (lambda-param-type-ref loc name)) ((procedure? loc) @@ -109,13 +109,13 @@ (if (and (pair? sig) (car sig)) (cons 'lambda sig) (list 'return-type (procedure-analysis loc))))) - (else ))) - (($ test pass fail) + (else Object))) + (($ Cnd test pass fail) (let ((test-type (type-analyze-expr test)) (pass-type (type-analyze-expr pass)) (fail-type (type-analyze-expr fail))) (type-union pass-type fail-type))) - (($ ls) + (($ Seq ls) (let lp ((ls ls)) (cond ((null? (cdr ls)) (type-analyze-expr (car ls))) @@ -135,7 +135,7 @@ (car p) (opcode-param-type f (opcode-num-params f))))) (match (car a) - (($ name (_ . (and g ($ )))) + (($ Ref name (_ . (and g ($ Lam)))) (let ((t (type-intersection (lambda-param-type-ref g name) p-type))) (lambda-param-type-set! g name t))) @@ -165,12 +165,12 @@ ((and (pair? f-type) (memq (car f-type) '(return-type param-type))) f-type) (else - )))))) + Object)))))) (else (type-of x)))) (define (resolve-delayed-type x) - (let lp ((x x) (seen '()) (default )) + (let lp ((x x) (seen '()) (default Object)) (match x (('return-type f) (if (memq f seen) @@ -183,7 +183,7 @@ (('or y ...) (let ((z (find finalized-type? y))) (if z - (let ((default (if (eq? default ) + (let ((default (if (eq? default Object) (lp z seen default) (type-union (lp z seen default) default)))) (fold type-union @@ -199,7 +199,7 @@ (define (type-resolve-circularities x) (match x - (($ name params body defs) + (($ Lam name params body defs) (if (unfinalized-type? (lambda-return-type x)) (lambda-return-type-set! x (resolve-delayed-type (lambda-return-type x)))) @@ -210,13 +210,13 @@ params (lambda-param-types x)) (type-resolve-circularities (lambda-body x))) - (($ ref value) + (($ Set ref value) (type-resolve-circularities value)) - (($ test pass fail) + (($ Cnd test pass fail) (type-resolve-circularities test) (type-resolve-circularities pass) (type-resolve-circularities fail)) - (($ ls) + (($ Seq ls) (for-each type-resolve-circularities ls)) ((app ...) (for-each type-resolve-circularities app)) diff --git a/lib/srfi/99/records/inspection.scm b/lib/srfi/99/records/inspection.scm index 4626050d..15994f39 100644 --- a/lib/srfi/99/records/inspection.scm +++ b/lib/srfi/99/records/inspection.scm @@ -1,6 +1,6 @@ (define (record? x) - (is-a? x )) + (is-a? x Object)) (define (record-rtd x) (type-of x))