]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' into smarter_error_list
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 6 Apr 2009 04:54:01 +0000 (23:54 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 6 Apr 2009 04:54:01 +0000 (23:54 -0500)
17 files changed:
basis/debugger/debugger.factor
basis/models/arrow/smart/authors.txt [new file with mode: 0644]
basis/models/arrow/smart/smart-tests.factor [new file with mode: 0644]
basis/models/arrow/smart/smart.factor [new file with mode: 0644]
basis/models/search/search.factor
basis/models/sort/sort.factor
basis/tools/profiler/profiler.factor
basis/ui/gadgets/panes/panes-tests.factor
basis/ui/gadgets/search-tables/search-tables.factor
basis/ui/tools/compiler-errors/authors.txt [new file with mode: 0644]
basis/ui/tools/compiler-errors/compiler-errors.factor [new file with mode: 0644]
basis/ui/tools/operations/operations.factor
basis/ui/tools/profiler/profiler-tests.factor [new file with mode: 0644]
basis/ui/tools/profiler/profiler.factor
core/compiler/errors/errors.factor
core/compiler/units/units-tests.factor
core/compiler/units/units.factor

index efd35ab2803055b47556bbf552bc73c1e7d991c9..fd7696576b9d8f7a5b8460e4b73630d5a3f6d60c 100644 (file)
@@ -9,7 +9,7 @@ combinators generic.math classes.builtin classes compiler.units
 generic.standard vocabs init kernel.private io.encodings
 accessors math.order destructors source-files parser
 classes.tuple.parser effects.parser lexer compiler.errors
-generic.parser strings.parser vocabs.loader vocabs.parser ;
+generic.parser strings.parser vocabs.loader vocabs.parser see ;
 IN: debugger
 
 GENERIC: error. ( error -- )
@@ -309,11 +309,20 @@ M: lexer-error compute-restarts
 M: lexer-error error-help
     error>> error-help ;
 
-M: object compiler-error. ( error word -- )
-    nl
-    "While compiling " write pprint ": " print
-    nl
-    print-error ;
+M: object compiler-error. ( error -- )
+    [
+        [
+            [
+                [ line#>> # ": " % ]
+                [ word>> synopsis % ] bi
+            ] "" make
+        ] [
+            [
+                presented set
+                bold font-style set
+            ] H{ } make-assoc
+        ] bi format nl
+    ] [ error>> error. ] bi ;
 
 M: bad-effect summary
     drop "Bad stack effect declaration" ;
diff --git a/basis/models/arrow/smart/authors.txt b/basis/models/arrow/smart/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/models/arrow/smart/smart-tests.factor b/basis/models/arrow/smart/smart-tests.factor
new file mode 100644 (file)
index 0000000..3e8375e
--- /dev/null
@@ -0,0 +1,4 @@
+IN: models.arrows.smart.tests
+USING: models.arrow.smart tools.test accessors models math kernel ;
+
+[ 7 ] [ 3 <model> 4 <model> [ + ] <smart-arrow> [ activate-model ] [ value>> ] bi ] unit-test
\ No newline at end of file
diff --git a/basis/models/arrow/smart/smart.factor b/basis/models/arrow/smart/smart.factor
new file mode 100644 (file)
index 0000000..257a2bb
--- /dev/null
@@ -0,0 +1,9 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: models.arrow models.product stack-checker accessors fry
+generalizations macros kernel ;
+IN: models.arrow.smart
+
+MACRO: <smart-arrow> ( quot -- quot' )
+    [ infer in>> dup ] keep
+    '[ _ narray <product> [ _ firstn @ ] <arrow> ] ;
\ No newline at end of file
index 4bf74b3b92e06807bfbdb4da37a1de0b92007500..5ecb0fa34ada9a88cf9a3ac944fe6cb7bd7687e7 100644 (file)
@@ -1,12 +1,10 @@
 ! Copyright (C) 2008, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays fry kernel models.product models.arrow
-sequences unicode.case ;
+USING: fry kernel models.arrow.smart sequences unicode.case ;
 IN: models.search
 
 : <search> ( values search quot -- model )
-    [ 2array <product> ] dip
-    '[ first2 _ curry filter ] <arrow> ;
+    '[ _ curry filter ] <smart-arrow> ; inline
 
 : <string-search> ( values search quot -- model )
-    '[ swap @ [ >case-fold ] bi@ subseq? ] <search> ;
+    '[ swap @ [ >case-fold ] bi@ subseq? ] <search> ; inline
index 23c150796fac63b956280264821018fcf3a3e0c6..efd2e4927b53aa8fe5c4569e5757565f8a1b2880 100644 (file)
@@ -1,8 +1,7 @@
-! Copyright (C) 2008 Slava Pestov
+! Copyright (C) 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays fry kernel models.product models.arrow
-sequences sorting ;
+USING: sorting models.arrow.smart fry ;
 IN: models.sort
 
 : <sort> ( values sort -- model )
-    2array <product> [ first2 sort ] <arrow> ;
\ No newline at end of file
+    [ '[ _ call( obj1 obj2 -- <=> ) ] sort ] <smart-arrow> ; inline
\ No newline at end of file
index 864a637096c0c75790b63ff4d57e74cb208fc96a..f4488136b2d7b32323acb884d07c07be762d7191 100644 (file)
@@ -7,7 +7,7 @@ continuations generic compiler.units sets classes fry ;
 IN: tools.profiler
 
 : profile ( quot -- )
-    [ t profiling call ] [ f profiling ] [ ] cleanup ;
+    [ t profiling call ] [ f profiling ] [ ] cleanup ; inline
 
 : filter-counts ( alist -- alist' )
     [ second 0 > ] filter ;
index 0529437a76663c1d6edbb7c5877d4fcc3d39e615..01abe8b3d958c0175ee1f81b2a7be511fc65a917 100644 (file)
@@ -2,7 +2,7 @@ USING: alien ui.gadgets.panes ui.gadgets namespaces
 kernel sequences io io.styles io.streams.string tools.test
 prettyprint definitions help help.syntax help.markup
 help.stylesheet splitting ui.gadgets.debug models math summary
-inspector accessors help.topics see ;
+inspector accessors help.topics see fry ;
 IN: ui.gadgets.panes.tests
 
 : #children ( -- n ) "pane" get children>> length ;
@@ -18,8 +18,9 @@ IN: ui.gadgets.panes.tests
 [ t ] [ #children "num-children" get = ] unit-test
 
 : test-gadget-text ( quot -- ? )
-    dup make-pane gadget-text dup print "======" print
-    swap with-string-writer dup print = ;
+    '[ _ call( -- ) ]
+    [ make-pane gadget-text dup print "======" print ]
+    [ with-string-writer dup print ] bi = ;
 
 [ t ] [ [ "hello" write ] test-gadget-text ] unit-test
 [ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test
index 17570a8714a805903c79f213533e0afa7a6da4be..fc564b6ffe9eabd8c644ef2e236489e591cab550 100644 (file)
@@ -74,7 +74,7 @@ CONSULT: table-protocol search-table table>> ;
         dup field>> { 2 2 } <filled-border> f track-add
         values search 500 milliseconds <delay> quot <string-search>
         renderer <table> f >>takes-focus? >>table
-        dup table>> <scroller> 1 track-add ;
+        dup table>> <scroller> 1 track-add ; inline
 
 M: search-table model-changed
     nip field>> clear-search-field ;
diff --git a/basis/ui/tools/compiler-errors/authors.txt b/basis/ui/tools/compiler-errors/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/ui/tools/compiler-errors/compiler-errors.factor b/basis/ui/tools/compiler-errors/compiler-errors.factor
new file mode 100644 (file)
index 0000000..e574aa0
--- /dev/null
@@ -0,0 +1,77 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays sorting assocs colors.constants combinators
+combinators.smart compiler.errors compiler.units fonts kernel
+math.parser math.order models models.arrow namespaces summary ui
+ui.commands ui.gadgets ui.gadgets.tables ui.gadgets.tracks
+ui.gestures ui.operations ui.tools.browser ui.tools.common
+ui.gadgets.scrollers ;
+IN: ui.tools.compiler-errors
+
+TUPLE: error-list-gadget < tool table ;
+
+SINGLETON: error-renderer
+
+M: error-renderer row-columns
+    drop [
+        {
+            [ file>> ]
+            [ line#>> number>string ]
+            [ word>> name>> ]
+            [ error>> summary ]
+        } cleave
+    ] output>array ;
+
+M: error-renderer row-value
+    drop ;
+
+M: error-renderer column-titles
+    drop { "File" "Line" "Word" "Error" } ;
+
+: <error-table> ( model -- table )
+    [ [ [ [ file>> ] [ line#>> ] bi 2array ] compare ] sort ] <arrow>
+    error-renderer <table>
+        [ invoke-primary-operation ] >>action
+        monospace-font >>font
+        COLOR: dark-gray >>column-line-color
+        6 >>gap
+        30 >>min-rows
+        30 >>max-rows
+        80 >>min-cols
+        80 >>max-cols ;
+
+: <error-list-gadget> ( model -- gadget )
+    [ values ] <arrow> vertical error-list-gadget new-track
+        { 3 3 } >>gap
+        swap <error-table> >>table
+        dup table>> <scroller> 1 track-add ;
+
+M: error-list-gadget focusable-child*
+    table>> ;
+
+: error-list-help ( -- ) "ui-error-list" com-browse ;
+
+\ error-list-help H{ { +nullary+ t } } define-command
+
+error-list-gadget "toolbar" f {
+    { T{ key-down f f "F1" } error-list-help }
+} define-command-map
+
+SYMBOL: compiler-error-model
+
+compiler-error-model [ f <model> ] initialize
+
+SINGLETON: updater
+
+M: updater definitions-changed
+    2drop
+    compiler-errors get-global
+    compiler-error-model get-global
+    set-model ;
+
+updater remove-definition-observer
+updater add-definition-observer
+
+: error-list-window ( obj -- )
+    compiler-error-model get-global <error-list-gadget>
+    "Compiler errors" open-window ;
\ No newline at end of file
index c6371ac8aaf3794e8f9eae2eb4a639f52e134bd7..881808ea03f8760f23fdc01333b7b54585b4d3d2 100644 (file)
@@ -5,7 +5,7 @@ stack-checker summary io.pathnames io.styles kernel namespaces
 parser prettyprint quotations tools.crossref tools.annotations
 editors tools.profiler tools.test tools.time tools.walker vocabs
 vocabs.loader words sequences tools.vocabs classes
-compiler.units accessors vocabs.parser macros.expander ui
+compiler.errors compiler.units accessors vocabs.parser macros.expander ui
 ui.tools.browser ui.tools.listener ui.tools.listener.completion
 ui.tools.profiler ui.tools.inspector ui.tools.traceback
 ui.commands ui.gadgets.editors ui.gestures ui.operations
@@ -86,6 +86,24 @@ IN: ui.tools.operations
     { +listener+ t }
 } define-operation
 
+! Compiler errors
+: edit-error ( error -- )
+    [ file>> ] [ line#>> ] bi edit-location ;
+
+[ compiler-error? ] \ edit-error H{
+    { +primary+ t }
+    { +secondary+ t }
+    { +listener+ t }
+} define-operation
+
+: com-reload ( error -- )
+    file>> run-file ;
+
+[ compiler-error? ] \ com-reload H{
+    { +listener+ t }
+} define-operation
+
+! Definitions
 : com-forget ( defspec -- )
     [ forget ] with-compilation-unit ;
 
diff --git a/basis/ui/tools/profiler/profiler-tests.factor b/basis/ui/tools/profiler/profiler-tests.factor
new file mode 100644 (file)
index 0000000..86bebdd
--- /dev/null
@@ -0,0 +1,3 @@
+USING: ui.tools.profiler tools.test ;
+
+\ profiler-window must-infer
index 1c2318a35e94328d30cdf8f41231591ebb638cc5..5fef64ea8857e72b395f36a6f69529b49df93506 100644 (file)
@@ -11,6 +11,7 @@ ui.gadgets.tabbed ui.gadgets.status-bar ui.gadgets.borders
 ui.tools.browser ui.tools.common ui.baseline-alignment
 ui.operations ui.images ;
 FROM: models.arrow => <arrow> ;
+FROM: models.arrow.smart => <smart-arrow> ;
 FROM: models.product => <product> ;
 IN: ui.tools.profiler
 
@@ -112,8 +113,8 @@ M: method-renderer column-titles drop { "" "Method" "Count" } ;
 : <methods-model> ( profiler -- model )
     [
         [ method-counters <model> ] dip
-        [ generic>> ] [ class>> ] bi 3array <product>
-        [ first3 '[ _ _ method-matches? ] filter ] <arrow>
+        [ generic>> ] [ class>> ] bi
+        [ '[ _ _ method-matches? ] filter ] <smart-arrow>
     ] keep <profiler-model> ;
 
 : sort-by-name ( obj1 obj2 -- <=> )
@@ -208,6 +209,6 @@ profiler-gadget "toolbar" f {
 : profiler-window ( -- )
     <profiler-gadget> "Profiling results" open-status-window ;
 
-: com-profile ( quot -- ) profile profiler-window ;
+: com-profile ( quot -- ) profile profiler-window ; inline
 
 MAIN: profiler-window
index 1ea497c3fc5cbeab65f5e8b63329c4dac23b7a7d..f5e6fda646807f00d912fac5e73a470f7d24676a 100644 (file)
@@ -1,21 +1,28 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces make assocs io sequences
-sorting continuations math math.parser ;
+sorting continuations math math.order math.parser accessors
+definitions ;
 IN: compiler.errors
 
 SYMBOL: +error+
 SYMBOL: +warning+
 SYMBOL: +linkage+
 
+TUPLE: compiler-error error word file line# ;
+
 GENERIC: compiler-error-type ( error -- ? )
 
 M: object compiler-error-type drop +error+ ;
 
-GENERIC# compiler-error. 1 ( error word -- )
+M: compiler-error compiler-error-type error>> compiler-error-type ;
+
+GENERIC: compiler-error. ( error -- )
 
 SYMBOL: compiler-errors
 
+compiler-errors [ H{ } clone ] initialize
+
 SYMBOL: with-compiler-errors?
 
 : errors-of-type ( type -- assoc )
@@ -23,9 +30,19 @@ SYMBOL: with-compiler-errors?
     swap [ [ nip compiler-error-type ] dip eq? ] curry
     assoc-filter ;
 
+: sort-compile-errors ( assoc -- alist )
+    [ [ [ line#>> ] compare ] sort ] { } assoc-map-as sort-keys ;
+
+: group-by-source-file ( errors -- assoc )
+    H{ } clone [ [ push-at ] curry [ nip dup file>> ] prepose assoc-each ] keep ;
+
 : compiler-errors. ( type -- )
-    errors-of-type >alist sort-keys
-    [ swap compiler-error. ] assoc-each ;
+    errors-of-type group-by-source-file sort-compile-errors
+    [
+        [ nl "==== " write print nl ]
+        [ [ nl ] [ compiler-error. ] interleave ]
+        bi*
+    ] assoc-each ;
 
 : (compiler-report) ( what type word -- )
     over errors-of-type assoc-empty? [ 3drop ] [
@@ -51,17 +68,17 @@ SYMBOL: with-compiler-errors?
 
 : :linkage ( -- ) +linkage+ compiler-errors. ;
 
+: <compiler-error> ( error word -- compiler-error )
+    dup where [ first2 ] [ "<unknown file>" 0 ] if* \ compiler-error boa ;
+
 : compiler-error ( error word -- )
-    with-compiler-errors? get [
-        compiler-errors get pick
-        [ set-at ] [ delete-at drop ] if
-    ] [ 2drop ] if ;
+    compiler-errors get-global pick
+    [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
 
 : with-compiler-errors ( quot -- )
     with-compiler-errors? get "quiet" get or [ call ] [
         [
             with-compiler-errors? on
-            V{ } clone compiler-errors set-global
             [ compiler-report ] [ ] cleanup
         ] with-scope
     ] if ; inline
index d84b377f361d92256d69b0bcc455f08dfeaf5f20..6545a456046d4f73429a1da3c6e62b15d08dec48 100644 (file)
@@ -1,6 +1,6 @@
-IN: compiler.units.tests
 USING: definitions compiler.units tools.test arrays sequences words kernel
 accessors namespaces fry ;
+IN: compiler.units.tests
 
 [ [ [ ] define-temp ] with-compilation-unit ] must-infer
 [ [ [ ] define-temp ] with-nested-compilation-unit ] must-infer
@@ -30,4 +30,19 @@ accessors namespaces fry ;
         "a" get [ "B" ] define
     ] with-compilation-unit
     "b" get execute
-] unit-test
\ No newline at end of file
+] unit-test
+
+! Notify observers even if compilation unit did nothing
+SINGLETON: observer
+
+observer add-definition-observer
+
+SYMBOL: counter
+
+0 counter set-global
+
+M: observer definitions-changed 2drop global [ counter inc ] bind ;
+
+[ ] with-compilation-unit
+
+[ 1 ] [ counter get-global ] unit-test
\ No newline at end of file
index afa05f94426e20657ff84a932902518a27e08e22..e8b5b4647d747c096b5326cb297c1bb80cc506e1 100644 (file)
@@ -3,7 +3,7 @@
 USING: accessors arrays kernel continuations assocs namespaces
 sequences words vocabs definitions hashtables init sets
 math math.order classes classes.algebra classes.tuple
-classes.tuple.private generic ;
+classes.tuple.private generic compiler.errors ;
 IN: compiler.units
 
 SYMBOL: old-definitions
@@ -41,7 +41,7 @@ SYMBOL: compiler-impl
 HOOK: recompile compiler-impl ( words -- alist )
 
 ! Non-optimizing compiler
-M: f recompile [ f ] { } map>assoc ;
+M: f recompile [ [ f swap compiler-error ] each ] [ [ f ] { } map>assoc ] bi ;
 
 ! Trivial compiler. We don't want to touch the code heap
 ! during stage1 bootstrap, it would just waste time.