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

extra/fry/fry-docs.factor

@@ -87,7 +87,7 @@ $nl
 } ;
 
 ARTICLE: "fry.limitations" "Fried quotation limitations"
-"As with " { $link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". Unlike " { $link "locals" } ", using " { $link dip } " is not a suitable workaround since unlike closure conversion, fry conversion is not recursive, and so the quotation passed to " { $link dip } " cannot contain fry specifiers." ;
+"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } "." ;
 
 ARTICLE: "fry" "Fried quotations"
 "A " { $emphasis "fried quotation" } " differs from a literal quotation in that when it is evaluated, instead of just pushing itself on the stack, it consumes zero or more stack values and inserts them into the quotation."

extra/fry/fry-tests.factor

@@ -48,3 +48,7 @@ sequences ;
 [ { 1 2 3 } ] [
     3 1 '[ , [ , + ] map ] call
 ] unit-test
+
+[ { 1 { 2 { 3 } } } ] [
+    1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
+] unit-test

extra/fry/fry.factor

@@ -54,7 +54,7 @@ DEFER: (shallow-fry)
                     [ { , namespaces:, @ } member? ] filter length
                     \ , <repetition> %
                 ]
-                [ deep-fry % ] bi
+                [ fry % ] bi
             ] [ namespaces:, ] if
         ] each
     ] [ ] make deep-fry ;

extra/morse/morse-tests.factor

@@ -9,5 +9,5 @@ USING: arrays morse strings tools.test ;
 [ "-- --- .-. ... . / -.-. --- -.. ." ] [ "morse code" >morse ] unit-test
 [ "morse code" ] [ "-- --- .-. ... . / -.-. --- -.. ." morse> ] unit-test
 [ "hello, world!" ] [ "Hello, World!" >morse morse> ] unit-test
-[ ] [ "sos" 0.075 play-as-morse ] unit-test
+[ ] [ "sos" 0.075 play-as-morse* ] unit-test
 [ ] [ "Factor rocks!" play-as-morse ] unit-test

extra/unicode/script/authors.txt

@@ -0,0 +1 @@
+Daniel Ehrenberg

extra/unicode/script/script-docs.factor

@@ -0,0 +1,8 @@
+USING: help.syntax help.markup ;
+IN: unicode.script
+
+HELP: script-of
+{ $values { "char" "a code point" } { "script" "a symbol" } }
+{ $description "Gets a symbol representing the code point of a given character. The word name of the symbol is the same as the one " } ;
+
+ABOUT: script-of

extra/unicode/script/script-tests.factor

@@ -0,0 +1,4 @@
+USING: unicode.script tools.test ;
+
+[ Latin ] [ CHAR: a script-of ] unit-test
+[ Common ] [ 0 script-of ] unit-test

extra/unicode/script/script.factor

@@ -0,0 +1,56 @@
+USING: unicode.syntax.backend kernel sequences assocs io.files
+io.encodings ascii math.ranges io splitting math.parser 
+namespaces byte-arrays locals math sets io.encodings.ascii
+words compiler.units ;
+IN: unicode.script
+
+<PRIVATE
+VALUE: char>num-table
+VALUE: num>name-table
+
+: parse-script ( stream -- assoc )
+    ! assoc is code point/range => name
+    lines [ "#" split1 drop ] map [ empty? not ] filter [
+        ";" split1 [ [ blank? ] trim ] bi@
+    ] H{ } map>assoc ;
+
+: set-if ( value var -- )
+    dup 500000 < [ set ] [ 2drop ] if ;
+
+: expand-ranges ( assoc -- char-assoc )
+    ! char-assoc is code point => name
+    [ [
+        CHAR: . pick member? [
+            swap ".." split1 [ hex> ] bi@ [a,b]
+            [ set-if ] with each
+        ] [ swap hex> set-if ] if
+    ] assoc-each ] H{ } make-assoc ;
+
+: hash>byte-array ( hash -- byte-array )
+    [ keys supremum 1+ <byte-array> dup ] keep
+    [ -rot set-nth ] with assoc-each ;
+
+: make-char>num ( assoc -- char>num-table )
+    expand-ranges
+    [ num>name-table index ] assoc-map
+    hash>byte-array ;
+
+: >symbols ( strings -- symbols )
+    [
+        [ "unicode.script" create dup define-symbol ] map
+    ] with-compilation-unit ;
+
+: process-script ( ranges -- )
+    [ values prune \ num>name-table set-value ]
+    [ make-char>num \ char>num-table set-value ] bi
+    num>name-table >symbols \ num>name-table set-value ;
+
+: load-script ( -- )
+    "resource:extra/unicode/script/Scripts.txt"
+    ascii <file-reader> parse-script process-script ;
+
+load-script
+PRIVATE>
+
+: script-of ( char -- script )
+    char>num-table nth num>name-table nth ;

extra/unicode/script/summary.txt

@@ -0,0 +1 @@
+Reads the UCD to get the script of a code point

extra/update/backup/backup.factor

@@ -0,0 +1,25 @@
+
+USING: namespaces io.files bootstrap.image builder.util ;
+
+IN: update.backup
+
+: backup-boot-image ( -- )
+  my-boot-image-name
+  { "boot." my-arch "-" [ "datestamp" get ] ".image" } to-string  
+  move-file ;
+
+: backup-image ( -- )
+  "factor.image"
+  { "factor" "-" [ "datestamp" get ] ".image" } to-string
+  move-file ;
+
+: backup-vm ( -- )
+  "factor"
+  { "factor" "-" [ "datestamp" get ] } to-string
+  move-file ;
+
+: backup ( -- )
+  datestamp "datestamp" set
+  backup-boot-image
+  backup-image
+  backup-vm ;

extra/update/latest/latest.factor

@@ -0,0 +1,53 @@
+
+USING: kernel namespaces system io.files bootstrap.image http.client
+       builder.util update update.backup ;
+
+IN: update.latest
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: git-pull-master ( -- )
+  image parent-directory
+    [
+      { "git" "pull" "git://factorcode.org/git/factor.git" "master" }
+      run-command
+    ]
+  with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: remote-latest-image ( -- url )
+  { "http://factorcode.org/images/latest/" my-boot-image-name } to-string ;
+
+: download-latest-image ( -- ) remote-latest-image download ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: rebuild-latest ( -- )
+  image parent-directory
+    [
+      backup
+      download-latest-image
+      make-clean
+      make
+      boot
+    ]
+  with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: update-latest ( -- )
+  image parent-directory
+    [
+      git-id
+      git-pull-master
+      git-id
+      = not
+        [ rebuild-latest ]
+      when
+    ]
+  with-directory ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: update-latest