551 lines
12 KiB
Text
551 lines
12 KiB
Text
|
|
def null
|
|
func =null { | pop
|
|
"`null` must not be assigned a value!" panic
|
|
}
|
|
|
|
def program-name
|
|
|
|
def print'pre-std &print =print'pre-std
|
|
func print { |
|
|
_str print'pre-std call
|
|
}
|
|
|
|
func println { |
|
|
print "\n" print
|
|
}
|
|
|
|
construct error {
|
|
kind
|
|
message
|
|
object
|
|
trace
|
|
mr-trace
|
|
}
|
|
|
|
construct FrameInfo {
|
|
file
|
|
function
|
|
}
|
|
|
|
construct _str_ext {
|
|
;
|
|
new { any | with this ;
|
|
null clone this settype:construct
|
|
}
|
|
to-bytes { [int] | str-to-bytes }
|
|
split { str | with splitter this ;
|
|
def bytes splitter:to-bytes =bytes
|
|
def iter this:to-bytes:iter =iter
|
|
def item 0 =item
|
|
[ while { item null eq not } {
|
|
def match 0 =match
|
|
[
|
|
while { match bytes:len eq not } {
|
|
iter:next =item
|
|
item null eq if {
|
|
3 stop
|
|
}
|
|
item dup (match bytes:get) eq dup if {
|
|
match ++ =match
|
|
} not if {
|
|
0 =match
|
|
}
|
|
}
|
|
{ | pop pop } match:foreach
|
|
] _str
|
|
} ]
|
|
}
|
|
replace { str | with replacee replacement this ;
|
|
def bytes replacee:to-bytes =bytes
|
|
def iter this:to-bytes:iter =iter
|
|
def item 0 =item
|
|
[ while { item null eq not } {
|
|
def match 0 =match
|
|
while { match bytes:len eq not } {
|
|
iter:next =item
|
|
item null eq if {
|
|
3 stop
|
|
}
|
|
item dup (match bytes:get) eq dup if {
|
|
match ++ =match
|
|
} not if {
|
|
0 =match
|
|
}
|
|
}
|
|
{ | pop pop } match:foreach
|
|
match bytes:len eq if {
|
|
replacement _array :to-stack
|
|
}
|
|
} ] _str
|
|
}
|
|
starts-with { bool | with beginning this ;
|
|
beginning:to-bytes this:to-bytes:starts-with
|
|
}
|
|
_char { int | with this ;
|
|
0 (this _array):get
|
|
}
|
|
} include _str_ext in str
|
|
|
|
construct _mega-ext {
|
|
;
|
|
swap { .. | with this ;
|
|
this mswap
|
|
this -- mswap
|
|
}
|
|
mswap { .. | mswap }
|
|
foreach { | with callable this ;
|
|
def i 0 =i
|
|
while { i this lt } { i callable call i ++ =i }
|
|
}
|
|
} include _mega-ext in mega
|
|
|
|
construct _array-ext {
|
|
;
|
|
get { any | array-get }
|
|
sget { any|null | with idx this ;
|
|
idx this:len lt idx -1 gt and dup if {
|
|
pop
|
|
idx this:get
|
|
2 stop
|
|
} not if {
|
|
null
|
|
}
|
|
}
|
|
len { mega | array-len }
|
|
set { any | array-set }
|
|
to-stack { .. | with this ;
|
|
def len this:len =len
|
|
def i 0 =i
|
|
while { i len lt } {
|
|
i this:get
|
|
i ++ =i
|
|
}
|
|
}
|
|
foreach { | with callable this ;
|
|
def i 0 =i
|
|
while { i this:len lt } { i this:get callable call i ++ =i }
|
|
}
|
|
to-str { str | bytes-to-str }
|
|
sub { [any] | with begin end this ;
|
|
this (end begin - anew) begin 0 (end begin -) acopy
|
|
}
|
|
starts-with { bool | with beginning this ;
|
|
this:len beginning:len lt if {
|
|
0
|
|
2 stop
|
|
}
|
|
0 beginning:len this:sub beginning eq
|
|
}
|
|
last { | with this ;
|
|
this:len -- this:get
|
|
}
|
|
=last { | with this ;
|
|
this:len -- this:set
|
|
}
|
|
0 { any | with this ;
|
|
0 this:get
|
|
}
|
|
1 { any | with this ;
|
|
1 this:get
|
|
}
|
|
2 { any | with this ;
|
|
2 this:get
|
|
}
|
|
3 { any | with this ;
|
|
3 this:get
|
|
}
|
|
4 { any | with this ;
|
|
4 this:get
|
|
}
|
|
=0 { | with this ;
|
|
0 this:set;
|
|
}
|
|
=1 { | with this ;
|
|
1 this:set;
|
|
}
|
|
=2 { | with this ;
|
|
2 this:set;
|
|
}
|
|
=3 { | with this ;
|
|
3 this:set;
|
|
}
|
|
=4 { | with this ;
|
|
4 this:set;
|
|
}
|
|
} include _array-ext in array
|
|
|
|
construct _func-ext {
|
|
args
|
|
;
|
|
call { | with this ;
|
|
this:args null eq if {
|
|
0 anew this:=args
|
|
}
|
|
this:args:to-stack this call
|
|
}
|
|
add-args { this | with args this ;
|
|
this:args null eq if {
|
|
0 anew this:=args
|
|
}
|
|
[ this:args:to-stack args:to-stack ] this:=args
|
|
this
|
|
}
|
|
add-arg { this | with arg this ;
|
|
this:args null eq if {
|
|
0 anew this:=args
|
|
}
|
|
[ this:args:to-stack arg ] this:=args
|
|
this
|
|
}
|
|
} include _func-ext in func
|
|
|
|
"#iter.spl" import
|
|
|
|
construct List {
|
|
array
|
|
;
|
|
construct { this | with this ;
|
|
0 anew this:=array
|
|
this
|
|
}
|
|
from { this | with array this ;
|
|
array this:=array
|
|
this
|
|
}
|
|
foreach { | :array:foreach }
|
|
get { any | :array:get }
|
|
sget { any|null | :array:sget }
|
|
len { mega | :array:len }
|
|
set { any | :array:set }
|
|
to-stack { .. | :array:to-stack }
|
|
to-str { str | :array:to-str }
|
|
sub { [any] | :array:sub }
|
|
}
|
|
construct _GrowingArray {
|
|
;
|
|
push-front { | with item this ;
|
|
[ item this:array:to-stack ] this:=array
|
|
}
|
|
push { | with item this ;
|
|
[ this:array:to-stack item ] this:=array
|
|
}
|
|
insert { | with item index this ;
|
|
this:array:len index - =index
|
|
[ this:array:to-stack index:mswap item (index ++):mswap ] this:=array
|
|
}
|
|
}
|
|
construct _ShrinkingArray {
|
|
;
|
|
pop-front { any | with this ;
|
|
0 this:remove
|
|
}
|
|
pop { any | with this ;
|
|
this:array:len not if {
|
|
null 2 stop
|
|
}
|
|
def item
|
|
[ this:array:to-stack =item ] this:=array
|
|
item
|
|
}
|
|
remove { any | with index this ;
|
|
this:array:len not if {
|
|
null 2 stop
|
|
}
|
|
def item
|
|
this:array:len index - =index
|
|
[ this:array:to-stack index:mswap =item (index --):mswap ] this:=array
|
|
item
|
|
}
|
|
}
|
|
|
|
include _GrowingArray in List
|
|
include _ShrinkingArray in List
|
|
|
|
construct ArrayIter {
|
|
array
|
|
idx
|
|
;
|
|
construct { this | with array this ;
|
|
array this:=array
|
|
0 this:=idx
|
|
this
|
|
}
|
|
next { any | with this ;
|
|
this:idx dup ++ this:=idx this:array:sget
|
|
}
|
|
}
|
|
construct _IterableArray {
|
|
;
|
|
iter { ArrayIter | with this ;
|
|
this gettype "array" eq dup if {
|
|
pop
|
|
this ArrayIter:new
|
|
2 stop
|
|
} not if {
|
|
this:array ArrayIter:new
|
|
}
|
|
}
|
|
}
|
|
include _Iter in ArrayIter
|
|
include _IterableArray in List
|
|
include _IterableArray in array
|
|
|
|
construct MicroMap {
|
|
pairs
|
|
;
|
|
construct { this | with this ;
|
|
List:new this:=pairs
|
|
this
|
|
}
|
|
from { this | with pairs this ;
|
|
pairs this:=pairs
|
|
this
|
|
}
|
|
get-entry { [any,any]|null | with key this ;
|
|
this:pairs:iter
|
|
{ mega | 0 swap:get key eq } swap:filter
|
|
:next
|
|
}
|
|
get-or-create-entry { [any,any] | with key this ;
|
|
{ [any,any] |
|
|
[ key null ] dup this:pairs:push
|
|
} key this:get-entry:unwrap-or
|
|
}
|
|
get { any | with key this ;
|
|
this:pairs:iter
|
|
{ mega | 0 swap:get key eq } swap:filter
|
|
{ any | 1 swap:get } swap:map
|
|
:next
|
|
}
|
|
set { any | with key val this ;
|
|
val 1 (key this:get-or-create-entry):set
|
|
}
|
|
remove { any | with key this ;
|
|
this:pairs:iter
|
|
{ mega | 0 swap:get key eq not } swap:filter
|
|
:collect
|
|
List:new:from
|
|
=pairs
|
|
}
|
|
iter { ArrayIter | with this ;
|
|
this:pairs:iter
|
|
}
|
|
foreach { | with callable this ;
|
|
callable this:pairs:foreach
|
|
}
|
|
}
|
|
|
|
construct Range {
|
|
lower
|
|
upper
|
|
step
|
|
;
|
|
construct { this | with lower upper this ;
|
|
lower _mega this:=lower
|
|
upper _mega this:=upper
|
|
1 this:=step
|
|
this
|
|
}
|
|
set-step { this | with step this ;
|
|
step this:=step
|
|
this
|
|
}
|
|
iter { RangeIter | with this ;
|
|
this RangeIter:new
|
|
}
|
|
item { mega|null | with index this ;
|
|
def itm index this:step * this:lower + =itm
|
|
(itm this:upper lt) (itm this:lower lt not) and dup if {
|
|
pop
|
|
itm
|
|
2 stop
|
|
} not if {
|
|
null
|
|
2 stop
|
|
}
|
|
}
|
|
}
|
|
|
|
construct RangeIter {
|
|
range
|
|
idx
|
|
;
|
|
construct { this | with range this ;
|
|
range this:=range
|
|
0 this:=idx
|
|
this
|
|
}
|
|
next { mega | with this ;
|
|
this:idx dup ++ this:=idx this:range:item
|
|
}
|
|
}
|
|
|
|
include _Iter in RangeIter
|
|
|
|
construct shadow { }
|
|
|
|
func aadd { array | with arr1 arr2 ;
|
|
|
|
def newarr arr1:len arr2:len + anew =newarr
|
|
|
|
arr1 newarr 0 0 arr1:len acopy;
|
|
arr2 newarr 0 arr1:len arr2:len acopy;
|
|
|
|
newarr
|
|
}
|
|
|
|
func concat { str | with a b ;
|
|
a _array b _array aadd _str
|
|
}
|
|
|
|
func nconcat { str | with amt ;
|
|
_array
|
|
(amt 1 -):foreach<{ | pop
|
|
swap _array swap aadd
|
|
}>
|
|
_str
|
|
}
|
|
|
|
def cached-results MicroMap:new =cached-results
|
|
func cache { ... | with arg-amt id body ;
|
|
def args arg-amt anew =args
|
|
def i arg-amt -- =i
|
|
while { i 0 lt not } {
|
|
"from stack"; i args:set;
|
|
i -- =i
|
|
}
|
|
def result [ args id ] cached-results:get =result
|
|
result null eq if {
|
|
args:to-stack body call dup =result [ args id ] swap cached-results:set;
|
|
}
|
|
result
|
|
}
|
|
|
|
def do-not-dump 0 =do-not-dump
|
|
func handle-panic { | with msg trace ;
|
|
program-name dup if {
|
|
program-name print " panicked at:" println
|
|
} not if {
|
|
"Program panicked at:" println
|
|
}
|
|
&println trace:foreach
|
|
"\nPanic message:" println
|
|
" " print msg println
|
|
def map env =map
|
|
"SPL_PANIC_DUMP" env:get dup if {
|
|
"Dumping because SPL_PANIC_DUMP is set." println
|
|
null =map
|
|
dyn-__dump
|
|
} not if {
|
|
do-not-dump if {
|
|
"Not dumping." println
|
|
2 stop
|
|
}
|
|
"SPL_PLAIN_PANIC" map:get dup if {
|
|
"Not dumping because SPL_PLAIN_PANIC is set." println
|
|
} not if {
|
|
"Type 'Yes^M' to dump. You can set SPL_PANIC_DUMP to always dump "
|
|
"on panic, or SPL_PLAIN_PANIC to never dump." concat println
|
|
readln "Yes" eq if {
|
|
null =map
|
|
dyn-__dump
|
|
}
|
|
}
|
|
}
|
|
"Exiting." println
|
|
1 exit
|
|
}
|
|
|
|
func panic { | trace handle-panic }
|
|
|
|
{ | with msg this ;
|
|
this not if {
|
|
"Assertion failed!" panic
|
|
}
|
|
} "assert" "int" dyn-def-method
|
|
|
|
{ | with msg this ;
|
|
this if {
|
|
"Assertion failed!" panic
|
|
}
|
|
} "nassert" "int" dyn-def-method
|
|
|
|
func assert-eq { any any | with a b ;
|
|
a b eq not if {
|
|
"Equality assertion failed!" panic
|
|
}
|
|
a b
|
|
}
|
|
|
|
func [ { shadow |
|
|
"array" "shadow" settype
|
|
}
|
|
|
|
func ] { array |
|
|
[ alit-end
|
|
}
|
|
|
|
func env { MicroMap |
|
|
get-env List:new:from MicroMap:new:from
|
|
}
|
|
|
|
func ++ { mega |
|
|
1 +
|
|
}
|
|
|
|
func -- { mega |
|
|
1 -
|
|
}
|
|
|
|
func times { | with amount callable ;
|
|
def i 0 =i
|
|
while { i amount lt } {
|
|
i callable call
|
|
i ++ =i
|
|
}
|
|
}
|
|
|
|
def _'has-been-called 0 =_'has-been-called
|
|
func _ { |
|
|
_'has-been-called not if {
|
|
"WARN: The _ function is deprecated!" println
|
|
1 =_'has-been-called
|
|
}
|
|
}
|
|
|
|
func call-main-on-file { | with file ;
|
|
catch {
|
|
"@" (0 (file _array):get 0 ("#" _array):get eq) if { pop "" } file concat
|
|
import
|
|
update-types
|
|
argv main exit
|
|
} { with err ;
|
|
err:message dup null eq if {
|
|
pop
|
|
"Uncaught error."
|
|
} err:trace handle-panic
|
|
}
|
|
}
|
|
|
|
func update-types { |
|
|
{ | with type ;
|
|
{ self | } "unwrap" type dyn-def-method
|
|
{ self | swap pop } "unwrap-or" type dyn-def-method
|
|
} dyn-all-types:foreach
|
|
{ | with this ;
|
|
"null cannot be unwrapped." panic
|
|
} "unwrap" "null" dyn-def-method
|
|
{ any | with fb this ;
|
|
fb call
|
|
} "unwrap-or" "null" dyn-def-method
|
|
}
|
|
update-types
|
|
|
|
"Adds a field to a namespace and initially sets it to the field's name.";
|
|
func register-field { | with field-name namespace-name namespace ;
|
|
field-name namespace-name dyn-def-field;
|
|
namespace namespace-name settype ("=" namespace-name concat) dyn-call
|
|
}
|
|
|