Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

addenda.eval: generic eval-using, introduce eval-literal and ?eval-li…

…teral (for syntax tests)
  • Loading branch information...
commit 7cf22bf89573382b610ff78139064a9b368d8809 1 parent 5a15c8d
@k7f authored
View
21 work/addenda/eval/eval.factor
@@ -1,8 +1,23 @@
! Copyright (C) 2012 krzYszcz.
! See http://factorcode.org/license.txt for BSD license.
-USING: eval sequences ;
+USING: eval io.streams.string kernel prettyprint sequences ;
IN: addenda.eval
-: eval-using ( token vocabs -- obj )
- " " join "USING: " " ; " surround prepend ( -- obj ) eval ;
+: eval-using ( str vocabs effect -- )
+ [ " " join "USING: " " ; " surround prepend ] dip eval ; inline
+
+: eval-literal ( str vocabs -- obj )
+ ( -- obj ) eval-using ;
+
+: (over-parse-literal) ( str vocabs -- obj str' )
+ eval-literal [ [ pprint ] with-string-writer ] keep swap ; inline
+
+: over-parse-literal ( str vocabs -- obj obj' )
+ 2dup [ (over-parse-literal) ] 2dip
+ swap pick = [ 2drop dup ] [ eval-literal ] if ;
+
+: ?eval-literal ( str vocabs -- obj ? )
+ over-parse-literal 2dup eq? [ drop t ] [
+ 2dup = [ drop f ] unless
+ ] if ;
View
5 work/addenda/prettyprint/prettyprint.factor
@@ -50,11 +50,10 @@ M: tuple deep-pprint* deep-pprint-tuple ;
: .tuple ( tuple -- ) [ deep-pprint-tuple ] with-pprint nl ;
: unparse-tuple ( tuple -- string )
- [ .tuple ] with-string-writer
+ [ [ deep-pprint-tuple ] with-pprint ] with-string-writer
dup length <vector> [
dup CHAR: \n = [ drop CHAR: space ] when
dup CHAR: space = [
over ?last CHAR: space = [ drop ] [ suffix! ] if
] [ suffix! ] if
- ] reduce
- dup last CHAR: space = [ but-last-slice ] when >string ;
+ ] reduce >string ;
View
24 work/om/rhythm/rhythm-tests.factor
@@ -11,27 +11,25 @@ IN: om.rhythm.tests
{< {< >} >} unparse-tuple
] unit-test
-: (reparse-literal) ( token vocabs -- obj token' )
- eval-using [ [ pprint ] with-string-writer ] keep swap ; inline
-
-: reparse-literal ( token vocabs -- obj ? )
- over [ (reparse-literal) ] dip = ;
-
[
- { { {< >} t } { {< >} f } { {< >} f }
+ { { {< >} t } { {< >} {< >} } { {< >} {< >} }
{ {< -2 >} t } { {< 1 >} t } { {< 2 >} t } { {< 3//4 >} t }
- { {< >} f } { {< 2 >< >} t } { {< 3//4 >} f }
- { {< >} f } { {< -2 >} f } { {< 1 >} f } { {< 2 >} f }
- { {< {< >} >} t }
+ { {< >} {< >} } { {< 2 >< >} t } { {< 3//4 >} {< 3//4 >} }
+ { {< >} {< >} } { {< -2 >} {< -2 >} }
+ { {< 1 >} {< 1 >} } { {< 2 >} {< 2 >} }
+ { {< {< >} >} t } { {< {< >} >} {< {< >} >} }
+ { {< >} {< >} } { {< -2 >} {< -2 >} } { {< {< >} >} {< {< >} >} }
}
] [
{ "{< >}" "{< >< >}" "{< -1 >}"
"{< -2 >}" "{< 1 >}" "{< 2 >}" "{< 3//4 >}"
"{< 1 >< >}" "{< 2 >< >}" "{< 3//4 >< >}"
- "{< >< -1 >}" "{< >< -2 >}" "{< >< 1 >}" "{< >< 2 >}"
- "{< {< >} >}"
+ "{< >< -1 >}" "{< >< -2 >}"
+ "{< >< 1 >}" "{< >< 2 >}"
+ "{< {< >} >}" "{< >< {< >} >}"
+ "{< 1 >< -1 >}" "{< 1 >< -2 >}" "{< 1 >< {< >} >}"
}
- [ { "om.rhythm" } reparse-literal 2array ] map
+ [ { "om.rhythm" } ?eval-literal 2array ] map
] unit-test
[ {< 1/4 1/4 1/4 1/4 >} 1 ] [
Please sign in to comment.
Something went wrong with that request. Please try again.