steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

simpler t

cvs
Slava Pestov 2005-09-09 21:32:38 +00:00
parent d2f18a45de
commit 2bdd82ea53
10 changed files with 32 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
library/bootstrap/image.factor
View File

@ -27,8 +27,6 @@ SYMBOL: objects
SYMBOL: big-endian
SYMBOL: 64-bits
SYMBOL: t-object
: emit ( cell -- ) image get push ;
: emit-seq ( seq -- ) image get swap nappend ;
@ -119,13 +117,8 @@ M: bignum ' ( bignum -- tagged )
! Padded with fixnums for 8-byte alignment
: t,
object-tag here-as
dup t-offset fixup t-object set
t-type >header emit
0 ' emit ;
: t, t t-offset fixup ;
M: t ' ( obj -- ptr ) drop t-object get ;
M: f ' ( obj -- ptr )
#! f is #define F RETAG(0,OBJECT_TYPE)
drop object-tag ;

5
library/bootstrap/primitives.factor
View File

@ -300,8 +300,7 @@ null null define-class
{ { 0 { "real" "math" } f } { 1 { "imaginary" "math" } f } } define-builtin
"complex" "math" create 4 "math-priority" set-word-prop
"t" "!syntax" create 7 "t?" "kernel" create
{ } define-builtin
"displaced-alien" "alien" create 7 "displaced-alien?" "alien" create { } define-builtin
"array" "kernel-internals" create 8 "array?" "kernel-internals" create
{ } define-builtin
@ -350,8 +349,6 @@ null null define-class
"byte-array" "kernel-internals" create 19 "byte-array?" "kernel-internals" create { } define-builtin
"displaced-alien" "alien" create 20 "displaced-alien?" "alien" create { } define-builtin
! Define general-t type, which is any object that is not f.
"general-t" "kernel" create dup define-symbol
"general-t?" "kernel" create

26
library/compiler/intrinsics.factor
View File

