diff --git a/extra/ip-parser/ip-parser-tests.factor b/extra/ip-parser/ip-parser-tests.factor index fa7e83414e..a1a0841401 100644 --- a/extra/ip-parser/ip-parser-tests.factor +++ b/extra/ip-parser/ip-parser-tests.factor @@ -22,5 +22,5 @@ IN: ip-parser } [ parse-ipv4 "74.125.226.4" = ] all? ] unit-test -{ "174.36.207.186" } [ 2921648058 ipv4-ntoa ] unit-test -{ 2921648058 } [ "174.36.207.186" ipv4-aton ] unit-test +{ "74.125.226.4" } [ 1249763844 ipv4-ntoa ] unit-test +{ 1249763844 } [ "74.125.226.4" ipv4-aton ] unit-test diff --git a/extra/ip-parser/ip-parser.factor b/extra/ip-parser/ip-parser.factor index dd9e1be82a..4408460044 100644 --- a/extra/ip-parser/ip-parser.factor +++ b/extra/ip-parser/ip-parser.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2012 John Benediktsson ! See http://factorcode.org/license.txt for BSD license - -USING: combinators combinators.short-circuit formatting kernel -literals locals math math.bitwise math.parser sequences -splitting ; +USING: arrays combinators combinators.short-circuit +generalizations kernel literals locals math math.bitwise +math.parser sequences sequences.private splitting ; IN: ip-parser @@ -16,22 +15,28 @@ ERROR: invalid-ipv4 str ; [ rest "0o" prepend ] when ; : split-components ( str -- array ) - "." split [ cleanup-octal string>number ] map ; + "." split [ cleanup-octal string>number ] map! ; -: bubble ( array -- array' ) - reverse 0 swap [ + 256 /mod ] map reverse nip ; +: byte>string ( byte -- str ) + $[ 256 iota [ number>string ] map ] nth-unsafe ; inline -: join-components ( array -- str ) - [ number>string ] map "." join ; +: bubble1 ( m n -- x y ) + [ -8 shift + ] [ 8 bits ] bi ; inline -: (parse-ipv4) ( str -- array ) +: bubble ( a b c d -- w x y z ) + bubble1 [ bubble1 ] dip [ bubble1 ] 2dip [ 8 bits ] 3dip ; inline + +: join-components ( a b c d -- str ) + [ byte>string ] 4 napply 4array "." join ; inline + +: (parse-ipv4) ( str -- a b c d ) dup split-components dup length { - { 1 [ { 0 0 0 } prepend ] } - { 2 [ first2 [| A D | { A 0 0 D } ] call ] } - { 3 [ first3 [| A B D | { A B 0 D } ] call ] } - { 4 [ ] } + { 1 [ nip first-unsafe [ 0 0 0 ] dip ] } + { 2 [ nip first2-unsafe [ 0 0 ] dip ] } + { 3 [ nip first3-unsafe [ 0 ] dip ] } + { 4 [ nip first4-unsafe ] } [ drop invalid-ipv4 ] - } case bubble nip ; + } case bubble ; inline PRIVATE> @@ -39,8 +44,8 @@ PRIVATE> (parse-ipv4) join-components ; : ipv4-ntoa ( integer -- ip ) - $[ { -24 -16 -8 0 } [ [ shift 8 bits ] curry ] map ] - cleave "%s.%s.%s.%s" sprintf ; + $[ { -24 -16 -8 0 } [ [ 8 shift-mod ] curry ] map ] cleave + join-components ; : ipv4-aton ( ip -- integer ) - (parse-ipv4) B{ 24 16 8 0 } [ shift ] [ + ] 2map-reduce ; + (parse-ipv4) [ 24 16 8 [ shift ] tri-curry@ tri* ] dip + + + ;