diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 18efb74fa9..a738c157c3 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -351,12 +351,18 @@ M: curry ' : emit-words ( -- ) all-words [ emit-word ] each ; +: fix-source-files + [ + clone dup source-file-definitions H{ } clone 2array + over set-source-file-definitions + ] assoc-map ; + : emit-global ( -- ) [ { dictionary source-files typemap builtins class : make-image ( arch -- ) [ - [ drop ] recompile-hook set prepare-image begin-image "resource:/core/bootstrap/stage1.factor" run-file diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 12248b8361..33b1b05be4 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -19,7 +19,11 @@ crossref off "syntax" vocab vocab-words bootstrap-syntax set "resource:core/bootstrap/syntax.factor" parse-file + H{ } clone dictionary set +H{ } clone changed-words set +[ drop ] recompile-hook set + call ! Create some empty vocabs where the below primitives and diff --git a/core/cpu/x86/assembler/assembler.factor b/core/cpu/x86/assembler/assembler.factor old mode 100644 new mode 100755 index bb5e13613c..15b0d57f4f --- a/core/cpu/x86/assembler/assembler.factor +++ b/core/cpu/x86/assembler/assembler.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays generator generator.fixup io.binary kernel +USING: arrays generator.fixup io.binary kernel combinators kernel.private math namespaces parser sequences words system ; IN: cpu.x86.assembler diff --git a/core/definitions/definitions-docs.factor b/core/definitions/definitions-docs.factor index b771306d9b..2a698ca3fa 100755 --- a/core/definitions/definitions-docs.factor +++ b/core/definitions/definitions-docs.factor @@ -88,12 +88,7 @@ HELP: redefine-error { $description "Throws a " { $link redefine-error } "." } { $error-description "Indicates that a single source file contains two definitions for the same artifact, one of which shadows the other. This is an error since it indicates a likely mistake, such as two words accidentally named the same by the developer; the error is restartable." } ; -HELP: redefinition? -{ $values { "definition" "a definition specifier" } { "?" "a boolean" } } -{ $description "Tests if this definition is already present in the current source file." } -$parsing-note ; - -HELP: (save-location) +HELP: remember-definition { $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } } { $description "Saves the location of a definition and associates this definition with the current source file." $nl diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index d21d689975..104dd3c09e 100755 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -54,26 +54,37 @@ TUPLE: redefine-error def ; \ redefine-error construct-boa { { "Continue" t } } throw-restarts drop ; -: redefinition? ( definition -- ? ) - new-definitions get key? ; +: add-once ( key assoc -- ) + 2dup key? [ drop redefine-error ] when dupd set-at ; -: (save-location) ( definition loc -- ) - over redefinition? [ over redefine-error ] when - over set-where - dup new-definitions get set-at ; +: (remember-definition) ( definition loc assoc -- ) + >r over set-where r> add-once ; + +: remember-definition ( definition loc -- ) + new-definitions get first (remember-definition) ; + +: remember-class ( class loc -- ) + new-definitions get second (remember-definition) ; TUPLE: forward-error word ; : forward-error ( word -- ) \ forward-error construct-boa throw ; +: forward-reference? ( word -- ? ) + dup old-definitions get assoc-stack + [ new-definitions get assoc-stack not ] + [ drop f ] if ; + SYMBOL: recompile-hook +: ( -- pair ) { H{ } H{ } } [ clone ] map ; + : with-compilation-unit ( quot -- new-defs ) [ H{ } clone changed-words set - H{ } clone new-definitions set - old-definitions off + new-definitions set + old-definitions set call changed-words get keys recompile-hook get call ] with-scope ; inline diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 446add5678..4dce1bd455 100755 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -229,7 +229,7 @@ HELP: HELP: location { $values { "loc" "a " { $snippet "{ path line# }" } " pair" } } -{ $description "Outputs the current parser location. This value can be passed to " { $link set-where } " or " { $link (save-location) } "." } ; +{ $description "Outputs the current parser location. This value can be passed to " { $link set-where } " or " { $link remember-definition } "." } ; HELP: save-location { $values { "definition" "a definition specifier" } } diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 0c0bbf82d9..57ff831eca 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -141,7 +141,7 @@ IN: temporary "IN: temporary : smudge-me ;" "foo" parse-stream drop - "foo" source-file source-file-definitions assoc-size + "foo" source-file source-file-definitions first assoc-size ] unit-test [ t ] [ "smudge-me" "temporary" lookup >boolean ] unit-test @@ -158,21 +158,21 @@ IN: temporary "IN: temporary USING: math strings ; GENERIC: smudge-me M: integer smudge-me ; M: string smudge-me ;" "foo" parse-stream drop - "foo" source-file source-file-definitions assoc-size + "foo" source-file source-file-definitions first assoc-size ] unit-test [ 1 ] [ "IN: temporary USING: arrays ; M: array smudge-me ;" "bar" parse-stream drop - "bar" source-file source-file-definitions assoc-size + "bar" source-file source-file-definitions first assoc-size ] unit-test [ 2 ] [ "IN: temporary USING: math strings ; GENERIC: smudge-me M: integer smudge-me ;" "foo" parse-stream drop - "foo" source-file source-file-definitions assoc-size + "foo" source-file source-file-definitions first assoc-size ] unit-test [ t ] [ @@ -217,7 +217,7 @@ IN: temporary [ t ] [ [ - "IN: temporary : x ; : y 3 throw ; parsing y" + "IN: temporary : x ; : y 3 throw ; this is an error" "a" parse-stream ] catch parse-error? ] unit-test @@ -376,9 +376,9 @@ IN: temporary : ~c ; : ~d ; - H{ { ~a ~a } { ~c ~c } { ~d ~d } } old-definitions set + { H{ { ~a ~a } { ~c ~c } { ~d ~d } } H{ } } old-definitions set - H{ { ~d ~d } } new-definitions set + { H{ { ~d ~d } } H{ } } new-definitions set [ V{ ~b } { ~a } { ~a ~c } ] [ smudged-usage diff --git a/core/parser/parser.factor b/core/parser/parser.factor index c51bc74d5f..e954b55782 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -20,7 +20,10 @@ TUPLE: lexer text line column ; [ >r source-file-path r> 2array ] [ 2drop f ] if ; : save-location ( definition -- ) - location (save-location) ; + location remember-definition ; + +: save-class-location ( class -- ) + location remember-class ; SYMBOL: parser-notes @@ -217,7 +220,7 @@ PREDICATE: unexpected unexpected-eof : CREATE-CLASS ( -- word ) scan in get create - dup save-location + dup save-class-location dup predicate-word save-location ; : word-restarts ( possibilities -- restarts ) @@ -235,14 +238,6 @@ M: no-word summary swap words-named word-restarts throw-restarts dup word-vocabulary (use+) ; -: forward-reference? ( word -- ? ) - { - { [ dup old-definitions get key? over old-definitions get key? or not ] [ f ] } - { [ dup new-definitions get key? ] [ f ] } - { [ dup new-definitions get key? ] [ f ] } - { [ t ] [ t ] } - } cond nip ; - : check-forward ( str word -- word ) dup forward-reference? [ drop @@ -270,7 +265,8 @@ M: staging-violation summary "A parsing word cannot be used in the same file it is defined in." ; : execute-parsing ( word -- ) - dup new-definitions get key? [ staging-violation ] when + dup + new-definitions get first key? [ staging-violation ] when execute ; : parse-step ( accum end -- accum ? ) @@ -380,9 +376,10 @@ SYMBOL: bootstrap-syntax file get source-file-path = ] assoc-subset ; +: removed-definitions ( -- definitions ) new-definitions get old-definitions get [ first2 union ] 2apply diff ; + : smudged-usage ( -- usages referenced removed ) - new-definitions get old-definitions get diff filter-moved - keys [ + removed-definitions filter-moved keys [ outside-usages [ empty? swap pathname? or not ] assoc-subset dup values concat prune swap keys diff --git a/core/source-files/source-files-docs.factor b/core/source-files/source-files-docs.factor index 742d12fff3..66b56e6168 100755 --- a/core/source-files/source-files-docs.factor +++ b/core/source-files/source-files-docs.factor @@ -37,7 +37,7 @@ HELP: source-file { { $link source-file-modified } " - the result of " { $link file-modified } " at the time the source file was most recently loaded." } { { $link source-file-checksum } " - the CRC32 checksum of the source file's contents at the time it was most recently loaded." } { { $link source-file-uses } " - an assoc whose keys are words referenced from this source file's top level form." } - { { $link source-file-definitions } " - an assoc whose keys are definitions defined in this source file." } + { { $link source-file-definitions } " - a pair of assocs, containing definitions and classes defined in this source file, respectively" } } } ; diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index 30514e5aee..e1c6b0e2b6 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -58,7 +58,9 @@ uses definitions ; new-definitions get swap set-source-file-definitions ; : ( path -- source-file ) - { set-source-file-path } \ source-file construct ; + + { set-source-file-path set-source-file-definitions } + \ source-file construct ; : source-file ( path -- source-file ) source-files get [ ] cache ; @@ -74,13 +76,13 @@ M: pathname where pathname-string 1 2array ; : forget-source ( path -- ) dup source-file dup unxref-source - source-file-definitions keys forget-all + source-file-definitions [ keys forget-all ] each source-files get delete-at ; M: pathname forget pathname-string forget-source ; : rollback-source-file ( source-file -- ) - dup source-file-definitions new-definitions get union + dup source-file-definitions new-definitions get [ union ] 2map swap set-source-file-definitions ; SYMBOL: file diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 4c55dede64..f3f4adc62c 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -95,7 +95,7 @@ IN: bootstrap.syntax "DEFER:" [ scan in get create - dup old-definitions get delete-at + dup old-definitions get first delete-at set-word ] define-syntax @@ -128,7 +128,7 @@ IN: bootstrap.syntax location >r scan-word bootstrap-word scan-word [ parse-definition -rot define-method ] 2keep - 2array r> (save-location) + 2array r> remember-definition ] define-syntax "UNION:" [ diff --git a/extra/help/definitions/definitions-tests.factor b/extra/help/definitions/definitions-tests.factor old mode 100644 new mode 100755 index 6f6703258f..a07789ddfd --- a/extra/help/definitions/definitions-tests.factor +++ b/extra/help/definitions/definitions-tests.factor @@ -12,7 +12,7 @@ IN: temporary "IN: temporary USING: help.syntax ; : hello ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" "foo" parse-stream drop - "foo" source-file source-file-definitions assoc-size + "foo" source-file source-file-definitions first assoc-size ] unit-test [ t ] [ "hello" articles get key? ] unit-test @@ -25,7 +25,7 @@ IN: temporary "IN: temporary USING: help.syntax ; : hello ; ARTICLE: \"hello\" \"world\" ;" "foo" parse-stream drop - "foo" source-file source-file-definitions assoc-size + "foo" source-file source-file-definitions first assoc-size ] unit-test [ t ] [ "hello" articles get key? ] unit-test diff --git a/extra/help/syntax/syntax.factor b/extra/help/syntax/syntax.factor old mode 100644 new mode 100755 index a1acd6a49d..6d287de60f --- a/extra/help/syntax/syntax.factor +++ b/extra/help/syntax/syntax.factor @@ -13,7 +13,7 @@ IN: help.syntax : ARTICLE: location >r \ ; parse-until >array [ first2 ] keep 2 tail
- over add-article >link r> (save-location) ; parsing + over add-article >link r> remember-definition ; parsing : ABOUT: scan-word dup parsing? [