From 577c450db90f1b7ca4eb01688085ed2a610dfad2 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 2 Jun 2009 00:55:53 +0200 Subject: [PATCH 1/7] FUEL: When creating foo-docs.factor, optionally insert scaffold. --- misc/fuel/factor-mode.el | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index b302fb6b8f..af0f62aa27 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -36,6 +36,13 @@ When set to false, you'll be asked only once." :type 'boolean :group 'factor-mode) +(defcustom factor-mode-cycle-insert-docs-p 'ask + "Whether to insert documentation templates upon creation of doc +file during cycling." + :type '(choice (const :tag "Never" nil) + (const :tag "Always" 'always) + (const :tag "Ask me" 'ask))) + (defcustom factor-mode-use-fuel t "Whether to use the full FUEL facilities in factor mode. @@ -125,7 +132,8 @@ code in the buffer." (defun factor-mode--indent-setter-line () (when (fuel-syntax--at-setter-line) (save-excursion - (let ((indent (and (fuel-syntax--at-constructor-line) (current-indentation)))) + (let ((indent (and (fuel-syntax--at-constructor-line) + (current-indentation)))) (while (not (or indent (bobp) (fuel-syntax--at-begin-of-def) @@ -225,12 +233,32 @@ code in the buffer." (defsubst factor-mode--cycling-setup () (setq factor-mode--cycling-no-ask nil)) +(defun factor-mode--other-file-doc-p (file) + (let ((bn (file-name-nondirectory file))) + (and (string-match "\\(.+\\)-docs.factor" bn) + (expand-file-name (concat (match-string 1 bn) ".factor") + (file-name-directory file))))) + +(defun factor-mode--other-file-check-docs (file) + (when (and factor-mode-cycle-insert-docs-p + (boundp 'fuel-mode) + fuel-mode) + (let ((code-file (factor-mode--other-file-doc-p file))) + (when (and code-file + (or (eq factor-mode-cycle-insert-docs-p 'always) + (y-or-n-p "Insert doc templates? "))) + (save-excursion + (set-buffer (find-file-noselect code-file)) + (fuel-scaffold-help)))))) + (defun factor-mode-visit-other-file (&optional skip) "Cycle between code, tests and docs factor files. With prefix, non-existing files will be skipped." (interactive "P") (let ((file (factor-mode--cycle-next (buffer-file-name) skip))) (unless file (error "No other file found")) + (unless (file-exists-p file) + (factor-mode--other-file-check-docs file)) (find-file file) (unless (file-exists-p file) (set-buffer-modified-p t) From a381d12b6d04bce1a4bb0a73f70836e07221e511 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 2 Jun 2009 03:21:35 +0200 Subject: [PATCH 2/7] FUEL: Automatic insertion of scaffolding in docs and test upon file creation. --- misc/fuel/factor-mode.el | 32 ++++++-------------- misc/fuel/fuel-mode.el | 5 ++- misc/fuel/fuel-scaffold.el | 62 ++++++++++++++++++++++++++++++++++++-- 3 files changed, 72 insertions(+), 27 deletions(-) diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index af0f62aa27..cc8ebe35fb 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -36,13 +36,6 @@ When set to false, you'll be asked only once." :type 'boolean :group 'factor-mode) -(defcustom factor-mode-cycle-insert-docs-p 'ask - "Whether to insert documentation templates upon creation of doc -file during cycling." - :type '(choice (const :tag "Never" nil) - (const :tag "Always" 'always) - (const :tag "Ask me" 'ask))) - (defcustom factor-mode-use-fuel t "Whether to use the full FUEL facilities in factor mode. @@ -233,23 +226,18 @@ code in the buffer." (defsubst factor-mode--cycling-setup () (setq factor-mode--cycling-no-ask nil)) -(defun factor-mode--other-file-doc-p (file) - (let ((bn (file-name-nondirectory file))) - (and (string-match "\\(.+\\)-docs.factor" bn) +(defun factor-mode--code-file (kind &optional file) + (let* ((file (or file (buffer-file-name))) + (bn (file-name-nondirectory file))) + (and (string-match (format "\\(.+\\)-%s\\.factor$" kind) bn) (expand-file-name (concat (match-string 1 bn) ".factor") (file-name-directory file))))) -(defun factor-mode--other-file-check-docs (file) - (when (and factor-mode-cycle-insert-docs-p - (boundp 'fuel-mode) - fuel-mode) - (let ((code-file (factor-mode--other-file-doc-p file))) - (when (and code-file - (or (eq factor-mode-cycle-insert-docs-p 'always) - (y-or-n-p "Insert doc templates? "))) - (save-excursion - (set-buffer (find-file-noselect code-file)) - (fuel-scaffold-help)))))) +(defsubst factor-mode--in-docs (&optional file) + (factor-mode--code-file "docs")) + +(defsubst factor-mode--in-tests (&optional file) + (factor-mode--code-file "tests")) (defun factor-mode-visit-other-file (&optional skip) "Cycle between code, tests and docs factor files. @@ -257,8 +245,6 @@ With prefix, non-existing files will be skipped." (interactive "P") (let ((file (factor-mode--cycle-next (buffer-file-name) skip))) (unless file (error "No other file found")) - (unless (file-exists-p file) - (factor-mode--other-file-check-docs file)) (find-file file) (unless (file-exists-p file) (set-buffer-modified-p t) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 0186392f34..282ef3240f 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -172,7 +172,10 @@ interacting with a factor listener is at your disposal. (when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode)) (setq fuel-stack-mode-string "/S") - (when fuel-mode-stack-p (fuel-stack-mode fuel-mode))) + (when fuel-mode-stack-p (fuel-stack-mode fuel-mode)) + + (when (and fuel-mode (not (file-exists-p (buffer-file-name)))) + (fuel-scaffold--maybe-insert))) ;;; Keys: diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el index b1c4462503..9b7d9861c7 100644 --- a/misc/fuel/fuel-scaffold.el +++ b/misc/fuel/fuel-scaffold.el @@ -39,6 +39,64 @@ (let ((cmd '(:fuel* (vocab-roots get :get) "fuel"))) (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) +(defun fuel-scaffold--dev-name () + (or fuel-scaffold-developer-name + (let ((cmd '(:fuel* (developer-name get :get) "fuel"))) + (fuel-eval--retort-result (fuel-eval--send/wait cmd))) + "Your name")) + +(defun fuel-scaffold--first-vocab () + (goto-char (point-min)) + (re-search-forward fuel-syntax--current-vocab-regex nil t)) + +(defsubst fuel-scaffold--vocab (file) + (save-excursion + (set-buffer (find-file-noselect file)) + (fuel-scaffold--first-vocab) + (fuel-syntax--current-vocab))) + +(defconst fuel-scaffold--tests-header-format + "! Copyright (C) %s %s +! See http://factorcode.org/license.txt for BSD license. +USING: %s tools.test ; +IN: %s +") + +(defsubst fuel-scaffold--check-auto (var) + (and var (or (eq var 'always) (y-or-n-p "Insert template? ")))) + +(defun fuel-scaffold--tests (parent) + (when (and parent (fuel-scaffold--check-auto fuel-scaffold-test-autoinsert-p)) + (let ((year (format-time-string "%Y")) + (name (fuel-scaffold--dev-name)) + (vocab (fuel-scaffold--vocab parent))) + (insert (format fuel-scaffold--tests-header-format + year name vocab vocab)) + t))) + +(defsubst fuel-scaffold--create-docs (vocab) + (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-help) + "fuel"))) + (fuel-eval--send/wait cmd))) + +(defun fuel-scaffold--help (parent) + (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p)) + (let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent))) + (file (fuel-eval--retort-result ret))) + (when file + (revert-buffer t t t) + (when (and fuel-scaffold-help-header-only-p + (fuel-scaffold--first-vocab)) + (delete-region (1+ (point)) (point-max)) + (save-buffer)) + (message "Inserting template ... done.")) + (goto-char (point-min))))) + +(defun fuel-scaffold--maybe-insert () + (ignore-errors + (or (fuel-scaffold--tests (factor-mode--in-tests)) + (fuel-scaffold--help (factor-mode--in-docs))))) + ;;; User interface: @@ -73,9 +131,7 @@ You can configure `fuel-scaffold-developer-name' (set by default to (interactive "P") (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab)) (fuel-completion--read-vocab nil))) - (cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-help) - "fuel")) - (ret (fuel-eval--send/wait cmd)) + (ret (fuel-scaffold--create-docs vocab)) (file (fuel-eval--retort-result ret))) (unless file (error "Error creating help file" (car (fuel-eval--retort-error ret)))) From 09b08a092468c5521ba878a076b4b116fa8f0f2d Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 2 Jun 2009 04:34:40 +0200 Subject: [PATCH 3/7] FUEL: Better looking tables in help buffers and a fix for in-cell links. --- misc/fuel/fuel-markup.el | 2 +- misc/fuel/fuel-table.el | 59 ++++++++++++++++++++++++++++++++++------ 2 files changed, 52 insertions(+), 9 deletions(-) diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index 80fe8e830b..cc788fe5dc 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -382,7 +382,7 @@ (when (looking-at "Word *\\(Stack effect\\|Syntax\\)$") (push (list "Word" (match-string-no-properties 1)) rows) (forward-line)) - (while (looking-at "\\(.+?\\)\\( +\\(.+\\)\\)?$") + (while (looking-at " ?\\(.+?\\)\\( +\\(.+\\)\\)?$") (let ((word `($link ,(match-string-no-properties 1) ,(match-string-no-properties 1) word)) diff --git a/misc/fuel/fuel-table.el b/misc/fuel/fuel-table.el index a00b21bf2f..dfab07c540 100644 --- a/misc/fuel/fuel-table.el +++ b/misc/fuel/fuel-table.el @@ -72,21 +72,64 @@ (push (fuel-table--pad-row (reverse frow)) frows))) (reverse frows))) +(defvar fuel-table-corner-lt "┌") +(defvar fuel-table-corner-lb "└") +(defvar fuel-table-corner-rt "┐") +(defvar fuel-table-corner-rb "┘") +(defvar fuel-table-line "─") +(defvar fuel-table-tee-t "┬") +(defvar fuel-table-tee-b "┴") +(defvar fuel-table-tee-l "├") +(defvar fuel-table-tee-r "┤") +(defvar fuel-table-crux "┼") +(defvar fuel-table-sep "│") + +(defun fuel-table--insert-line (widths first last sep) + (insert first fuel-table-line) + (dolist (w widths) + (while (> w 0) + (insert fuel-table-line) + (setq w (1- w))) + (insert fuel-table-line sep fuel-table-line)) + (delete-char -2) + (insert fuel-table-line last) + (newline)) + +(defun fuel-table--insert-first-line (widths) + (fuel-table--insert-line widths + fuel-table-corner-lt + fuel-table-corner-rt + fuel-table-tee-t)) + +(defun fuel-table--insert-middle-line (widths) + (fuel-table--insert-line widths + fuel-table-tee-l + fuel-table-tee-r + fuel-table-crux)) + +(defun fuel-table--insert-last-line (widths) + (fuel-table--insert-line widths + fuel-table-corner-lb + fuel-table-corner-rb + fuel-table-tee-b)) + (defun fuel-table--insert (rows) (let* ((widths (fuel-table--col-widths rows)) - (rows (fuel-table--format-rows rows widths)) - (ls (concat "+" (mapconcat (lambda (n) (make-string n ?-)) widths "-+") "-+"))) - (insert ls "\n") + (rows (fuel-table--format-rows rows widths))) + (fuel-table--insert-first-line widths) (dolist (r rows) (let ((ln (length (car r))) (l 0)) (while (< l ln) - (insert (concat "|" (mapconcat 'identity - (mapcar `(lambda (x) (nth ,l x)) r) - " |") - " |\n")) + (insert (concat fuel-table-sep " " + (mapconcat 'identity + (mapcar `(lambda (x) (nth ,l x)) r) + (concat " " fuel-table-sep " ")) + " " fuel-table-sep "\n")) (setq l (1+ l)))) - (insert ls "\n")))) + (fuel-table--insert-middle-line widths)) + (kill-line -1) + (fuel-table--insert-last-line widths))) (provide 'fuel-table) From 7639afb0d743518b86affe921f6884395262da92 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 2 Jun 2009 05:02:39 +0200 Subject: [PATCH 4/7] FUEL: Tiny refactoring. --- misc/fuel/fuel-table.el | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/misc/fuel/fuel-table.el b/misc/fuel/fuel-table.el index dfab07c540..1af2e25712 100644 --- a/misc/fuel/fuel-table.el +++ b/misc/fuel/fuel-table.el @@ -113,20 +113,23 @@ fuel-table-corner-rb fuel-table-tee-b)) +(defun fuel-table--insert-row (r) + (let ((ln (length (car r))) + (l 0)) + (while (< l ln) + (insert (concat fuel-table-sep " " + (mapconcat 'identity + (mapcar `(lambda (x) (nth ,l x)) r) + (concat " " fuel-table-sep " ")) + " " fuel-table-sep "\n")) + (setq l (1+ l))))) + (defun fuel-table--insert (rows) (let* ((widths (fuel-table--col-widths rows)) (rows (fuel-table--format-rows rows widths))) (fuel-table--insert-first-line widths) (dolist (r rows) - (let ((ln (length (car r))) - (l 0)) - (while (< l ln) - (insert (concat fuel-table-sep " " - (mapconcat 'identity - (mapcar `(lambda (x) (nth ,l x)) r) - (concat " " fuel-table-sep " ")) - " " fuel-table-sep "\n")) - (setq l (1+ l)))) + (fuel-table--insert-row r) (fuel-table--insert-middle-line widths)) (kill-line -1) (fuel-table--insert-last-line widths))) From 7922628abbd5f6ba96a2922be7854299c89e85d1 Mon Sep 17 00:00:00 2001 From: Philipp Winkler Date: Fri, 29 May 2009 14:41:24 -0700 Subject: [PATCH 5/7] Add a hand parser. Improves speed from 23 seconds to 0.03 seconds when parsing a 123Kb string. --- basis/json/reader/authors.txt | 2 + basis/json/reader/reader-tests.factor | 2 + basis/json/reader/reader.factor | 134 ++++++++++++++++---------- 3 files changed, 89 insertions(+), 49 deletions(-) diff --git a/basis/json/reader/authors.txt b/basis/json/reader/authors.txt index 44b06f94bc..d269b4ffb5 100644 --- a/basis/json/reader/authors.txt +++ b/basis/json/reader/authors.txt @@ -1 +1,3 @@ Chris Double +Peter Burns +Philipp Winkler diff --git a/basis/json/reader/reader-tests.factor b/basis/json/reader/reader-tests.factor index e97d45babe..fa6c8d7d3a 100644 --- a/basis/json/reader/reader-tests.factor +++ b/basis/json/reader/reader-tests.factor @@ -19,6 +19,8 @@ IN: json.reader.tests { 10.25 } [ "1025e-2" json> ] unit-test { 0.125 } [ "0.125" json> ] unit-test { -0.125 } [ "-0.125" json> ] unit-test +{ -0.00125 } [ "-0.125e-2" json> ] unit-test +{ -012.5 } [ "-0.125e+2" json> ] unit-test ! not widely supported by javascript, but allowed in the grammar, and a nice ! feature to get diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 887a7a50e5..1544af55cf 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,61 +1,97 @@ -! Copyright (C) 2008 Peter Burns. +! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler ! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg peg.ebnf math.parser math.parser.private strings math -math.functions sequences arrays vectors hashtables assocs -prettyprint json ; +USING: arrays assocs combinators io io.streams.string json +kernel math math.parser math.parser.private sequences strings ; IN: json.reader float ] + [ [ "eE." index ] any? [ >integer ] unless ] bi + ] dip ; -: grammar-list>vector ( seq -- vec ) first2 values swap prefix ; +DEFER: j-string + +: convert-string ( str -- str ) + read1 + { + { CHAR: b [ 8 ] } + { CHAR: f [ 12 ] } + { CHAR: n [ CHAR: \n ] } + { CHAR: r [ CHAR: \r ] } + { CHAR: t [ CHAR: \t ] } + { CHAR: u [ 4 read hex> ] } + [ ] + } case + dup + [ 1string append j-string append ] + [ drop ] if ; + +: j-string ( -- str ) + "\\\"" read-until CHAR: \" = + [ convert-string ] unless ; + +: second-last ( seq -- second-last ) + [ length 2 - ] keep nth ; inline -! Grammar for JSON from RFC 4627 -EBNF: (json>) +: third-last ( seq -- third-last ) + [ length 3 - ] keep nth ; inline + +: last2 ( seq -- second-last last ) + [ second-last ] [ last ] bi ; inline -ws = (" " | "\r" | "\t" | "\n")* +: last3 ( seq -- third-last second-last last ) + [ third-last ] [ last2 ] bi ; inline -true = "true" => [[ t ]] -false = "false" => [[ f ]] -null = "null" => [[ json-null ]] +: v-over-push ( vec -- vec' ) + dup length 2 >= + [ + dup + [ pop ] + [ last ] bi push + ] when ; -hex = [0-9a-fA-F] -char = '\\"' [[ CHAR: " ]] - | "\\\\" [[ CHAR: \ ]] - | "\\/" [[ CHAR: / ]] - | "\\b" [[ 8 ]] - | "\\f" [[ 12 ]] - | "\\n" [[ CHAR: \n ]] - | "\\r" [[ CHAR: \r ]] - | "\\t" [[ CHAR: \t ]] - | "\\u" (hex hex hex hex) [[ hex> ]] => [[ second ]] - | [^"\] -string = '"' char*:cs '"' => [[ cs >string ]] +: v-pick-push ( vec -- vec' ) + dup length 3 >= + [ + dup + [ pop ] + [ second-last ] bi push + ] when ; -sign = ("-" | "+")? => [[ "-" = "-" "" ? ]] -digits = [0-9]+ => [[ >string ]] -decimal = "." digits => [[ concat ]] -exp = ("e" | "E") sign digits => [[ concat ]] -number = sign digits decimal? exp? => [[ dup concat swap fourth [ string>float ] [ string>number ] if ]] - -elements = value ("," value)* => [[ grammar-list>vector ]] -array = "[" elements?:arr "]" => [[ arr >array ]] - -pair = ws string:key ws ":" value:val => [[ { key val } ]] -members = pair ("," pair)* => [[ grammar-list>vector ]] -object = "{" members?:hash "}" => [[ hash >hashtable ]] - -val = true - | false - | null - | string - | number - | array - | object - -value = ws val:v ws => [[ v ]] - -;EBNF +: (close-hash) ( accum -- accum' ) + dup length 3 >= [ v-over-push ] when + dup dup [ pop ] dip pop swap + zip H{ } assoc-clone-like over push ; + +: scan ( accum char -- accum ) + [ + { + { CHAR: \" [ j-string over push ] } + { CHAR: [ [ V{ } clone over push ] } + { CHAR: , [ v-over-push ] } + { CHAR: ] [ v-over-push dup pop >array over push ] } + { CHAR: { [ 2 [ V{ } clone over push ] times ] } + { CHAR: : [ v-pick-push ] } + { CHAR: } [ (close-hash) ] } + { CHAR: \u000020 [ ] } + { CHAR: \t [ ] } + { CHAR: \r [ ] } + { CHAR: \n [ ] } + { CHAR: t [ 3 read drop t over push ] } + { CHAR: f [ 4 read drop f over push ] } + { CHAR: n [ 3 read drop json-null over push ] } + [ value [ over push ] dip [ scan ] when* ] + } case + ] when* ; +: (json-parser>) ( string -- object ) + [ V{ } clone [ read1 dup ] [ scan ] while drop first ] with-string-reader ; + PRIVATE> - -: json> ( string -- object ) (json>) ; \ No newline at end of file + +: json> ( string -- object ) + (json-parser>) ; \ No newline at end of file From 70b75b8dea2a64f1cc32859f6b95b73274b438d7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 6 Jun 2009 01:04:12 -0500 Subject: [PATCH 6/7] Linear scan: implement live range intersection --- .../linear-scan/allocation/allocation.factor | 29 ++++++++- .../cfg/linear-scan/linear-scan-tests.factor | 60 +++++++++++++++++++ 2 files changed, 86 insertions(+), 3 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index f8258039e1..7b56bd6150 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -226,18 +226,41 @@ SYMBOL: spill-counts : assign-free-register ( new registers -- ) pop >>reg add-active ; -: next-intersection ( new inactive -- n ) - 2drop 0 ; +: relevant-ranges ( new inactive -- new' inactive' ) + ! Slice off all ranges of 'inactive' that precede the start of 'new' + [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ; + +: intersect-live-range ( range1 range2 -- n/f ) + 2dup [ from>> ] bi@ > [ swap ] when + 2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ; + +: intersect-live-ranges ( ranges1 ranges2 -- n ) + { + { [ over empty? ] [ 2drop 1/0. ] } + { [ dup empty? ] [ 2drop 1/0. ] } + [ + 2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [ + drop + 2dup [ first from>> ] bi@ < + [ [ rest-slice ] dip ] [ rest-slice ] if + intersect-live-ranges + ] if + ] + } cond ; + +: intersect-inactive ( new inactive -- n ) + relevant-ranges intersect-live-ranges ; : intersecting-inactive ( new -- live-intervals ) dup vreg>> inactive-intervals-for - [ tuck next-intersection ] with { } map>assoc ; + [ tuck intersect-inactive ] with { } map>assoc ; : fits-in-hole ( new pair -- ) first reuse-register ; : split-before-use ( new pair -- before after ) ! Find optimal split position + ! Insert move instruction second split-interval ; : assign-inactive-register ( new live-intervals -- ) diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index e4510e884e..ccfc4a1ff7 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1314,4 +1314,64 @@ USING: math.private compiler.cfg.debugger ; } } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan) instructions>> first live-spill-slots>> empty? +] unit-test + +[ f ] [ + T{ live-range f 0 10 } + T{ live-range f 20 30 } + intersect-live-range +] unit-test + +[ 10 ] [ + T{ live-range f 0 10 } + T{ live-range f 10 30 } + intersect-live-range +] unit-test + +[ 5 ] [ + T{ live-range f 0 10 } + T{ live-range f 5 30 } + intersect-live-range +] unit-test + +[ 5 ] [ + T{ live-range f 5 30 } + T{ live-range f 0 10 } + intersect-live-range +] unit-test + +[ 5 ] [ + T{ live-range f 5 10 } + T{ live-range f 0 15 } + intersect-live-range +] unit-test + +[ 50 ] [ + { + T{ live-range f 0 10 } + T{ live-range f 20 30 } + T{ live-range f 40 50 } + } + { + T{ live-range f 11 15 } + T{ live-range f 31 35 } + T{ live-range f 50 55 } + } + intersect-live-ranges +] unit-test + +[ 5 ] [ + T{ live-interval + { start 0 } + { end 10 } + { uses { 0 10 } } + { ranges V{ T{ live-range f 0 10 } } } + } + T{ live-interval + { start 5 } + { end 10 } + { uses { 5 10 } } + { ranges V{ T{ live-range f 5 10 } } } + } + intersect-inactive ] unit-test \ No newline at end of file From 360453568779ee07ed6d533a95cd8b89c1e1b202 Mon Sep 17 00:00:00 2001 From: Philipp Winkler Date: Sat, 6 Jun 2009 20:49:44 -0700 Subject: [PATCH 7/7] Fix a error parsing out nested arrays. --- basis/json/reader/reader-tests.factor | 1 + basis/json/reader/reader.factor | 10 ++++++++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/basis/json/reader/reader-tests.factor b/basis/json/reader/reader-tests.factor index fa6c8d7d3a..14a54b89c0 100644 --- a/basis/json/reader/reader-tests.factor +++ b/basis/json/reader/reader-tests.factor @@ -33,6 +33,7 @@ IN: json.reader.tests { 8 9 10 12 13 34 47 92 } >string 1array [ <" "\b\t\n\f\r\"\/\\" "> json> ] unit-test { HEX: abcd } >string 1array [ <" "\uaBCd" "> json> ] unit-test +{ H{ { "a" { } } { "b" 123 } } } [ "{\"a\":[],\"b\":123}" json> ] unit-test { { } } [ "[]" json> ] unit-test { { 1 "two" 3.0 } } [ <" [1, "two", 3.0] "> json> ] unit-test { H{ } } [ "{}" json> ] unit-test diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 1544af55cf..9886e316d7 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs combinators io io.streams.string json -kernel math math.parser math.parser.private sequences strings ; +kernel math math.parser math.parser.private prettyprint +sequences strings vectors ; IN: json.reader array over push ; + : (close-hash) ( accum -- accum' ) dup length 3 >= [ v-over-push ] when dup dup [ pop ] dip pop swap zip H{ } assoc-clone-like over push ; : scan ( accum char -- accum ) + ! 2dup . . ! Great for debug... [ { { CHAR: \" [ j-string over push ] } { CHAR: [ [ V{ } clone over push ] } { CHAR: , [ v-over-push ] } - { CHAR: ] [ v-over-push dup pop >array over push ] } + { CHAR: ] [ (close-array) ] } { CHAR: { [ 2 [ V{ } clone over push ] times ] } { CHAR: : [ v-pick-push ] } { CHAR: } [ (close-hash) ] }