From 82b6e32945f39e87a77a67234764676ce7c8100e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 29 Mar 2009 21:35:57 -0500 Subject: [PATCH 1/5] fix a few compile errors --- basis/sorting/human/human.factor | 2 +- extra/bank/bank.factor | 2 +- extra/irc/client/client.factor | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor index 1c7392901b..c07ed8758b 100644 --- a/basis/sorting/human/human.factor +++ b/basis/sorting/human/human.factor @@ -11,7 +11,7 @@ IN: sorting.human : human>=< ( obj1 obj2 -- >=< ) human<=> invert-comparison ; inline -: human-compare ( obj1 obj2 quot -- <=> ) bi@ human<=> ; +: human-compare ( obj1 obj2 quot -- <=> ) bi@ human<=> ; inline : human-sort ( seq -- seq' ) [ human<=> ] sort ; diff --git a/extra/bank/bank.factor b/extra/bank/bank.factor index 0f8b5581df..2584335672 100644 --- a/extra/bank/bank.factor +++ b/extra/bank/bank.factor @@ -59,7 +59,7 @@ C: transaction [ dup [ over [ swap call ] dip ] dip 1 days time+ ] dip each-day ] [ 3drop - ] if ; + ] if ; inline : process-to-date ( account date -- account ) over interest-last-paid>> 1 days time+ diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index c82f2e292c..97fa659209 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -165,7 +165,7 @@ M: irc-chat to-chat in-messages>> mailbox-put ; " hostname servername :irc.factor" irc-print ; : /CONNECT ( server port -- stream ) - irc> connect>> call drop ; + irc> connect>> call drop ; inline : /JOIN ( channel password -- ) "JOIN " irc-write From 95cda29b4435fbe1f74b651417ae0f9554b3e85c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 29 Mar 2009 21:39:21 -0500 Subject: [PATCH 2/5] fix compile error --- extra/bank/bank.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/bank/bank.factor b/extra/bank/bank.factor index 2584335672..f06bc2fb81 100644 --- a/extra/bank/bank.factor +++ b/extra/bank/bank.factor @@ -59,11 +59,11 @@ C: transaction [ dup [ over [ swap call ] dip ] dip 1 days time+ ] dip each-day ] [ 3drop - ] if ; inline + ] if ; inline recursive : process-to-date ( account date -- account ) over interest-last-paid>> 1 days time+ - [ dupd process-day ] spin each-day ; + [ dupd process-day ] spin each-day ; inline : inserting-transactions ( account transactions -- account ) [ [ date>> process-to-date ] keep >>transaction ] each ; From c1297ec177589928d9de688d4130be9e721da0d8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 30 Mar 2009 00:18:02 -0500 Subject: [PATCH 3/5] add unit tests for quoting --- basis/quoting/quoting-tests.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 basis/quoting/quoting-tests.factor diff --git a/basis/quoting/quoting-tests.factor b/basis/quoting/quoting-tests.factor new file mode 100644 index 0000000000..f024d9c4a7 --- /dev/null +++ b/basis/quoting/quoting-tests.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test quoting ; +IN: quoting.tests + +[ f ] [ "" quoted? ] unit-test +[ t ] [ "''" quoted? ] unit-test +[ t ] [ "\"\"" quoted? ] unit-test +[ t ] [ "\"Circus Maximus\"" quoted? ] unit-test +[ t ] [ "'Circus Maximus'" quoted? ] unit-test +[ f ] [ "Circus Maximus" quoted? ] unit-test From 42d164db7709f8f0fa125fb17b95df1cd6e37425 Mon Sep 17 00:00:00 2001 From: sheeple Date: Mon, 30 Mar 2009 07:19:14 -0500 Subject: [PATCH 4/5] Fix C99 complex number support in FFI on Mac OS X/PPC --- basis/cpu/ppc/ppc.factor | 39 ++++++++++++++++++++++++++++++++++----- vm/alien.c | 13 ++++++++++++- vm/alien.h | 1 + 3 files changed, 47 insertions(+), 6 deletions(-) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 8b6b4fbb11..85bf188bb8 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -659,13 +659,40 @@ M: ppc %callback-value ( ctype -- ) M: ppc small-enough? ( n -- ? ) -32768 32767 between? ; -M: ppc return-struct-in-registers? ( c-type -- ? ) drop f ; +M: ppc return-struct-in-registers? ( c-type -- ? ) + c-type return-in-registers?>> ; -M: ppc %box-small-struct - drop "No small structs" throw ; +M: ppc %box-small-struct ( c-type -- ) + #! Box a <= 16-byte struct returned in r3:r4:r5:r6 + heap-size 7 LI + "box_medium_struct" f %alien-invoke ; -M: ppc %unbox-small-struct - drop "No small structs" throw ; +: %unbox-struct-1 ( -- ) + ! Alien must be in r3. + "alien_offset" f %alien-invoke + 3 3 0 LWZ ; + +: %unbox-struct-2 ( -- ) + ! Alien must be in r3. + "alien_offset" f %alien-invoke + 4 3 4 LWZ + 3 3 0 LWZ ; + +: %unbox-struct-4 ( -- ) + ! Alien must be in r3. + "alien_offset" f %alien-invoke + 6 3 12 LWZ + 5 3 8 LWZ + 4 3 4 LWZ + 3 3 0 LWZ ; + +M: ppc %unbox-small-struct ( size -- ) + #! Alien must be in EAX. + heap-size cell align cell /i { + { 1 [ %unbox-struct-1 ] } + { 2 [ %unbox-struct-2 ] } + { 4 [ %unbox-struct-4 ] } + } case ; USE: vocabs.loader @@ -673,3 +700,5 @@ USE: vocabs.loader { [ os macosx? ] [ "cpu.ppc.macosx" require ] } { [ os linux? ] [ "cpu.ppc.linux" require ] } } cond + +"complex-double" c-type t >>return-in-registers? drop diff --git a/vm/alien.c b/vm/alien.c index 8b7df45e9a..2681579c5d 100755 --- a/vm/alien.c +++ b/vm/alien.c @@ -160,7 +160,7 @@ void box_value_struct(void *src, CELL size) dpush(tag_object(array)); } -/* On OS X, structs <= 8 bytes are returned in registers. */ +/* On some x86 OSes, structs <= 8 bytes are returned in registers. */ void box_small_struct(CELL x, CELL y, CELL size) { CELL data[2]; @@ -169,6 +169,17 @@ void box_small_struct(CELL x, CELL y, CELL size) box_value_struct(data,size); } +/* On OS X/PPC, complex numbers are returned in registers. */ +void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size) +{ + CELL data[4]; + data[0] = x1; + data[1] = x2; + data[2] = x3; + data[3] = x4; + box_value_struct(data,size); +} + /* open a native library and push a handle */ void primitive_dlopen(void) { diff --git a/vm/alien.h b/vm/alien.h index ec1eb08acf..dc76d49810 100755 --- a/vm/alien.h +++ b/vm/alien.h @@ -40,6 +40,7 @@ void primitive_set_alien_cell(void); DLLEXPORT void to_value_struct(CELL src, void *dest, CELL size); DLLEXPORT void box_value_struct(void *src, CELL size); DLLEXPORT void box_small_struct(CELL x, CELL y, CELL size); +void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size); DEFINE_UNTAG(F_DLL,DLL_TYPE,dll) From 6b6de2b8aa36823ed00460cacbaced60fa5dfbd5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 30 Mar 2009 19:42:04 -0500 Subject: [PATCH 5/5] refactor some error handling in peg, more unit tests --- basis/peg/ebnf/ebnf-tests.factor | 12 +++++- basis/peg/ebnf/ebnf.factor | 72 ++++++++++++++++++++------------ 2 files changed, 57 insertions(+), 27 deletions(-) diff --git a/basis/peg/ebnf/ebnf-tests.factor b/basis/peg/ebnf/ebnf-tests.factor index a6d3cf0b21..cc83a55c7e 100644 --- a/basis/peg/ebnf/ebnf-tests.factor +++ b/basis/peg/ebnf/ebnf-tests.factor @@ -3,7 +3,7 @@ ! USING: kernel tools.test peg peg.ebnf words math math.parser sequences accessors peg.parsers parser namespaces arrays - strings eval ; + strings eval unicode.data multiline ; IN: peg.ebnf.tests { T{ ebnf-non-terminal f "abc" } } [ @@ -520,3 +520,13 @@ Tok = Spaces (Number | Special ) { "\\" } [ "\\" [EBNF foo="\\" EBNF] ] unit-test + +[ "USE: peg.ebnf [EBNF EBNF]" eval ] must-fail + +[ <" USE: peg.ebnf [EBNF + lol = a + lol = b + EBNF] "> eval +] [ + error>> [ redefined-rule? ] [ name>> "lol" = ] bi and +] must-fail-with diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index 9f730831e7..b50ba685b8 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -5,13 +5,18 @@ sequences quotations vectors namespaces make math assocs continuations peg peg.parsers unicode.categories multiline splitting accessors effects sequences.deep peg.search combinators.short-circuit lexer io.streams.string stack-checker -io combinators parser ; +io combinators parser summary ; IN: peg.ebnf : rule ( name word -- parser ) #! Given an EBNF word produced from EBNF: return the EBNF rule "ebnf-parser" word-prop at ; +ERROR: no-rule rule parser ; + +: lookup-rule ( rule parser -- rule' ) + 2dup rule [ 2nip ] [ no-rule ] if* ; + TUPLE: tokenizer any one many ; : default-tokenizer ( -- tokenizer ) @@ -34,8 +39,13 @@ TUPLE: tokenizer any one many ; : reset-tokenizer ( -- ) default-tokenizer \ tokenizer set-global ; +ERROR: no-tokenizer name ; + +M: no-tokenizer summary + drop "Tokenizer not found" ; + SYNTAX: TOKENIZER: - scan search [ "Tokenizer not found" throw ] unless* + scan dup search [ nip ] [ no-tokenizer ] if* execute( -- tokenizer ) \ tokenizer set-global ; TUPLE: ebnf-non-terminal symbol ; @@ -258,7 +268,7 @@ DEFER: 'choice' "]]" token ensure-not , "]?" token ensure-not , [ drop t ] satisfy , - ] seq* [ first ] action repeat0 [ >string ] action ; + ] seq* repeat0 [ concat >string ] action ; : 'ensure-not' ( -- parser ) #! Parses the '!' syntax to ensure that @@ -367,15 +377,16 @@ M: ebnf-tokenizer (transform) ( ast -- parser ) (transform) dup parser-tokenizer \ tokenizer set-global ] if ; + +ERROR: redefined-rule name ; + +M: redefined-rule summary + name>> "Rule '" "' defined more than once" surround ; M: ebnf-rule (transform) ( ast -- parser ) dup elements>> (transform) [ - swap symbol>> dup get parser? [ - "Rule '" over append "' defined more than once" append throw - ] [ - set - ] if + swap symbol>> dup get parser? [ redefined-rule ] [ set ] if ] keep ; M: ebnf-sequence (transform) ( ast -- parser ) @@ -466,14 +477,18 @@ ERROR: bad-effect quot effect ; { [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] } [ bad-effect ] } cond ; + +: ebnf-transform ( ast -- parser quot ) + [ parser>> (transform) ] + [ code>> insert-escapes ] + [ parser>> ] tri build-locals + [ string-lines parse-lines ] call( string -- quot ) ; M: ebnf-action (transform) ( ast -- parser ) - [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals - [ string-lines parse-lines ] call( string -- quot ) check-action-effect action ; + ebnf-transform check-action-effect action ; M: ebnf-semantic (transform) ( ast -- parser ) - [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals - [ string-lines parse-lines ] call( string -- quot ) semantic ; + ebnf-transform semantic ; M: ebnf-var (transform) ( ast -- parser ) parser>> (transform) ; @@ -481,19 +496,20 @@ M: ebnf-var (transform) ( ast -- parser ) M: ebnf-terminal (transform) ( ast -- parser ) symbol>> tokenizer one>> call( symbol -- parser ) ; +ERROR: ebnf-foreign-not-found name ; + +M: ebnf-foreign-not-found summary + name>> "Foreign word '" "' not found" surround ; + M: ebnf-foreign (transform) ( ast -- parser ) - dup word>> search - [ "Foreign word '" swap word>> append "' not found" append throw ] unless* + dup word>> search [ word>> ebnf-foreign-not-found ] unless* swap rule>> [ main ] unless* over rule [ nip ] [ execute( -- parser ) ] if* ; -: parser-not-found ( name -- * ) - [ - "Parser '" % % "' not found." % - ] "" make throw ; +ERROR: parser-not-found name ; M: ebnf-non-terminal (transform) ( ast -- parser ) symbol>> [ @@ -504,16 +520,16 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) 'ebnf' parse transform ; : check-parse-result ( result -- result ) - dup [ - dup remaining>> [ blank? ] trim empty? [ + [ + dup remaining>> [ blank? ] trim [ [ "Unable to fully parse EBNF. Left to parse was: " % remaining>> % ] "" make throw - ] unless + ] unless-empty ] [ "Could not parse EBNF" throw - ] if ; + ] if* ; : parse-ebnf ( string -- hashtable ) 'ebnf' (parse) check-parse-result ast>> transform ; @@ -522,14 +538,18 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) parse-ebnf dup dup parser [ main swap at compile ] with-variable [ compiled-parse ] curry [ with-scope ast>> ] curry ; -SYNTAX: " reset-tokenizer parse-multiline-string parse-ebnf main swap at +SYNTAX: " + reset-tokenizer parse-multiline-string parse-ebnf main swap at parsed reset-tokenizer ; -SYNTAX: [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip +SYNTAX: [EBNF + "EBNF]" + reset-tokenizer parse-multiline-string ebnf>quot nip parsed \ call parsed reset-tokenizer ; SYNTAX: EBNF: reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string - ebnf>quot swapd (( input -- ast )) define-declared "ebnf-parser" set-word-prop + ebnf>quot swapd + (( input -- ast )) define-declared "ebnf-parser" set-word-prop reset-tokenizer ; -