Skip to content

Instantly share code, notes, and snippets.

@nedzadarek
Created June 25, 2018 13:42
Show Gist options
  • Save nedzadarek/7de18b1a5a167f24e4f5d398d63f3efe to your computer and use it in GitHub Desktop.
Save nedzadarek/7de18b1a5a167f24e4f5d398d63f3efe to your computer and use it in GitHub Desktop.
Adds support for `op!`/`function!` based heavily on http://red.qyz.cz/dependent-types.html
Red [
info: {
Adds support for `op!`/`function!` based heavily on http://red.qyz.cz/dependent-types.html
}
]
my-assert: func [bl] [
unless true = do bl [cause-error 'user 'message ["Wrong assertion!!"]]
]
afunc: func [
"Make function with more checks"
spec [block!]
body [block!]
/local
word-rule type-rule
word desc type symbol val
fun-type
] [
; define some rules
word-rule: [
(type: desc: none)
; this is very simple func constructor,
; so it ignores lit-word! and get-word!
set word word!
]
type-rule: [
; type can end with ! but it's word! still
set type word!
any [
set symbol word!;['< | '> | '<= | '>=]
(
case [
op! = type? get symbol [fun-type: op!]
function! = type? get symbol [fun-type: function!]
true [cause-error 'user 'message ["The symbol is not op/function"]]
]
)
set val number!
(
case [
(function! = fun-type) [
insert/only body compose/deep [(symbol) (word) (val)]
insert body 'my-assert
]
(op! = fun-type) [
insert/only body compose/deep [(word) (symbol) (val)]
insert body 'my-assert
]
]
head body
)
]
]
local: make block! length? spec
parse spec [
some [
word-rule
any [
set desc string!
| opt into type-rule
]
(repend local [word reduce [type] desc])
]
]
remove-each word local [none? word]
; print "function spec/body: "
make function! copy/deep reduce [local body]
]
o: :<
op-assert: afunc [a [integer! o 4]] [a * 10]
?? op-assert
op-assert 2
op-assert 42
foo: func [a b] [a < b]
fun-assert: afunc [a [integer! foo 4]] [a * 10]
?? fun-assert
fun-assert 2
fun-assert 42
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment