Split off error. methods into sub-vocabs in a few places

db4
Slava Pestov 2008-12-08 20:04:13 -06:00
parent a0e7663afb
commit 5bfa17d962
8 changed files with 61 additions and 40 deletions

View File

@ -3,14 +3,14 @@
USING: accessors assocs kernel math math.parser namespaces make USING: accessors assocs kernel math math.parser namespaces make
sequences io io.sockets io.streams.string io.files io.timeouts sequences io io.sockets io.streams.string io.files io.timeouts
strings splitting calendar continuations accessors vectors strings splitting calendar continuations accessors vectors
math.order hashtables byte-arrays prettyprint destructors math.order hashtables byte-arrays destructors
io.encodings io.encodings
io.encodings.string io.encodings.string
io.encodings.ascii io.encodings.ascii
io.encodings.8-bit io.encodings.8-bit
io.encodings.binary io.encodings.binary
io.streams.duplex io.streams.duplex
fry debugger summary ascii urls urls.encoding present fry ascii urls urls.encoding present
http http.parsers ; http http.parsers ;
IN: http.client IN: http.client
@ -84,10 +84,6 @@ M: f >post-data ;
ERROR: too-many-redirects ; ERROR: too-many-redirects ;
M: too-many-redirects summary
drop
[ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ;
<PRIVATE <PRIVATE
DEFER: (with-http-request) DEFER: (with-http-request)
@ -161,10 +157,6 @@ PRIVATE>
ERROR: download-failed response ; ERROR: download-failed response ;
M: download-failed error.
"HTTP request failed:" print nl
response>> . ;
: check-response ( response -- response ) : check-response ( response -- response )
dup code>> success? [ download-failed ] unless ; dup code>> success? [ download-failed ] unless ;
@ -203,3 +195,7 @@ M: download-failed error.
: http-post ( post-data url -- response data ) : http-post ( post-data url -- response data )
<post-request> http-request ; <post-request> http-request ;
USING: vocabs vocabs.loader ;
"debugger" vocab [ "http.client.debugger" require ] when

View File

@ -0,0 +1,13 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel summary debugger io make math.parser
prettyprint http.client accessors ;
IN: http.client.debugger
M: too-many-redirects summary
drop
[ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ;
M: download-failed error.
"HTTP request failed:" print nl
response>> . ;

View File

@ -1,9 +1,9 @@
! Copyright (C) 2003, 2008 Slava Pestov. ! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel combinators math namespaces make USING: accessors kernel combinators math namespaces make assocs
assocs sequences splitting sorting sets debugger sequences splitting sorting sets strings vectors hashtables
strings vectors hashtables quotations arrays byte-arrays quotations arrays byte-arrays math.parser calendar
math.parser calendar calendar.format present urls calendar.format present urls
io io.encodings io.encodings.iana io.encodings.binary io io.encodings io.encodings.iana io.encodings.binary
io.encodings.8-bit io.encodings.8-bit

View File

@ -0,0 +1,12 @@
USING: io kernel accessors math.parser sequences prettyprint
debugger peg ;
IN: peg.debugger
M: parse-error error.
"Peg parsing error at character position " write dup position>> number>string write
"." print "Expected " write messages>> [ " or " write ] [ write ] interleave nl ;
M: parse-failed error.
"The " write dup word>> pprint " word could not parse the following input:" print nl
input>> . ;

View File

@ -5,7 +5,7 @@ sequences quotations vectors namespaces make math assocs
continuations peg peg.parsers unicode.categories multiline continuations peg peg.parsers unicode.categories multiline
splitting accessors effects sequences.deep peg.search splitting accessors effects sequences.deep peg.search
combinators.short-circuit lexer io.streams.string stack-checker combinators.short-circuit lexer io.streams.string stack-checker
io prettyprint combinators parser ; io combinators parser ;
IN: peg.ebnf IN: peg.ebnf
: rule ( name word -- parser ) : rule ( name word -- parser )
@ -458,16 +458,13 @@ M: ebnf-var build-locals ( code ast -- )
M: object build-locals ( code ast -- ) M: object build-locals ( code ast -- )
drop ; drop ;
ERROR: bad-effect quot effect ;
: check-action-effect ( quot -- quot ) : check-action-effect ( quot -- quot )
dup infer { dup infer {
{ [ dup (( a -- b )) effect<= ] [ drop ] } { [ dup (( a -- b )) effect<= ] [ drop ] }
{ [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] } { [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] }
[ [ bad-effect ]
[
"Bad effect: " write effect>string write
" for quotation " write pprint
] with-string-writer throw
]
} cond ; } cond ;
M: ebnf-action (transform) ( ast -- parser ) M: ebnf-action (transform) ( ast -- parser )

View File

@ -1,14 +1,12 @@
! Copyright (C) 2007, 2008 Chris Double. ! Copyright (C) 2007, 2008 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings fry namespaces make math assocs USING: kernel sequences strings fry namespaces make math assocs
debugger io vectors arrays math.parser math.order io vectors arrays math.parser math.order vectors combinators
vectors combinators classes sets unicode.categories classes sets unicode.categories compiler.units parser words
compiler.units parser words quotations effects memoize accessors quotations effects memoize accessors locals effects splitting
locals effects splitting combinators.short-circuit generalizations ; combinators.short-circuit generalizations ;
IN: peg IN: peg
USE: prettyprint
TUPLE: parse-result remaining ast ; TUPLE: parse-result remaining ast ;
TUPLE: parse-error position messages ; TUPLE: parse-error position messages ;
TUPLE: parser peg compiled id ; TUPLE: parser peg compiled id ;
@ -19,10 +17,6 @@ M: parser hashcode* id>> hashcode* ;
C: <parse-result> parse-result C: <parse-result> parse-result
C: <parse-error> parse-error C: <parse-error> parse-error
M: parse-error error.
"Peg parsing error at character position " write dup position>> number>string write
"." print "Expected " write messages>> [ " or " write ] [ write ] interleave nl ;
SYMBOL: error-stack SYMBOL: error-stack
: (merge-errors) ( a b -- c ) : (merge-errors) ( a b -- c )
@ -238,8 +232,6 @@ TUPLE: peg-head rule-id involved-set eval-set ;
nip nip
] if ; ] if ;
USE: prettyprint
: apply-rule ( r p -- ast ) : apply-rule ( r p -- ast )
! 2dup [ rule-id ] dip 2array "apply-rule: " write . ! 2dup [ rule-id ] dip 2array "apply-rule: " write .
2dup recall [ 2dup recall [
@ -624,10 +616,6 @@ PRIVATE>
ERROR: parse-failed input word ; ERROR: parse-failed input word ;
M: parse-failed error.
"The " write dup word>> pprint " word could not parse the following input:" print nl
input>> . ;
: PEG: : PEG:
(:) (:)
[let | def [ ] word [ ] | [let | def [ ] word [ ] |
@ -643,3 +631,9 @@ M: parse-failed error.
] with-compilation-unit ] with-compilation-unit
] over push-all ] over push-all
] ; parsing ] ; parsing
USING: vocabs vocabs.loader ;
"debugger" vocab [
"peg.debugger" require
] when

