CHAR: notation for literal chars, native parser work

TODO.FACTOR.txt

@@ -1,6 +1,7 @@
 + native:
 
-- parsing: #\, |
+- top level catch should be a continuation
+- parsing: #\
 - {...} vectors
 - parsing should be parsing
 - telnetd: listening on a socket

build.sh

@@ -3,11 +3,6 @@ rm *.o
 export CC=gcc34
 export CFLAGS="-pedantic -Wall -Winline -O4 -Os -march=pentium4 -fomit-frame-pointer -falign-functions=8"
 
-$CC $CFLAGS -o f *.c
+$CC $CFLAGS -o f native/*.c
 
 strip f
-
-#export CC=gcc
-#export CFLAGS="-g"
-
-#$CC $CFLAGS -o f-debug *.c

factor/FactorInterpreter.java

@@ -153,23 +153,39 @@ public class FactorInterpreter implements FactorObject, Runnable
 		in = "builtins";
 		use = new Cons(in,null);
 
-		// parsing words
+		/* comments */
 		FactorWord lineComment = define("builtins","!");
 		lineComment.parsing = new LineComment(lineComment,false);
 		FactorWord stackComment = define("builtins","(");
 		stackComment.parsing = new StackComment(stackComment);
+		FactorWord docComment = define("builtins","#!");
+		docComment.parsing = new LineComment(docComment,true);
+
+		/* strings */
 		FactorWord str = define("builtins","\"");
 		str.parsing = new StringLiteral(str,true);
+		FactorWord ch = define("builtins","CHAR:");
+		ch.parsing = new CharLiteral(ch);
+		FactorWord raw = define("builtins","#\"");
+		raw.parsing = new StringLiteral(raw,false);
+
+		/* constants */
 		FactorWord t = define("builtins","t");
 		t.parsing = new T(t);
 		FactorWord f = define("builtins","f");
 		f.parsing = new F(f);
+		FactorWord complex = define("builtins","#{");
+		complex.parsing = new ComplexLiteral(complex,"}");
+
+		/* lists */
 		FactorWord bra = define("builtins","[");
 		bra.parsing = new Bra(bra);
 		FactorWord ket = define("builtins","]");
 		ket.parsing = new Ket(bra,ket);
 		FactorWord bar = define("builtins","|");
 		bar.parsing = new Bar(bar);
+
+		/* word defs */
 		FactorWord def = define("builtins",":");
 		def.parsing = new Def(def);
 		def.getNamespace().setVariable("doc-comments",Boolean.TRUE);
@@ -178,20 +194,17 @@ public class FactorInterpreter implements FactorObject, Runnable
 		FactorWord shuffle = define("builtins","~<<");
 		shuffle.parsing = new Shuffle(shuffle,">>~");
 
-		FactorWord noParsing = define("builtins","POSTPONE:");
+		/* reading numbers with another base */
-		noParsing.parsing = new NoParsing(noParsing);
+		FactorWord bin = define("builtins","BIN:");
+		bin.parsing = new Base(bin,2);
+		FactorWord oct = define("builtins","OCT:");
+		oct.parsing = new Base(oct,8);
+		FactorWord hex = define("builtins","HEX:");
+		hex.parsing = new Base(hex,16);
 
-		// #X
+		/* specials */
 		FactorWord dispatch = define("builtins","#");
 		dispatch.parsing = new Dispatch(dispatch);
-		FactorWord ch = define("builtins","#\\");
-		ch.parsing = new CharLiteral(ch);
-		FactorWord raw = define("builtins","#\"");
-		raw.parsing = new StringLiteral(raw,false);
-		FactorWord complex = define("builtins","#{");
-		complex.parsing = new ComplexLiteral(complex,"}");
-		FactorWord docComment = define("builtins","#!");
-		docComment.parsing = new LineComment(docComment,true);
 		FactorWord unreadable = define("builtins","#<");
 		unreadable.parsing = new Unreadable(unreadable);
 
