Supports dotted pair notation
parent
189b54998d
commit
a38b3dfd83
|
@ -105,4 +105,23 @@ M: list >list ;
|
|||
|
||||
M: sequence >list sequence>list ;
|
||||
|
||||
SYNTAX: L{ \ } [ sequence>list ] parse-literal ;
|
||||
: items>list ( seq -- cons-pair )
|
||||
dup empty? [ drop +nil+ ] [
|
||||
reverse unclip swap [ swap cons ] each
|
||||
] if ;
|
||||
|
||||
:: (parse-list-literal) ( accum right-of-dot? -- accum )
|
||||
accum scan-token {
|
||||
{ "}" [ +nil+ , ] }
|
||||
{ "rest:" [ t (parse-list-literal) ] }
|
||||
[
|
||||
parse-datum dup parsing-word? [
|
||||
V{ } clone swap execute-parsing first
|
||||
] when
|
||||
, right-of-dot? [ "}" expect ] [ f (parse-list-literal) ] if ]
|
||||
} case ;
|
||||
|
||||
: parse-list-literal ( accum -- accum object )
|
||||
[ f (parse-list-literal) ] { } make items>list ;
|
||||
|
||||
SYNTAX: L{ parse-list-literal suffix! ;
|
||||
|
|
|
@ -277,7 +277,12 @@ M: cons-state pprint*
|
|||
'[ dup cons-state? _ length _ < and ]
|
||||
[ uncons swap , ] while
|
||||
] { } make
|
||||
[ pprint* ] each nil? [ "~more~" text ] unless
|
||||
[ pprint* ] each
|
||||
dup list? [
|
||||
nil? [ "~more~" text ] unless
|
||||
] [
|
||||
"." text pprint*
|
||||
] if
|
||||
block>
|
||||
] dip pprint-word block>
|
||||
] check-recursion ;
|
||||
|
|
Loading…
Reference in New Issue