View File

@ -0,0 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel present prettyprint.custom prettyprint.backend urls ;
IN: urls.prettyprint
M: url pprint* dup present "URL\" " "\"" pprint-string ;

View File

@ -4,8 +4,7 @@ USING: kernel ascii combinators combinators.short-circuit
sequences splitting fry namespaces make assocs arrays strings sequences splitting fry namespaces make assocs arrays strings
io.sockets io.encodings.string io.encodings.utf8 math io.sockets io.encodings.string io.encodings.utf8 math
math.parser accessors parser strings.parser lexer math.parser accessors parser strings.parser lexer
prettyprint.backend prettyprint.custom hashtables present hashtables present peg.ebnf urls.encoding ;
peg.ebnf urls.encoding ;
IN: urls IN: urls
TUPLE: url protocol username password host port path query anchor ; TUPLE: url protocol username password host port path query anchor ;
@ -182,4 +181,8 @@ PRIVATE>
! Literal syntax ! Literal syntax
: URL" lexer get skip-blank parse-string >url parsed ; parsing : URL" lexer get skip-blank parse-string >url parsed ; parsing
M: url pprint* dup present "URL\" " "\"" pprint-string ; USING: vocabs vocabs.loader ;
"prettyprint" vocab [
"urls.prettyprint" require
] when