From e0b5ddb07c7eb84b256fe18c1878b71ad467e285 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 27 Jun 2016 20:45:34 -0700 Subject: [PATCH] modern.out: messing with arity. --- core/modern/out/out.factor | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/core/modern/out/out.factor b/core/modern/out/out.factor index a19a499bf4..2e7445d987 100644 --- a/core/modern/out/out.factor +++ b/core/modern/out/out.factor @@ -48,7 +48,6 @@ CONSTANT: janky-arities H{ `HOOK 3 } ; -DEFER: write-literal GENERIC: write-literal ( obj -- ) ; ! M: object write-literal lexed-underlying write ; M: string write-literal write ; @@ -234,22 +233,24 @@ M: compound-sequence-literal write-literal ] if ; inline recursive -GENERIC: split-arity ( obj -- seq ) ; +GENERIC: fixup-arity ( obj -- seq ) ; -M: uppercase-colon-literal split-arity - dup { [ uppercase-colon-literal? ] [ tag>> janky-arities at ] } 1&& [ - dup tag>> janky-arities at +ERROR: closing-tag-required2 obj ; +M: uppercase-colon-literal fixup-arity + dup tag>> janky-arities ?at [ $[ _ swap [ any-comment? not ] cut-nth-match swap ] change-payload swap 2array dup first f >>closing-tag drop ! dup first " ;" >>closing-tag drop - ] when ; + ] [ + drop + dup closing-tag>> [ closing-tag-required2 ] unless + ] if ; -M: less-than-literal split-arity - [ [ split-arity ] map ] change-payload ; - -M: object split-arity ; +M: less-than-literal fixup-arity + [ [ fixup-arity ] map ] change-payload ; +M: object fixup-arity ; : rewrite-path ( path quot -- ) ! dup print @@ -257,7 +258,7 @@ M: object split-arity ; [ path>literals [ _ map-literals ] map - [ split-arity ] map + [ fixup-arity ] map ] [ ] bi write-modern-path ] [ drop . ] recover ; inline @@ -265,7 +266,7 @@ M: object split-arity ; ! dup print [ string>literals ] dip $[ _ map-literals ] map ! colons - [ split-arity ] map + [ fixup-arity ] map write-modern-string ; inline : rewrite-paths ( seq quot -- ) $[ _ rewrite-path ] each ; inline