@ -108,6 +108,7 @@ sequences vectors words ;
[
[[ fixnum+ %fixnum+ ]]
[[ fixnum- %fixnum- ]]
[[ fixnum* %fixnum* ]]
[[ fixnum/i %fixnum/i ]]
[[ fixnum-bitand %fixnum-bitand ]]
[[ fixnum-bitor %fixnum-bitor ]]
@ -122,27 +123,6 @@ sequences vectors words ;
"intrinsic" set-word-prop
] each
: fast-fixnum* ( n -- )
-1 %inc-d ,
in-1
log2 0 <vreg> 0 <vreg> %fixnum<< ,
out-1 ;
: slow-fixnum* ( node -- ) \ %fixnum* binary-op ;
\ fixnum* [
! Turn multiplication by a power of two into a left shift.
dup node-peek dup literal-immediate? [
literal-value dup power-of-2? [
nip fast-fixnum*
] [
drop slow-fixnum*
] ifte
] [
drop slow-fixnum*
] ifte
] "intrinsic" set-word-prop
\ fixnum-mod [
! This is not clever. Because of x86, %fixnum-mod is
! hard-coded to put its output in vreg 2, which happends to
@ -158,8 +138,8 @@ sequences vectors words ;
! See the remark on fixnum-mod for vreg usage
drop
in-2
[ << vreg f 1 >> << vreg f 0 >> ]
[ << vreg f 2 >> << vreg f 0 >> ]
{ << vreg f 1 >> << vreg f 0 >> }
{ << vreg f 2 >> << vreg f 0 >> }
%fixnum/mod ,
2 0 %replace-d ,
0 1 %replace-d ,

34
library/inference/known-words.factor
View File

@ -10,23 +10,23 @@ memory parser sequences strings vectors words prettyprint ;
! This transformation really belongs in the optimizer, but it
! is simpler to do it here.
\ fixnum< [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
\ fixnum< [ [ fixnum fixnum ] [ object ] ] "infer-effect" set-word-prop
\ fixnum< t "flushable" set-word-prop
\ fixnum< t "foldable" set-word-prop
\ fixnum<= [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
\ fixnum<= [ [ fixnum fixnum ] [ object ] ] "infer-effect" set-word-prop
\ fixnum<= t "flushable" set-word-prop
\ fixnum<= t "foldable" set-word-prop
\ fixnum> [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
\ fixnum> [ [ fixnum fixnum ] [ object ] ] "infer-effect" set-word-prop
\ fixnum> t "flushable" set-word-prop
\ fixnum> t "foldable" set-word-prop
\ fixnum>= [ [ fixnum fixnum ] [ boolean ] ] "infer-effect" set-word-prop
\ fixnum>= [ [ fixnum fixnum ] [ object ] ] "infer-effect" set-word-prop
\ fixnum>= t "flushable" set-word-prop
\ fixnum>= t "foldable" set-word-prop
\ eq? [ [ object object ] [ boolean ] ] "infer-effect" set-word-prop
\ eq? [ [ object object ] [ object ] ] "infer-effect" set-word-prop
\ eq? t "flushable" set-word-prop
\ eq? t "foldable" set-word-prop
@ -189,7 +189,7 @@ memory parser sequences strings vectors words prettyprint ;
\ fixnum-shift t "flushable" set-word-prop
\ fixnum-shift t "foldable" set-word-prop
\ bignum= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
\ bignum= [ [ bignum bignum ] [ object ] ] "infer-effect" set-word-prop
\ bignum= t "flushable" set-word-prop
\ bignum= t "foldable" set-word-prop
@ -241,23 +241,23 @@ memory parser sequences strings vectors words prettyprint ;
\ bignum-shift t "flushable" set-word-prop
\ bignum-shift t "foldable" set-word-prop
\ bignum< [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
\ bignum< [ [ bignum bignum ] [ object ] ] "infer-effect" set-word-prop
\ bignum< t "flushable" set-word-prop
\ bignum< t "foldable" set-word-prop
\ bignum<= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
\ bignum<= [ [ bignum bignum ] [ object ] ] "infer-effect" set-word-prop
\ bignum<= t "flushable" set-word-prop
\ bignum<= t "foldable" set-word-prop
\ bignum> [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
\ bignum> [ [ bignum bignum ] [ object ] ] "infer-effect" set-word-prop
\ bignum> t "flushable" set-word-prop
\ bignum> t "foldable" set-word-prop
\ bignum>= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
\ bignum>= [ [ bignum bignum ] [ object ] ] "infer-effect" set-word-prop
\ bignum>= t "flushable" set-word-prop
\ bignum>= t "foldable" set-word-prop
\ float= [ [ bignum bignum ] [ boolean ] ] "infer-effect" set-word-prop
\ float= [ [ bignum bignum ] [ object ] ] "infer-effect" set-word-prop
\ float= t "flushable" set-word-prop
\ float= t "foldable" set-word-prop
@ -277,19 +277,19 @@ memory parser sequences strings vectors words prettyprint ;
\ float/f t "flushable" set-word-prop
\ float/f t "foldable" set-word-prop
\ float< [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
\ float< [ [ float float ] [ object ] ] "infer-effect" set-word-prop
\ float< t "flushable" set-word-prop
\ float< t "foldable" set-word-prop
\ float<= [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
\ float<= [ [ float float ] [ object ] ] "infer-effect" set-word-prop
\ float<= t "flushable" set-word-prop
\ float<= t "foldable" set-word-prop
\ float> [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
\ float> [ [ float float ] [ object ] ] "infer-effect" set-word-prop
\ float> t "flushable" set-word-prop
\ float> t "foldable" set-word-prop
\ float>= [ [ float float ] [ boolean ] ] "infer-effect" set-word-prop
\ float>= [ [ float float ] [ object ] ] "infer-effect" set-word-prop
\ float>= t "flushable" set-word-prop
\ float>= t "foldable" set-word-prop
@ -345,7 +345,7 @@ memory parser sequences strings vectors words prettyprint ;
\ <word> t "flushable" set-word-prop
\ update-xt [ [ word ] [ ] ] "infer-effect" set-word-prop
\ compiled? [ [ word ] [ boolean ] ] "infer-effect" set-word-prop
\ compiled? [ [ word ] [ object ] ] "infer-effect" set-word-prop
\ getenv [ [ fixnum ] [ object ] ] "infer-effect" set-word-prop
\ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop
@ -492,7 +492,7 @@ memory parser sequences strings vectors words prettyprint ;
\ fwrite [ [ string alien ] [ ] ] "infer-effect" set-word-prop
\ fflush [ [ alien ] [ ] ] "infer-effect" set-word-prop
\ fclose [ [ alien ] [ ] ] "infer-effect" set-word-prop
\ expired? [ [ object ] [ boolean ] ] "infer-effect" set-word-prop
\ expired? [ [ object ] [ object ] ] "infer-effect" set-word-prop
\ <wrapper> [ [ object ] [ wrapper ] ] "infer-effect" set-word-prop
\ <wrapper> t "flushable" set-word-prop

4
library/kernel.factor
View File

@ -11,8 +11,6 @@ USING: generic kernel-internals vectors ;
#! on the data stack by the caller.
{ } set-datastack ;
UNION: boolean POSTPONE: f POSTPONE: t ;
GENERIC: hashcode ( obj -- n ) flushable
M: object hashcode drop 0 ;
@ -28,7 +26,7 @@ M: object clone ;
: num-types ( -- n )
#! One more than the maximum value from type primitive.
21 ; inline
20 ; inline
: ? ( cond t f -- t/f )
#! Push t if cond is true, otherwise push f.

4
library/syntax/parse-syntax.factor
View File

@ -36,8 +36,10 @@ words ;
! Booleans
: t t swons ; parsing
! the canonical truth value is just a symbol.
SYMBOL: t
! the canonical falsity is a special runtime object.
: f f swons ; parsing
! Lists

2
library/syntax/prettyprint.factor
View File

@ -230,8 +230,6 @@ M: word pprint* ( word -- )
dup pprint-word
"pprint-after-hook" word-prop call ;
M: t pprint* drop "t" f text ;
M: f pprint* drop "f" f text ;
M: dll pprint* ( obj -- str ) dll-path "DLL\" " pprint-string ;

2
library/test/generic.factor
View File

@ -34,7 +34,7 @@ M: fixnum foobar drop "Goodbye cruel world" ;
[ "Goodbye cruel world" ] [ 4 foobar ] unit-test
GENERIC: bool>str
M: t bool>str drop "true" ;
M: general-t bool>str drop "true" ;
M: f bool>str drop "false" ;
: str>bool

3
native/memory.c
View File

@ -48,9 +48,6 @@ CELL untagged_object_size(CELL pointer)
case WORD_TYPE:
size = sizeof(F_WORD);
break;
case T_TYPE:
size = CELLS * 2;
break;
case ARRAY_TYPE:
case TUPLE_TYPE:
case BIGNUM_TYPE:

10
native/memory.h
View File

@ -54,9 +54,7 @@ INLINE CELL align8(CELL a)
/*** Header types ***/
/* Canonical T object */
#define T_TYPE 7
CELL T;
#define DISPLACED_ALIEN_TYPE 7
#define ARRAY_TYPE 8
@ -74,9 +72,11 @@ CELL T;
#define WORD_TYPE 17
#define TUPLE_TYPE 18
#define BYTE_ARRAY_TYPE 19
#define DISPLACED_ALIEN_TYPE 20
#define TYPE_COUNT 21
#define TYPE_COUNT 20
/* Canonical T object. It's just a word */
CELL T;
INLINE bool headerp(CELL cell)
{