Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
216 lines (196 sloc) 5.52 KB
Topaz [
Title: "Topaz action helpers"
Author: "Gabriele Santilli"
Copyright: 2011
Type: Fake-Topaz
; License: {
; Permission is hereby granted, free of charge, to any person obtaining
; a copy of this software and associated documentation files
; (the "Software"), to deal in the Software without restriction, including
; without limitation the rights to use, copy, modify, merge, publish,
; distribute, sublicense, and/or sell copies of the Software, and to
; permit persons to whom the Software is furnished to do so, subject
; to the following conditions:
; The above copyright notice and this permission notice shall be included
; in all copies or substantial portions of the Software.
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
; OTHER DEALINGS IN THE SOFTWARE.
; }
]
; ===== ACTION HELPERS ========================================================
make: function [
"Make a Topaz type according to spec"
type [datatype!]
spec
] [] [
apply type/make [spec]
]
insert: function [
"Insert a value at the current position of the series"
series [series!]
value
options:
only: no [logic!] "Insert series as a single value"
new-line: no [logic!] "Temporary - add new line before value on MOLD"
] [] [
apply series/type/insert [series value only new-line]
]
head: function [
"Return the series at the head position"
series [series!]
] [] [
apply series/type/head [series]
]
tail: function [
"Return the series at the tail position"
series [series!]
] [] [
apply series/type/tail [series]
]
pick: function [
"Pick value in a series"
series [series!]
index [number!]
] [] [
apply series/type/pick [series index]
]
length-of: function [
"Return the length of a series"
series [series!]
] [] [
apply series/type/length-of [series]
]
empty?: function [
"True if the series is empty"
series [series!]
] [] [
0 = length-of series
]
skip: function [
"Return the series at a new position"
series [series!]
amount [number!] "Skip the specified number of values"
] [] [
apply series/type/skip [series amount]
]
mold: function [
"Return a LOAD-able text representation of a value"
value
options:
only: no [logic!] "Don't generate outer [ ] for block! values"
flat: no [logic!] "Produce a single text line"
limit [number! none!] "Don't return a string longer than LIMIT characters"
indent: "" [string!] "Add this string after each new line (ignored if flat)"
] [] [
apply value/type/mold [value only flat limit indent]
]
first: function [series] [] [
pick series 0
]
second: function [series] [] [
pick series 1
]
next: function [series] [] [
skip series 1
]
do-step: function [
"Evaluate one value"
value
block [block! paren!]
] [result arg2 op err] [
try [
set [result block] apply value/type/do [value block]
] 'e [
e: handle-js-error e
if e/type/name = "error!" [
insert/only tail e/stack block
]
throw e
]
while [op: operator? block] [
block: skip block 1
if empty? block [
err: make error! make-struct [
category: "Script"
id: "missing-argument"
message: "Operator missing its second argument"
]
insert/only tail err/stack skip block -2
throw err
]
arg2: first block
set [arg2 block] apply arg2/type/do [arg2 block]
result: do-op op result arg2
]
reduce [result block]
]
get-path: function [
"Apply path selector to a value"
value
selector
] [] [
switch selector/type/name [
"paren!" [
selector: do selector
]
"get-word!" [
selector: get selector
]
]
apply value/type/get-path [value selector]
]
set-path: function [
"Set an element of a value according to path selector"
value
selector
set-to
] [] [
switch selector/type/name [
"paren!" [
selector: do selector
]
"get-word!" [
selector: get selector
]
]
apply value/type/set-path [value selector set-to]
]
bind: function [
"Bind words to a specified context"
words
context [context!]
options:
copy: no [logic!] "Bind a (deep) copy of WORDS"
new: no [logic!] "Add all words to CONTEXT"
] [] [
apply words/type/bind [words context :copy new]
]
equal?: function [
"Return TRUE if the two values are equal"
val1
val2
] [obj] [
either obj: val1/type/(val2/type/name) [
apply obj/equal? [val1 val2]
] [
apply val1/type/equal? [val1 val2]
]
]
probe: function [
"Print a text representation of a value; return the value"
value
options:
limit [number! none!] "Limit the length of the printed text"
indent: "" [string!] "Add this string after each new line"
] [] [
print mold/options [
value: value
limit: limit
indent: indent
]
]
You can’t perform that action at this time.