classes.builtin: Add the BUILTIN: keyword which lets builtin classes show up in source files. Probably could use save-location to allow editing, but it seemed to break things.
parent
ac95c024f3
commit
5a9e7cd374
|
@ -204,9 +204,8 @@ M: tuple-class see-class*
|
|||
M: word see-class* drop ;
|
||||
|
||||
M: builtin-class see-class*
|
||||
"! Built-in class" comment.
|
||||
<block
|
||||
\ PRIMITIVE: pprint-word
|
||||
\ BUILTIN: pprint-word
|
||||
[ pprint-word ]
|
||||
[ <block "slots" word-prop [ pprint-slot ] each pprint-; block> ] bi
|
||||
block> ;
|
||||
|
|
|
@ -4,6 +4,9 @@ USING: accessors byte-arrays byte-vectors continuations.private
|
|||
init kernel kernel.private math namespaces sequences ;
|
||||
IN: alien
|
||||
|
||||
BUILTIN: alien { underlying c-ptr read-only initial: f } expired ;
|
||||
BUILTIN: dll { path byte-array read-only initial: B{ } } ;
|
||||
|
||||
PREDICATE: pinned-alien < alien underlying>> not ;
|
||||
|
||||
UNION: pinned-c-ptr pinned-alien POSTPONE: f ;
|
||||
|
|
|
@ -3,6 +3,8 @@
|
|||
USING: accessors kernel math sequences sequences.private ;
|
||||
IN: arrays
|
||||
|
||||
BUILTIN: array { length array-capacity read-only initial: 0 } ;
|
||||
|
||||
M: array clone (clone) ; inline
|
||||
M: array length length>> ; inline
|
||||
M: array nth-unsafe [ integer>fixnum ] dip array-nth ; inline
|
||||
|
|
|
@ -42,6 +42,7 @@ IN: bootstrap.syntax
|
|||
"SBUF\""
|
||||
"SINGLETON:"
|
||||
"SINGLETONS:"
|
||||
"BUILTIN:"
|
||||
"SYMBOL:"
|
||||
"SYMBOLS:"
|
||||
"CONSTANT:"
|
||||
|
|
|
@ -4,6 +4,9 @@ USING: accessors alien.accessors kernel math sequences
|
|||
sequences.private ;
|
||||
IN: byte-arrays
|
||||
|
||||
BUILTIN: byte-array
|
||||
{ length array-capacity read-only initial: 0 } ;
|
||||
|
||||
M: byte-array clone (clone) ; inline
|
||||
M: byte-array length length>> ; inline
|
||||
M: byte-array nth-unsafe swap integer>fixnum alien-unsigned-1 ; inline
|
||||
|
|
|
@ -9,6 +9,11 @@ SYMBOL: builtins
|
|||
PREDICATE: builtin-class < class
|
||||
"metaclass" word-prop builtin-class eq? ;
|
||||
|
||||
ERROR: not-a-builtin object ;
|
||||
|
||||
: check-builtin ( class -- )
|
||||
dup builtin-class? [ drop ] [ not-a-builtin ] if ;
|
||||
|
||||
: class>type ( class -- n ) "type" word-prop ; foldable
|
||||
|
||||
: type>class ( n -- class ) builtins get-global nth ; foldable
|
||||
|
|
|
@ -54,8 +54,7 @@ ERROR: invalid-slot-name name ;
|
|||
: parse-tuple-slots ( -- )
|
||||
";" parse-tuple-slots-delim ;
|
||||
|
||||
: parse-tuple-definition ( -- class superclass slots )
|
||||
scan-new-class
|
||||
: (parse-tuple-definition) ( word -- class superclass slots )
|
||||
scan-token {
|
||||
{ ";" [ tuple f ] }
|
||||
{ "<" [ scan-word [ parse-tuple-slots ] { } make ] }
|
||||
|
@ -64,6 +63,10 @@ ERROR: invalid-slot-name name ;
|
|||
dup check-duplicate-slots
|
||||
3dup check-slot-shadowing ;
|
||||
|
||||
: parse-tuple-definition ( -- class superclass slots )
|
||||
scan-new-class (parse-tuple-definition) ;
|
||||
|
||||
|
||||
ERROR: bad-literal-tuple ;
|
||||
|
||||
ERROR: bad-slot-name class slot ;
|
||||
|
|
|
@ -3,6 +3,10 @@
|
|||
USING: kernel.private slots.private math.private ;
|
||||
IN: kernel
|
||||
|
||||
BUILTIN: callstack ;
|
||||
BUILTIN: tuple ;
|
||||
BUILTIN: wrapper { wrapped read-only } ;
|
||||
|
||||
DEFER: dip
|
||||
DEFER: 2dip
|
||||
DEFER: 3dip
|
||||
|
|
|
@ -3,6 +3,10 @@
|
|||
USING: kernel ;
|
||||
IN: math
|
||||
|
||||
BUILTIN: fixnum ;
|
||||
BUILTIN: bignum ;
|
||||
BUILTIN: float ;
|
||||
|
||||
GENERIC: >fixnum ( x -- n ) foldable
|
||||
GENERIC: >bignum ( x -- n ) foldable
|
||||
GENERIC: >integer ( x -- n ) foldable
|
||||
|
|
|
@ -4,6 +4,11 @@ USING: accessors arrays kernel kernel.private math sequences
|
|||
sequences.private slots.private ;
|
||||
IN: quotations
|
||||
|
||||
BUILTIN: quotation
|
||||
{ array array read-only initial: { } }
|
||||
cached-effect
|
||||
cache-counter ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: uncurry ( curry -- obj quot )
|
||||
|
|
|
@ -5,6 +5,8 @@ kernel.private math math.private sequences sequences.private
|
|||
slots.private ;
|
||||
IN: strings
|
||||
|
||||
BUILTIN: string { length array-capacity read-only initial: 0 } aux ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: string-hashcode ( str -- n ) 3 slot ; inline
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2004, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays byte-arrays byte-vectors
|
||||
classes.algebra.private classes.intersection classes.maybe
|
||||
classes.mixin classes.parser classes.predicate
|
||||
classes.algebra.private classes.builtin classes.intersection
|
||||
classes.maybe classes.mixin classes.parser classes.predicate
|
||||
classes.singleton classes.tuple classes.tuple.parser
|
||||
classes.union combinators compiler.units definitions
|
||||
effects.parser generic generic.hook generic.math generic.parser
|
||||
|
@ -116,6 +116,12 @@ IN: bootstrap.syntax
|
|||
scan-new-word parse-definition define-syntax
|
||||
] define-core-syntax
|
||||
|
||||
"BUILTIN:" [
|
||||
scan-word-name
|
||||
current-vocab lookup-word
|
||||
(parse-tuple-definition) 2drop check-builtin
|
||||
] define-core-syntax
|
||||
|
||||
"SYMBOL:" [
|
||||
scan-new-word define-symbol
|
||||
] define-core-syntax
|
||||
|
|
|
@ -6,6 +6,11 @@ slots.private strings vocabs ;
|
|||
FROM: assocs => change-at ;
|
||||
IN: words
|
||||
|
||||
BUILTIN: word
|
||||
{ hashcode fixnum initial: 0 } name vocabulary
|
||||
{ def quotation initial: [ ] } props pic-def pic-tail-def
|
||||
{ sub-primitive read-only } ;
|
||||
|
||||
: word ( -- word ) \ word get-global ;
|
||||
|
||||
: set-word ( word -- ) \ word set-global ;
|
||||
|
|
Loading…
Reference in New Issue