Keeping quotations as tuple members in Factor - factor-lang

I want to keep a quotation as a member of a tuple in Factor. But when I try to execute 'call' on it I get the error 'cannot apply call to a run-time computed value'. Note that marking the functions as 'inline' does nothing.
Sample code:
USING: accessors kernel ;
IN: stackoverflow
TUPLE: quottuple quot ;
C: <quottuple> quottuple
: call-quot ( quottuple -- result )
quot>> call ; inline
: main ( -- )
[ 1 ] <quottuple>
call-quot drop ;
MAIN: main

The answer is the 'call(' word. That word requires you to specify the stack effect of the quotation, but as a result the quotation doesn't need to be known at compile time.
USING: accessors kernel ;
IN: stackoverflow
TUPLE: quottuple quot ;
C: <quottuple> quottuple
: call-quot ( quottuple -- result )
quot>> call( -- result ) ;
: main ( -- )
[ 1 ] <quottuple>
call-quot drop ;
MAIN: main

Related

limit SHACL class to one of the specific types and nothing else

Suppose I have data like:
<http://domain/mySubj> abc:someProperty <http://domain/myObj>.
<http://domain/myObj> a <http://domain/Type1>.
<http://domain/myObj> a <http://domain/Type2>.
<http://domain/myObj> a <http://domain/WrongType>.
I want to write a SHACL rule that raise a violation if myObj has any type other that Type1 and Type2.
I have tried to write it like
sh:property [
a sh:PropertyShape ;
sh:path abc:someProperty ;
sh:or (
[ sh:class <http://domain/Type1> ; ]
[ sh:class <http://domain/Type2> ; ]
) ;
...
But this will not raise a violation since sh:or will pass as soon as one of the tests are correct. I can't also use sh:xone since this will need only one of Type1 and Type2 and not both, to be present. Even if I try to say sh:or([sh:xone (type1 type2)] [sh:and (type1 type2)]) my test will not produce the correct result since the and test will pass because we have type1 and type2 present and don't care about the Wrongtype.
Is there a way that I can say the class should be one or more things from a specific set of things and not anything else.
If this is about direct rdf:types only, I believe you can solve this using sh:in on the rdf:type of the values:
sh:property [
a sh:PropertyShape ;
sh:path abc:someProperty ;
sh:property [
sh:path rdf:type ;
sh:in ( abc:Type1 abc:Type2 ) ;
] ;
]

Netlogo How to avoid NOBODY Runtime error?

How can I avoid NOBODY Runtime error? The following is sample code. This is a code that can be used for zero division error avoidance. Therefore, I know that it can not be used to avoid NOBODY error. But I can not find any other way. The following is a Runtime error message-> "IFELSE-VALUE expected input to be a TRUE / FALSE but got NOBODY instead." I appreciate your advice.
set top ifelse-value (nobody)
[ 0 ][ top ]
set ts turtles with [speed = 0 and not right-end]
set top max-one-of turtles [who]
set topx [xcor] of top ; A NOBODY error appears in "of" of this code
set L count ts with [xcor > topx]
The input of ifelse-value needs to be a reporter the returns either true or false (full details here. So, if you use nobody as the input, Netlogo does not evaluate whether or not the input is nobody or not, it just reads nobody- in other words your input is not returning either true or false.
For input, then, you need to instead use a boolean variable (one that is either true or false), a to-report that returns true or false, an expression that Netlogo can evaluate, etc. Consider the following examples:
to go
let x true
set top ifelse-value ( x )
["x is true"]
["x is NOT true"]
print ( word "Example 1: " top )
set top ifelse-value ( this-is-true )
["Reporter returned true"]
["Reporter did not return true"]
print ( word "Example 2: " top )
set x nobody
set top ifelse-value ( x = nobody )
["x IS nobody"]
["Is NOT nobody"]
print ( word "Example 3: " top )
set x 0
set top ifelse-value ( x = nobody )
["x IS nobody"]
["x Is NOT nobody"]
print ( word "Example 4: " top )
set top ifelse-value ( nobody = nobody )
["nobody = nobody"]
["nobody != nobody"]
print ( word "Example 5: " top )
end
to-report this-is-true
report true
end

Debugging Forth using a Test Harness

I would like to use a simple test harness to test my code during debugging using the same methodology as the Forth test harness developed by John Hayes.
The concept is to define a function, say my+ and then to define simple code snippets that will test the code when Tdebug is on.
Tdebug if T{ 1 1 my+ -> 2 }T else
Is it really as simple as including tester.f and changing {> to T{ and } to }T?
I plan to omit tester.f in the production release if size is an issue.
Edit:
debug if ... then does not work because it is outside compile...
Now I need help!
If debug is true tester.f works well.
If debug is false t{ and }t must work like ( ... ) comments. How do I code this?
0 constant debug
: t{
debug if
( as defined in tester.fr )
else
( what goes here? )
then
;
: }t
debug if
( as defined in tester.fr )
else
( and what goes here? )
then
;
The only way is to parse the input source stream up to }t. If t{ can be nested, it becomes a little trickier — see the reference implementation of [ELSE] word.
For reference, the production-mode definition of t{ word for simple (not nested) case in standard Forth:
: t{ ( "ccc }t" -- ) \ skip up to '}t'
begin
begin parse-name dup while S" }t" compare 0= until exit then 2drop
refill 0=
until
;
Although, I suggest to place tests into separate files and make conditional inclusion of such files ("spec" files). In such case you don't need to have another (production-mode) definition of t{ word at all.
I eventually did something similar to #ruvim by including tester.f when in debug mode and including notester.f when in production as follows:
\ notester.fs
( include either tester.fs or notester.fs )
\ adapted from longcomment.txt
false variable verbose
: t{ ( -- ) \ Long comment
begin
token \ Get next token
dup 0= if 2drop cr query token then \ If length of token is zero, end of
\ line is reached.
\ Fetch new line. Fetch new token.
s" }t" compare \ Search for }t
until
immediate 0-foldable
;
: testing ( -- ) \ Talking comment.
source verbose #
if dup >r type cr r> >in !
else >in ! drop [char] * emit
then
;
t{ 1 1 + -> 2 }t \ Usage sample
I find that having the tests as usage comments in the production file assists clarity.

Stretching words and quotation scoping

To play at Stretch the word, I've defined the following words, to try to work at the problem via the same method as this answer:
USING: kernel math sequences sequences.repeating ;
IN: stretch-words
! "bonobo" -> { "b" "bo" "bon" "bono" "bonob" "bonobo" }
: ascend-string ( string -- ascending-seqs )
dup length 1 + iota [ 0 swap pick subseq ] map
[ "" = not ] filter nip ;
! expected: "bonobo" -> "bonoobbooo"
! actual: "bonobo" -> "bbbooonnnooobbbooo"
: stretch-word ( string -- stretched )
dup ascend-string swap zip
[
dup first swap last
[ = ] curry [ dup ] dip count
repeat
] map last ;
stretch-word is supposed to repeat a character in a string by the number of times it's appeared up to that position in the string. However, my implementation is repeating all instances of the 1string it gets.
I have the feeling this is easily implementable in Factor, but I can't quite figure it out. How do I make this do what I want?
Hm... not a great golf, but it works...
First, I made a minor change to ascend-string so it leaves the string on the stack:
: ascend-string ( string -- string ascending-seqs )
dup length 1 + iota [ 0 swap pick subseq ] map
[ "" = not ] filter ;
So stretch-word can work like this:
: stretch-word ( string -- stretched )
ascend-string zip ! just zip them in the same order
[
first2 over ! first2 is the only golf I could make :/
[ = ] curry count ! same thing
swap <array> >string ! make an array of char size count and make it a string
] map concat ; ! so you have to join the pieces
Edit:
I think the problem was using repeat to do the job.
: ascend-string ( string -- seqs )
"" [ suffix ] { } accumulate*-as ;
: counts ( string -- counts )
dup ascend-string [ indices length ] { } 2map-as ;
: stretch-word ( string -- stretched )
[ counts ] keep [ <string> ] { } 2map-as concat ;
"bonobo" stretch-word print
bonoobbooo
indices length could also be [ = ] with count

How to refactor code using partial application of quotations?

How can I use existing combinators to refactor this code so that regex will become argument to be partially applied and resulting quotation will have same identical stack effects as ls (x -- )?
USING: io.directories locals sequences accessors math
prettyprint kernel io.files.info io.directories.hierarchy
combinators.short-circuit regexp
;
IN: flac
:: job ( step path -- )
path
[ [ step call ] each ]
with-directory-entries
; inline
:: lsc ( x c -- ) x c call [ x . ] when ; inline
:: ls ( x -- )
x
[ {
[ directory? ]
[ name>> directory-tree-files
[ ".*[.]flac" <regexp> matches? ]
filter length 0 =
]
}
1&&
]
lsc
;
First of all, in the original code, it looks like x is a directory-entry. If x is required to stay as a directory-entry, then it is impossible to refactor out the regex as an argument, after all there's nowhere to put it! If x is allowed to change to, say a string with the regex embedded, or a collection or object, you can then make the regex part of the single argument -- x.
The following solution assumes x can be changed into a tuple object with "dir-entry" and "regex" as slots:
:: ls ( x -- )
x
[ dir-entry>> directory? ].
[
dir-entry>> name>> directory-tree-files
[ [ x regex>> <regexp> matches? ] any? ] [ drop x dir-entry>> ] when .
] smart-when* ;

Resources