Merge branch 'master' of git://factorcode.org/git/factor

build-support/grovel.c

@@ -145,6 +145,8 @@ void unix_constants()
 	constant(PROT_WRITE);
 	constant(MAP_FILE);
 	constant(MAP_SHARED);
+	grovel(pid_t);
+
 }
 	
 int main() {
@@ -158,6 +160,10 @@ int main() {
 	openbsd_stat();
 	openbsd_types();
 #endif
+	grovel(blkcnt_t);
+        grovel(blksize_t);
+        //grovel(fflags_t);
+        grovel(ssize_t);
 
 #ifdef UNIX
 	unix_types();

core/cpu/x86/architecture/architecture.factor

@@ -156,7 +156,7 @@ M: x86-backend %unbox-small-struct ( size -- )
 
 M: x86-backend struct-small-enough? ( size -- ? )
     { 1 2 4 8 } member?
-    os { "linux" "solaris" } member? not and ;
+    os { "linux" "netbsd" "solaris" } member? not and ;
 
 M: x86-backend %return ( -- ) 0 %unwind ;
 

extra/peg/ebnf/ebnf-tests.factor

@@ -143,3 +143,31 @@ IN: peg.ebnf.tests
 { f } [
   "Z" [EBNF foo=[^A-Z] EBNF] call  
 ] unit-test
+
+[ 
+  #! Test direct left recursion. Currently left recursion should cause a
+  #! failure of that parser.
+  #! Not using packrat, so recursion causes data stack overflow  
+  "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call
+] must-fail
+
+{ V{ 49 } } [ 
+  #! Test direct left recursion. Currently left recursion should cause a
+  #! failure of that parser.
+  #! Using packrat, so first part of expr fails, causing 2nd choice to be used  
+  "1+1" [ [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ] with-packrat parse-result-ast
+] unit-test
+
+[ 
+  #! Test indirect left recursion. Currently left recursion should cause a
+  #! failure of that parser.
+  #! Not using packrat, so recursion causes data stack overflow  
+  "1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call
+] must-fail
+
+{ V{ 49 } } [ 
+  #! Test indirect left recursion. Currently left recursion should cause a
+  #! failure of that parser.
+  #! Using packrat, so first part of expr fails, causing 2nd choice to be used  
+  "1+1" [ [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call ] with-packrat parse-result-ast
+] unit-test

extra/peg/ebnf/ebnf.factor

@@ -266,7 +266,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
   ] [ ] make delay sp ;
 
 : transform-ebnf ( string -- object )
-  'ebnf' parse parse-result-ast transform ;
+  'ebnf' packrat-parse parse-result-ast transform ;
 
 : check-parse-result ( result -- result )
   dup [
@@ -281,7 +281,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
   ] if ;
 
 : ebnf>quot ( string -- hashtable quot )
-  'ebnf' parse check-parse-result 
+  'ebnf' packrat-parse check-parse-result 
   parse-result-ast transform dup main swap at compile 1quotation ;
 
 : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing

extra/peg/peg-docs.factor

@@ -12,7 +12,7 @@ HELP: parse
 { $description 
     "Given the input string, parse it using the given parser. The result is a <parse-result> object if "
     "the parse was successful, otherwise it is f." } 
-{ $see-also compile with-packrat } ;
+{ $see-also compile with-packrat packrat-parse } ;
 
 HELP: with-packrat
 { $values 
@@ -23,8 +23,30 @@ HELP: with-packrat
     "Calls the quotation with a packrat cache in scope. Usually the quotation will "
     "call " { $link parse } " or call a word produced by " { $link compile } "."
     "The cache is used to avoid the possible exponential time performace that pegs "
-    "can have, instead giving linear time at the cost of increased memory usage."  } 
+    "can have, instead giving linear time at the cost of increased memory usage. "
-{ $see-also compile parse } ;
+    "Use of this packrat option also allows direct and indirect recursion to "
+    "be handled in the parser without entering an infinite loop."  } 
+{ $see-also compile parse packrat-parse packrat-call } ;
+
+HELP: packrat-parse
+{ $values 
+  { "input" "a string" } 
+  { "parser" "a parser" } 
+  { "result" "a parse-result or f" } 
+}
+{ $description 
+    "Compiles and calls the parser with a packrat cache in scope."  } 
+{ $see-also compile parse packrat-call with-packrat } ;
+
+HELP: packrat-call
+{ $values 
+  { "input" "a string" } 
+  { "quot" "a quotation with stack effect ( input -- result )" } 
+  { "result" "a parse-result or f" } 
+}
+{ $description 
+    "Calls the compiled parser with a packrat cache in scope."  } 
+{ $see-also compile packrat-call packrat-parse with-packrat } ;
 
 HELP: compile
 { $values 
@@ -36,7 +58,7 @@ HELP: compile
     "The mapping from parser to compiled word is kept in a cache. If you later change "
     "the definition of a parser you'll need to clear this cache with " 
     { $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." } 
-{ $see-also compile with-packrat reset-compiled-parsers } ;
+{ $see-also compile with-packrat reset-compiled-parsers packrat-call packrat-parse } ;
 
 HELP: reset-compiled-parsers
 { $description 

extra/peg/peg-tests.factor

@@ -158,3 +158,41 @@ IN: peg.tests
   "a]" "[" token hide "a" token "]" token hide 3array seq parse 
 ] unit-test
 
+
+{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [
+  [
+    [ "1" token , "-" token , "1" token , ] seq* ,
+    [ "1" token , "+" token , "1" token , ] seq* ,
+  ] choice* 
+  "1-1" over parse parse-result-ast swap
+  "1+1" swap parse parse-result-ast
+] unit-test
+
+{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [
+  [ 
+    [
+      [ "1" token , "-" token , "1" token , ] seq* ,
+      [ "1" token , "+" token , "1" token , ] seq* ,
+    ] choice* 
+    "1-1" over parse parse-result-ast swap
+  ] with-packrat
+  [
+    "1+1" swap parse parse-result-ast
+  ] with-packrat 
+] unit-test
+
+: expr ( -- parser ) 
+  #! Test direct left recursion. Currently left recursion should cause a
+  #! failure of that parser.
+  [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
+
+[
+  #! Not using packrat, so recursion causes data stack overflow  
+  "1+1" expr parse parse-result-ast   
+] must-fail
+
+{ "1" } [
+  #! Using packrat, so expr fails, causing the 2nd choice to be used.  
+  "1+1" expr [ parse ] with-packrat parse-result-ast   
+] unit-test
+

extra/peg/peg.factor

@@ -24,13 +24,32 @@ SYMBOL: packrat
 
 GENERIC: (compile) ( parser -- quot )
 
-:: run-packrat-parser ( input quot c -- result )
+: input-from ( input -- n )
-  input slice? [ input slice-from ] [ 0 ] if
+  #! Return the index from the original string that the
-  quot c [ drop H{ } clone ] cache 
+  #! input slice is based on.
-  [
+  dup slice? [ slice-from ] [ drop 0 ] if ;
-    drop input quot call  
+
+: input-cache ( quot cache -- cache )
+  #! From the packrat cache, obtain the cache for the parser quotation 
+  #! that maps the input string position to the parser result.
+  [ drop H{ } clone ] cache ;
+
+:: cached-result ( n input-cache input quot -- result )
+  #! Get the cached result for input position n
+  #! from the input cache. If the item is not in the cache,
+  #! call 'quot' with 'input' on the stack to get the result
+  #! and store that in the cache and return it.
+  n input-cache [ 
+    drop
+    f n input-cache set-at
+    input quot call 
   ] cache ; inline
 
+:: run-packrat-parser ( input quot c -- result )
+  input input-from
+  quot c input-cache 
+  input quot cached-result ; inline
+
 : run-parser ( input quot -- result )
   #! If a packrat cache is available, use memoization for
   #! packrat parsing, otherwise do a standard peg call.
@@ -48,11 +67,17 @@ GENERIC: (compile) ( parser -- quot )
   [ compiled-parser ] with-compilation-unit ;
 
 : parse ( state parser -- result )
-  compile execute ;
+  compile execute ; inline
 
 : with-packrat ( quot -- result )
   #! Run the quotation with a packrat cache active.
-  [ H{ } clone packrat ] dip with-variable ;
+  [ H{ } clone packrat ] dip with-variable ; inline
+
+: packrat-parse ( state parser -- result )
+  [ parse ] with-packrat ;
+
+: packrat-call ( state quot -- result )
+  with-packrat ; inline
 
 <PRIVATE
 
@@ -313,7 +338,7 @@ MEMO: 3seq ( parser1 parser2 parser3 -- parser )
 MEMO: 4seq ( parser1 parser2 parser3 parser4 -- parser )
   4array seq ;
 
-MEMO: seq* ( quot -- paser )
+: seq* ( quot -- paser )
   { } make seq ; inline 
 
 MEMO: choice ( seq -- parser )
@@ -328,7 +353,7 @@ MEMO: 3choice ( parser1 parser2 parser3 -- parser )
 MEMO: 4choice ( parser1 parser2 parser3 parser4 -- parser )
   4array choice ;
 
-MEMO: choice* ( quot -- paser )
+: choice* ( quot -- paser )
   { } make choice ; inline 
 
 MEMO: repeat0 ( parser -- parser )

extra/tools/deploy/deploy-tests.factor

@@ -1,10 +1,11 @@
 IN: tools.deploy.tests
 USING: tools.test system io.files kernel tools.deploy.config
 tools.deploy.backend math sequences io.launcher arrays
-namespaces ;
+namespaces continuations ;
 
 : shake-and-bake ( vocab -- )
-    "." resource-path [
+    [ "test.image" temp-file delete-file ] ignore-errors
+    "resource:" [
         >r vm
         "test.image" temp-file
         r> dup deploy-config make-deploy-image

extra/unix/bsd/bsd.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax combinators system vocabs.loader ;
 IN: unix
-USING: alien.syntax ;
 
 ! FreeBSD
 
@@ -15,8 +15,6 @@ USING: alien.syntax ;
 : O_TRUNC   HEX: 0400 ; inline
 : O_EXCL    HEX: 0800 ; inline
 
-: FD_SETSIZE 1024 ; inline
-
 : SOL_SOCKET HEX: ffff ; inline
 : SO_REUSEADDR HEX: 4 ; inline
 : SO_OOBINLINE HEX: 100 ; inline
@@ -83,3 +81,10 @@ C-STRUCT: sockaddr-un
 : SEEK_SET 0 ; inline
 : SEEK_CUR 1 ; inline
 : SEEK_END 2 ; inline
+
+os {
+    { "macosx"  [ "unix.bsd.macosx"  require ] }
+    { "freebsd" [ "unix.bsd.freebsd" require ] }
+    { "openbsd" [ "unix.bsd.openbsd" require ] }
+    { "netbsd"  [ "unix.bsd.netbsd"  require ] }
+} case

extra/unix/bsd/freebsd/freebsd.factor

@@ -0,0 +1,3 @@
+IN: unix
+
+: FD_SETSIZE 1024 ;

extra/unix/bsd/macosx/macosx.factor

@@ -0,0 +1,3 @@
+IN: unix
+
+: FD_SETSIZE 1024 ; inline

extra/unix/bsd/netbsd/netbsd.factor

@@ -0,0 +1,3 @@
+IN: unix
+
+: FD_SETSIZE 256 ; inline

extra/unix/bsd/openbsd/openbsd.factor

@@ -0,0 +1,3 @@
+IN: unix
+
+: FD_SETSIZE 1024 ; inline

extra/unix/stat/netbsd/32/32.factor

@@ -0,0 +1,26 @@
+USING: kernel alien.syntax math ;
+IN: unix.stat
+
+! NetBSD 4.0
+
+C-STRUCT: stat
+    { "dev_t" "st_dev" }
+    { "mode_t" "st_mode" }
+    { "ino_t" "st_ino" }
+    { "nlink_t" "st_nlink" }
+    { "uid_t" "st_uid" }
+    { "gid_t" "st_gid" }
+    { "dev_t" "st_rdev" }
+    { "timespec" "st_atim" }
+    { "timespec" "st_mtim" }
+    { "timespec" "st_ctim" }
+    { "timespec" "st_birthtim" }
+    { "off_t" "st_size" }
+    { "blkcnt_t" "st_blocks" }
+    { "blksize_t" "st_blksize" }
+    { "uint32_t" "st_flags" }
+    { "uint32_t" "st_gen" }
+    { { "uint32_t" 2 } "st_qspare" } ;
+
+FUNCTION: int stat  ( char* pathname, stat* buf ) ;
+FUNCTION: int lstat ( char* pathname, stat* buf ) ;

extra/unix/stat/netbsd/64/64.factor

@@ -0,0 +1,27 @@
+USING: kernel alien.syntax math ;
+IN: unix.stat
+
+! NetBSD 4.0
+
+C-STRUCT: stat
+    { "dev_t" "st_dev" }
+    { "ino_t" "st_ino" }
+    { "mode_t" "st_mode" }
+    { "nlink_t" "st_nlink" }
+    { "uid_t" "st_uid" }
+    { "gid_t" "st_gid" }
+    { "dev_t" "st_rdev" }
+    { "timespec" "st_atim" }
+    { "timespec" "st_mtim" }
+    { "timespec" "st_ctim" }
+    { "off_t" "st_size" }
+    { "blkcnt_t" "st_blocks" }
+    { "blksize_t" "st_blksize" }
+    { "uint32_t" "st_flags" }
+    { "uint32_t" "st_gen" }
+    { "uint32_t" "st_spare0" }
+    { "timespec" "st_birthtim" }
+    { "int" "__pad5" } ;
+
+FUNCTION: int stat  ( char* pathname, stat* buf ) ;
+FUNCTION: int lstat ( char* pathname, stat* buf ) ;

extra/unix/stat/netbsd/netbsd.factor

@@ -1,26 +1,7 @@
-USING: kernel alien.syntax math ;
+USING: layouts combinators vocabs.loader ;
 IN: unix.stat
 
-! NetBSD 4.0
+cell-bits {
-
+    { 32 [ "unix.stat.netbsd.32" require ] }
-C-STRUCT: stat
+    { 64 [ "unix.stat.netbsd.64" require ] }
-    { "dev_t" "st_dev" }
+} case
-    { "mode_t" "st_mode" }
-    { "ino_t" "st_ino" }
-    { "nlink_t" "st_nlink" }
-    { "uid_t" "st_uid" }
-    { "gid_t" "st_gid" }
-    { "dev_t" "st_rdev" }
-    { "timespec" "st_atim" }
-    { "timespec" "st_mtim" }
-    { "timespec" "st_ctim" }
-    { "timespec" "st_birthtim" }
-    { "off_t" "st_size" }
-    { "blkcnt_t" "st_blocks" }
-    { "blksize_t" "st_blksize" }
-    { "uint32_t" "st_flags" }
-    { "uint32_t" "st_gen" }
-    { { "uint32_t" 2 } "st_qspare" } ;
-
-FUNCTION: int stat  ( char* pathname, stat* buf ) ;
-FUNCTION: int lstat ( char* pathname, stat* buf ) ;

extra/unix/types/netbsd/netbsd.factor

@@ -18,7 +18,7 @@ TYPEDEF: ulonglong      u_int64_t
 
 TYPEDEF: __uint32_t     __dev_t
 TYPEDEF: __uint32_t     dev_t
-TYPEDEF: __uint64_t     ino_t
+TYPEDEF: __uint32_t     ino_t
 TYPEDEF: __uint32_t     mode_t
 TYPEDEF: __uint32_t     nlink_t
 TYPEDEF: __uint32_t     uid_t
@@ -26,7 +26,6 @@ TYPEDEF: __uint32_t     gid_t
 TYPEDEF: __int64_t      off_t
 TYPEDEF: __int64_t      blkcnt_t
 TYPEDEF: __uint32_t     blksize_t
-TYPEDEF: __uint32_t     fflags_t
+TYPEDEF: longlong       ssize_t
-TYPEDEF: int            ssize_t
 TYPEDEF: int            pid_t
 TYPEDEF: int            time_t

extra/unix/unix.factor

@@ -160,6 +160,5 @@ FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
     { [ linux? ] [ "unix.linux" require ] }
     { [ bsd? ] [ "unix.bsd" require ] }
     { [ solaris? ] [ "unix.solaris" require ] }
-    { [ t ] [ ] }
 } cond