@@ -201,7 +214,9 @@ public class FactorInterpreter implements FactorObject, Runnable
 		FactorWord passthru = define("builtins","#:");
 		passthru.parsing = new PassThrough(passthru);
 
-		// vocabulary parsing words
+		/* vocabulary parsing words */
+		FactorWord noParsing = define("builtins","POSTPONE:");
+		noParsing.parsing = new NoParsing(noParsing);
 		FactorWord defer = define("builtins","DEFER:");
 		defer.parsing = new Defer(defer);
 		FactorWord in = define("builtins","IN:");
@@ -213,14 +228,6 @@ public class FactorInterpreter implements FactorObject, Runnable
 		interpreterGet.def = new InterpreterGet(interpreterGet);
 		interpreterGet.inline = true;
 
-		// reading numbers with another base
-		FactorWord bin = define("builtins","BIN:");
-		bin.parsing = new Base(bin,2);
-		FactorWord oct = define("builtins","OCT:");
-		oct.parsing = new Base(oct,8);
-		FactorWord hex = define("builtins","HEX:");
-		hex.parsing = new Base(hex,16);
-
 		// primitives used by 'expand' and 'map'
 		FactorWord restack = define("builtins","restack");
 		restack.def = new Restack(restack);

factor/parser/CharLiteral.java

@@ -47,8 +47,9 @@ public class CharLiteral extends FactorParsingDefinition
 	public void eval(FactorInterpreter interp, FactorReader reader)
 		throws IOException, FactorParseException
 	{
-		reader.append(new Character(
+		String word = (String)reader.nextNonEOF(false,false);
-			reader.getScanner()
+		if(word.length() != 1)
-			.readNonEOFEscaped()));
+			reader.error("Bad character literal: " + word);
+		reader.append(new Character(word.charAt(0)));
 	}
 }

library/ansi.factor

@@ -35,7 +35,8 @@ USE: stack
 USE: streams
 USE: strings
 
-!!! Some words for outputting ANSI colors.
+! Some words for outputting ANSI colors.
+
 : black   0 ; inline
 : red     1 ; inline
 : green   2 ; inline

library/continuations.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2003 Slava Pestov.
+! Copyright (C) 2003, 2004 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:

library/hashtables.factor

@@ -33,9 +33,9 @@ USE: lists
 USE: stack
 USE: vectors
 
-!!! Note that the length of a hashtable vector must not change
+! Note that the length of a hashtable vector must not change
-!!! for the lifetime of the hashtable, otherwise problems will
+! for the lifetime of the hashtable, otherwise problems will
-!!! occur. Do not use vector words with hashtables.
+! occur. Do not use vector words with hashtables.
 
 : hashtable? ( obj -- ? )
     dup vector? [ [ assoc? ] vector-all? ] [ drop f ] ifte ;

library/httpd/html.factor

