steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ip-parser: prefer a cleaner maybe less fast version.

db4
John Benediktsson 2014-02-09 20:09:39 -08:00
parent c69005a324
commit c9badc9dd9
1 changed files with 16 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
extra/ip-parser/ip-parser.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2012 John Benediktsson
! Copyright (C) 2012-2014 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: arrays combinators combinators.short-circuit
generalizations kernel literals locals math math.bitwise
math.parser sequences sequences.private splitting ;
USING: combinators combinators.short-circuit kernel math
math.bitwise math.parser math.vectors sequences splitting ;
IN: ip-parser
@ -15,28 +14,22 @@ ERROR: invalid-ipv4 str ;
[ rest "0o" prepend ] when ;
: split-components ( str -- array )
"." split [ cleanup-octal string>number ] map! ;
"." split [ cleanup-octal string>number ] map ;
: byte>string ( byte -- str )
$[ 256 iota [ number>string ] map ] nth-unsafe ; inline
: bubble ( array -- newarray )
reverse 0 swap [ + 256 /mod ] map reverse nip ;
: bubble1 ( m n -- x y )
[ -8 shift + ] [ 8 bits ] bi ; inline
: join-components ( array -- str )
[ number>string ] map "." join ;
: 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 )
: (parse-ipv4) ( str -- array )
dup split-components dup length {
{ 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 ] }
{ 1 [ { 0 0 0 } prepend ] }
{ 2 [ 1 cut { 0 0 } glue ] }
{ 3 [ 2 cut { 0 } glue ] }
{ 4 [ ] }
[ drop invalid-ipv4 ]
} case bubble ; inline
} case bubble nip ; inline
PRIVATE>
@ -44,8 +37,7 @@ PRIVATE>
(parse-ipv4) join-components ;
: ipv4-ntoa ( integer -- ip )
$[ { -24 -16 -8 0 } [ [ 8 shift-mod ] curry ] map ] cleave
join-components ;
{ -24 -16 -8 0 } [ 8 shift-mod ] with map join-components ;
: ipv4-aton ( ip -- integer )
(parse-ipv4) [ 24 16 8 [ shift ] tri-curry@ tri* ] dip + + + ;
(parse-ipv4) { 24 16 8 0 } [ shift ] [ + ] 2map-reduce ;