@@ -40,11 +40,11 @@ USE: url-encoding
 
 : html-entities ( -- alist )
     [
-        [ #\< | "&lt;"   ]
+        [ CHAR: < | "&lt;"   ]
-        [ #\> | "&gt;"   ]
+        [ CHAR: > | "&gt;"   ]
-        [ #\& | "&amp;"  ]
+        [ CHAR: & | "&amp;"  ]
-        [ #\' | "&apos;" ]
+        [ CHAR: ' | "&apos;" ]
-        [ #\" | "&quot;" ]
+        [ CHAR: " | "&quot;" ]
     ] ;
 
 : chars>entities ( str -- str )

library/init.factor

@@ -39,8 +39,8 @@ USE: stdio
 USE: streams
 USE: strings
 
-!!! This file is run as the last stage of boot.factor; it relies
+! This file is run as the last stage of boot.factor; it relies
-!!! on all other words already being defined.
+! on all other words already being defined.
 
 : init-search-path ( -- )
     #! Sets up the default vocabularies.

library/namespaces.factor

@@ -34,24 +34,24 @@ USE: stack
 USE: strings
 USE: vectors
 
-!!! Other languages have classes, objects, variables, etc.
+! Other languages have classes, objects, variables, etc.
-!!! Factor has similar concepts.
+! Factor has similar concepts.
-!!!
+!
-!!!   5 "x" set
+!   5 "x" set
-!!!   "x" get 2 + .
+!   "x" get 2 + .
-!!! 7
+! 7
-!!!   7 "x" set
+!   7 "x" set
-!!!   "x" get 2 + .
+!   "x" get 2 + .
-!!! 9
+! 9
-!!!
+!
-!!! get ( name -- value ) and set ( value name -- ) search in
+! get ( name -- value ) and set ( value name -- ) search in
-!!! the namespaces on the namespace stack, in top-down order.
+! the namespaces on the namespace stack, in top-down order.
-!!!
+!
-!!! At the bottom of the namespace stack, is the global
+! At the bottom of the namespace stack, is the global
-!!! namespace; it is always present.
+! namespace; it is always present.
-!!!
+!
-!!! bind ( namespace quot -- ) executes a quotation with a
+! bind ( namespace quot -- ) executes a quotation with a
-!!! namespace pushed on the namespace stack.
+! namespace pushed on the namespace stack.
 
 : namestack ( -- stack )
     #! Push a copy of the namespace stack; same naming

library/platform/native/.kernel.factor.marks

@@ -1 +1 @@
-!a;2200;2200
+!a;2201;2201

library/platform/native/boot.factor

@@ -79,8 +79,11 @@ primitives,
     "/library/platform/native/io-internals.factor"
     "/library/platform/native/stream.factor"
     "/library/platform/native/kernel.factor"
+    "/library/platform/native/image.factor"
     "/library/platform/native/namespaces.factor"
+    "/library/platform/native/parse-numbers.factor"
     "/library/platform/native/parser.factor"
+    "/library/platform/native/parse-syntax.factor"
     "/library/platform/native/parse-stream.factor"
     "/library/platform/native/prettyprint.factor"
     "/library/platform/native/stack.factor"
@@ -100,7 +103,7 @@ primitives,
     max 2list length reverse nth list? 2rlist
     all? clone-list clone-list-iter subset subset-iter
     subset-add car= cdr= cons= cons-hashcode
-    tree-contains? =-or-contains? last* last
+    tree-contains? =-or-contains? last* last inject
 ] [ worddef worddef, ] each
 
 version,

library/platform/native/cross-compiler.factor

@@ -107,7 +107,11 @@ IN: cross-compiler
         mod
         /mod
         bitand
+        bitor
         bitxor
+        bitnot
+        shift>
+        shift<
         <
         <=
         >
@@ -176,4 +180,4 @@ IN: cross-compiler
 
     ! Uncomment this on sparc and powerpc.
     ! "big-endian" on
-    "native/factor.image" write-image ;
+    "factor.image" write-image ;

library/platform/native/kernel.factor

@@ -95,9 +95,11 @@ USE: words
 : inline ;
 : interpret-only ;
 
-!!! HACK
+! HACKS
 
 IN: strings
+: char? drop f ;
+: >char ;
 : >upper ;
 : >lower ;
 IN: lists

library/platform/native/parse-numbers.factor

@@ -0,0 +1,81 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: parser
+USE: arithmetic
+USE: combinators
+USE: errors
+USE: kernel
+USE: lists
+USE: logic
+USE: namespaces
+USE: stack
+USE: strings
+USE: words
+USE: vocabularies
+USE: unparser
+
+! Number parsing
+
+: letter? CHAR: a CHAR: z between? ;
+: LETTER? CHAR: A CHAR: Z between? ;
+: digit? CHAR: 0 CHAR: 9 between? ;
+
+: not-a-number "Not a number" throw ;
+
+: digit> ( ch -- n )
+    [
+        [ digit? ] [ CHAR: 0 - ]
+        [ letter? ] [ CHAR: a - 10 + ]
+        [ LETTER? ] [ CHAR: A - 10 + ]
+        [ drop t ] [ not-a-number ]
+    ] cond ;
+
+: >digit ( n -- ch )
+    dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] ifte ;
+
+: digit ( num digit -- num )
+    "base" get swap 2dup > [
+        >r * r> +
+    ] [
+        not-a-number
+    ] ifte ;
+
+: (str>fixnum) ( str -- num )
+    0 swap [ digit> digit ] str-each ;
+
+: str>fixnum ( str -- num )
+    #! Parse a string representation of an integer.
+    dup str-length 0 = [
+        drop not-a-number
+    ] [
+        dup "-" str-head? dup [
+            nip str>fixnum neg
+        ] [
+            drop (str>fixnum)
+        ] ifte
+    ] ifte ;

library/platform/native/parse-syntax.factor

@@ -0,0 +1,125 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: parser
+USE: arithmetic
+USE: combinators
+USE: errors
+USE: kernel
+USE: lists
+USE: logic
+USE: namespaces
+USE: stack
+USE: strings
+USE: words
+USE: vocabularies
+USE: unparser
+
+! Parsing words. 'builtins' is a stupid vocabulary name now
+! that it does not contain Java words anymore!
+
+IN: builtins
+
+! Constants
+: t t parsed ; parsing
+: f f parsed ; parsing
+
+! Lists
+: [ f ; parsing
+: ] nreverse parsed ; parsing
+
+: | ( syntax: | cdr ] )
+    #! See the word 'parsed'. We push a special sentinel, and
+    #! 'parsed' acts accordingly.
+    "|" ; parsing
+
+! Colon defs
+: :
+    #! Begin a word definition. Word name follows.
+    scan "in" get create f ; parsing
+
+: ;
+    #! End a word definition.
+    nreverse define ; parsing
+
+! Vocabularies
+: DEFER: scan "in" get create drop ; parsing
+: USE: scan "use" cons@ ; parsing
+: IN: scan dup "use" cons@ "in" set ; parsing
+
+! \x
+: escape ( ch -- esc )
+    [
+        [ CHAR: e | CHAR: \e ]
+        [ CHAR: n | CHAR: \n ]
+        [ CHAR: r | CHAR: \r ]
+        [ CHAR: t | CHAR: \t ]
+        [ CHAR: s | CHAR: \s ]
+        [ CHAR: \s | CHAR: \s ]
+        [ CHAR: 0 | CHAR: \0 ]
+        [ CHAR: \\ | CHAR: \\ ]
+        [ CHAR: \" | CHAR: \" ]
+    ] assoc ;
+
+! String literal
+
+: parse-escape ( -- )
+    next-ch escape dup [ drop "Bad escape" throw ] unless ;
+
+: parse-ch ( ch -- ch )
+    dup CHAR: \\ = [ drop parse-escape ] when ;
+
+: parse-string ( -- )
+    next-ch dup CHAR: " = [
+        drop
+    ] [
+        parse-ch % parse-string
+    ] ifte ;
+
+: "
+    #! Note the ugly hack to carry the new value of 'pos' from
+    #! the <% %> scope up to the original scope.
+    <% parse-string "pos" get %> swap "pos" set parsed ; parsing
+
+! Char literal
+: CHAR: ( -- ) skip-blank next-ch parse-ch parsed ; parsing
+
+! Comments
+: ( ")" until drop ; parsing
+: ! until-eol drop ; parsing
+: #! until-eol drop ; parsing
+    
+! Reading numbers in other bases
+
+: BASE: ( base -- )
+    #! Read a number in a specific base.
+    "base" get >r "base" set scan number, r> "base" set ;
+
+: HEX: 16 BASE: ; parsing
+: DEC: 10 BASE: ; parsing
+: OCT: 8 BASE: ; parsing
+: BIN: 2 BASE: ; parsing

library/platform/native/parser.factor

@@ -39,47 +39,6 @@ USE: words
 USE: vocabularies
 USE: unparser
 
-! Number parsing
-
-: letter? #\a #\z between? ;
-: LETTER? #\A #\Z between? ;
-: digit? #\0 #\9 between? ;
-
-: not-a-number "Not a number" throw ;
-
-: digit> ( ch -- n )
-    [
-        [ digit? ] [ #\0 - ]
-        [ letter? ] [ #\a - 10 + ]
-        [ LETTER? ] [ #\A - 10 + ]
-        [ drop t ] [ not-a-number ]
-    ] cond ;
-
-: >digit ( n -- ch )
-    dup 10 < [ #\0 + ] [ 10 - #\a + ] ifte ;
-
-: digit ( num digit -- num )
-    "base" get swap 2dup >= [
-        >r * r> +
-    ] [
-        not-a-number
-    ] ifte ;
-
-: (str>fixnum) ( str -- num )
-    0 swap [ digit> digit ] str-each ;
-
-: str>fixnum ( str -- num )
-    #! Parse a string representation of an integer.
-    dup str-length 0 = [
-        drop not-a-number
-    ] [
-        dup "-" str-head? dup [
-            nip str>fixnum neg
-        ] [
-            drop (str>fixnum)
-        ] ifte
-    ] ifte ;
-
 ! The parser uses a number of variables:
 ! line - the line being parsed
 ! pos  - position in the line
@@ -118,7 +77,7 @@ USE: unparser
     #! "hello world"
     #!
     #! Will call the parsing word ".
-    ch "\"!" str-contains? ;
+    ch "\"" str-contains? ;
 
 : (scan) ( -- start end )
     skip-blank "pos" get
@@ -165,7 +124,7 @@ USE: unparser
 : eval ( "X" -- X )
     parse call ;
 
-!!! Used by parsing words
+! Used by parsing words
 : ch-search ( ch -- index )
     "pos" get "line" get rot index-of* ;
 
@@ -175,87 +134,8 @@ USE: unparser
 : until ( ch -- str )
     ch-search (until) ;
 
-: until-eol ( ch -- str )
+: until-eol ( -- str )
     "line" get str-length (until) ;
 
 : next-ch ( -- ch )
     end? [ "Unexpected EOF" throw ] [ ch advance ] ifte ;
-
-!!! Parsing words. 'builtins' is a stupid vocabulary name now
-!!! that it does not contain Java words anymore!
-
-IN: builtins
-
-! Constants
-: t t parsed ; parsing
-: f f parsed ; parsing
-
-! Lists
-: [ f ; parsing
-: ] nreverse parsed ; parsing
-
-: | ( syntax: | cdr ] )
-    #! See the word 'parsed'. We push a special sentinel, and
-    #! 'parsed' acts accordingly.
-    "|" ; parsing
-
-! Colon defs
-: :
-    #! Begin a word definition. Word name follows.
-    scan "in" get create f ; parsing
-
-: ;
-    #! End a word definition.
-    nreverse define ; parsing
-
-! Vocabularies
-: DEFER: scan "in" get create drop ; parsing
-: USE: scan "use" cons@ ; parsing
-: IN: scan dup "use" cons@ "in" set ; parsing
-
-! \x
-: escape ( ch -- esc )
-    [
-        [ #\e | #\\e ]
-        [ #\n | #\\n ]
-        [ #\r | #\\r ]
-        [ #\t | #\\t ]
-        [ #\s | #\\s ]
-        [ #\\s | #\\s ]
-        [ #\0 | #\\0 ]
-        [ #\\\ | #\\\ ]
-        [ #\\" | #\\" ]
-    ] assoc ;
-
-! String literal
-
-: parse-escape ( -- )
-    next-ch escape dup [ % ] [ drop "Bad escape" throw ] ifte ;
-
-: parse-string ( -- )
-    next-ch dup #\" = [
-        drop
-    ] [
-        dup #\\\ = [ drop parse-escape ] [ % ] ifte parse-string
-    ] ifte ;
-
-: "
-    #! Note the ugly hack to carry the new value of 'pos' from
-    #! the <% %> scope up to the original scope.
-    <% parse-string "pos" get %> swap "pos" set parsed ; parsing
-
-! Comments
-: ( ")" until drop ; parsing
-: ! until-eol drop ; parsing
-: #! until-eol drop ; parsing
-    
-! Reading numbers in other bases
-
-: BASE: ( base -- )
-    #! Read a number in a specific base.
-    "base" get >r "base" set scan number, r> "base" set ;
-
-: HEX: 16 BASE: ; parsing
-: DEC: 10 BASE: ; parsing
-: OCT: 8 BASE: ; parsing
-: BIN: 2 BASE: ; parsing

library/platform/native/stream.factor

@@ -53,5 +53,11 @@ USE: namespaces
 : <file-stream> ( path mode -- stream )
     open-file dup <native-stream> ;
 
+: <filebr> ( path -- stream )
+    "r" <file-stream> ;
+
+: <filebw> ( path -- stream )
+    "w" <file-stream> ;
+
 : init-stdio ( -- )
     stdin stdout <native-stream> "stdio" set ;

library/platform/native/unparser.factor

@@ -54,7 +54,7 @@ USE: vocabularies
 
 : unparse-str ( str -- str )
     #! Not done
-    <% #\" % % #\" % %> ;
+    <% CHAR: " % % CHAR: " % %> ;
 
 : unparse-word ( word -- str )
     word-name dup "#<unnamed>" ? ;

library/styles.factor

@@ -31,12 +31,12 @@ USE: kernel
 USE: namespaces
 USE: stack
 
-!!! A style is a namespace whose variable names and values hold
+! A style is a namespace whose variable names and values hold
-!!! significance to the 'fwrite-attr' word when applied to a
+! significance to the 'fwrite-attr' word when applied to a
-!!! stream that supports attributed string output.
+! stream that supports attributed string output.
-!!!
+!
-!!! The default style enumerates the canonical names and values
+! The default style enumerates the canonical names and values
-!!! to determine a style.
+! to determine a style.
 
 : default-style ( -- style )
     #! Push the default style object.

native/error.c

@@ -42,7 +42,6 @@ void general_error(CELL error, CELL tagged)
 
 void type_error(CELL type, CELL tagged)
 {
-	printf("throwing %d %d\n",type,tagged);
 	CONS* c = cons(tag_fixnum(type),tag_cons(cons(tagged,F)));
 	general_error(ERROR_TYPE,tag_cons(c));
 }

native/fixnum.c

@@ -58,12 +58,36 @@ void primitive_and(void)
 	env.dt = x & y;
 }
 
+void primitive_or(void)
+{
+	BINARY_OP(x,y);
+	env.dt = x | y;
+}
+
 void primitive_xor(void)
 {
 	BINARY_OP(x,y);
 	env.dt = x ^ y;
 }
 
+void primitive_not(void)
+{
+	type_check(FIXNUM_TYPE,env.dt);
+	env.dt = RETAG(~env.dt,FIXNUM_TYPE);
+}
+
+void primitive_shiftleft(void)
+{
+	BINARY_OP(x,y);
+	env.dt = UNTAG(x >> (y >> TAG_BITS));
+}
+
+void primitive_shiftright(void)
+{
+	BINARY_OP(x,y);
+	env.dt = x << (y >> TAG_BITS);
+}
+
 void primitive_less(void)
 {
 	BINARY_OP(x,y);

native/fixnum.h

@@ -19,7 +19,11 @@ void primitive_divide(void);
 void primitive_mod(void);
 void primitive_divmod(void);
 void primitive_and(void);
+void primitive_or(void);
 void primitive_xor(void);
+void primitive_not(void);
+void primitive_shiftleft(void);
+void primitive_shiftright(void);
 void primitive_less(void);
 void primitive_lesseq(void);
 void primitive_greater(void);

native/primitives.c

@@ -42,44 +42,48 @@ XT primitives[] = {
 	primitive_mod,                          /* 38 */
 	primitive_divmod,                       /* 39 */
 	primitive_and,                          /* 40 */
-	primitive_xor,                          /* 41 */
+	primitive_or,                           /* 41 */
-	primitive_less,                         /* 42 */
+	primitive_xor,                          /* 42 */
-	primitive_lesseq,                       /* 43 */
+	primitive_not,                          /* 43 */
-	primitive_greater,                      /* 44 */
+	primitive_shiftleft,                    /* 44 */
-	primitive_greatereq,                    /* 45 */
+	primitive_shiftright,                   /* 45 */
-	primitive_wordp,                        /* 46 */
+	primitive_less,                         /* 46 */
-	primitive_word,                         /* 47 */
+	primitive_lesseq,                       /* 47 */
-	primitive_word_primitive,               /* 48 */
+	primitive_greater,                      /* 48 */
-	primitive_set_word_primitive,           /* 49 */
+	primitive_greatereq,                    /* 49 */
-	primitive_word_parameter,               /* 50 */
+	primitive_wordp,                        /* 50 */
-	primitive_set_word_parameter,           /* 51 */
+	primitive_word,                         /* 51 */
-	primitive_word_plist,                   /* 52 */
+	primitive_word_primitive,               /* 52 */
-	primitive_set_word_plist,               /* 53 */
+	primitive_set_word_primitive,           /* 53 */
-	primitive_drop,                         /* 54 */
+	primitive_word_parameter,               /* 54 */
-	primitive_dup,                          /* 55 */
+	primitive_set_word_parameter,           /* 55 */
-	primitive_swap,                         /* 56 */
+	primitive_word_plist,                   /* 56 */
-	primitive_over,                         /* 57 */
+	primitive_set_word_plist,               /* 57 */
-	primitive_pick,                         /* 58 */
+	primitive_drop,                         /* 58 */
-	primitive_nip,                          /* 59 */
+	primitive_dup,                          /* 59 */
-	primitive_tuck,                         /* 60 */
+	primitive_swap,                         /* 60 */
-	primitive_rot,                          /* 61 */
+	primitive_over,                         /* 61 */
-	primitive_to_r,                         /* 62 */
+	primitive_pick,                         /* 62 */
-	primitive_from_r,                       /* 63 */
+	primitive_nip,                          /* 63 */
-	primitive_eq,                           /* 64 */
+	primitive_tuck,                         /* 64 */
-	primitive_getenv,                       /* 65 */
+	primitive_rot,                          /* 65 */
-	primitive_setenv,                       /* 66 */
+	primitive_to_r,                         /* 66 */
-	primitive_open_file,                    /* 67 */
+	primitive_from_r,                       /* 67 */
-	primitive_read_line_8,                  /* 68 */
+	primitive_eq,                           /* 68 */
-	primitive_write_8,                      /* 69 */
+	primitive_getenv,                       /* 69 */
-	primitive_close,                        /* 70 */
+	primitive_setenv,                       /* 70 */
-	primitive_gc,                           /* 71 */
+	primitive_open_file,                    /* 71 */
-	primitive_save_image,                   /* 72 */
+	primitive_read_line_8,                  /* 72 */
-	primitive_datastack,                    /* 73 */
+	primitive_write_8,                      /* 73 */
-	primitive_callstack,                    /* 74 */
+	primitive_close,                        /* 74 */
-	primitive_set_datastack,                /* 75 */
+	primitive_gc,                           /* 75 */
-	primitive_set_callstack,                /* 76 */
+	primitive_save_image,                   /* 76 */
-	primitive_handlep,                      /* 77 */
+	primitive_datastack,                    /* 77 */
-	primitive_exit                          /* 78 */
+	primitive_callstack,                    /* 78 */
+	primitive_set_datastack,                /* 79 */
+	primitive_set_callstack,                /* 80 */
+	primitive_handlep,                      /* 81 */
+	primitive_exit                          /* 82 */
 };
 
 CELL primitive_to_xt(CELL primitive)

native/primitives.h

@@ -1,5 +1,5 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 79
+#define PRIMITIVE_COUNT 83
 
 CELL primitive_to_xt(CELL primitive);