Laria Carolin Chabowski
0361000e7c
We'll soon need the full apfl_ctx, where we previously only needed the gc. apflc was the only place manually constructing a struct gc without an apfl_ctx, so lets change that.
432 lines
9.5 KiB
Text
432 lines
9.5 KiB
Text
{ C ->
|
|
if := C.if
|
|
== := C.==
|
|
> := C.>
|
|
< := C.<
|
|
>= := C.>=
|
|
<= := C.<=
|
|
+ := C.+
|
|
- := C.-
|
|
* := C.*
|
|
/ := C./
|
|
join := C.join
|
|
print := C.print
|
|
dump := C.dump
|
|
disasm := C.disasm
|
|
tostring := C.tostring
|
|
not := C.not
|
|
len := C.len
|
|
type := C.type
|
|
loop := C.loop
|
|
gc := C.gc
|
|
backtrace := C.backtrace
|
|
fopen := C.fopen
|
|
fread := C.fread
|
|
fwrite := C.fwrite
|
|
fclose := C.fclose
|
|
load-file := C.load-file
|
|
load-string := C.load-string
|
|
get-optional := C.get-optional
|
|
raise := C.raise
|
|
symbol := C.symbol
|
|
splice := C.splice
|
|
|
|
Some := (C.getsym-Some)
|
|
|
|
-named := { name f ->
|
|
C.set-func-name f name
|
|
}
|
|
|
|
while := { cond body ->
|
|
res := nil
|
|
loop {
|
|
if (cond) {
|
|
res = (body)
|
|
true
|
|
} {
|
|
false
|
|
}
|
|
}
|
|
res
|
|
}
|
|
|
|
for := {
|
|
end body ->
|
|
for 0 end body
|
|
start end body ->
|
|
if (> start end) {
|
|
for start -1 end body
|
|
} {
|
|
for start 1 end body
|
|
}
|
|
start step end body ->
|
|
end-not-reached := if (> step 0) {{ < start end }} {{ > start end }}
|
|
out := nil
|
|
while end-not-reached {
|
|
out = body start
|
|
start = + start step
|
|
}
|
|
out
|
|
}
|
|
|
|
& := { ~strings ->
|
|
join "" strings
|
|
}
|
|
|
|
partial := { f ~a1 ->
|
|
{ ~a2 ->
|
|
f ~a1 ~a2
|
|
}
|
|
}
|
|
|
|
compose := {
|
|
f -> f
|
|
f ~fs ->
|
|
fs-composed := compose ~fs
|
|
{ ~args ->
|
|
f (fs-composed ~args)
|
|
}
|
|
}
|
|
|
|
!= := -named '!= (compose not ==)
|
|
!> := -named '!> (compose not >)
|
|
!< := -named '!< (compose not <)
|
|
!>= := -named '!>= (compose not >=)
|
|
!<= := -named '!<= (compose not <=)
|
|
|
|
has := {
|
|
pred cmp y ->
|
|
{ x ->
|
|
cmp (pred x) y
|
|
}
|
|
pred y ->
|
|
has pred == y
|
|
}
|
|
|
|
identity := { x -> x }
|
|
|
|
is := -named 'is (partial has identity)
|
|
|
|
++ := { x -> + x 1 }
|
|
-- := { x -> - x 1 }
|
|
|
|
-raw-substring := C.substring
|
|
substr := {
|
|
start s ->
|
|
substr start (len s) s
|
|
start?(is < 0) newlen s ->
|
|
substr (+ start (len s)) newlen s
|
|
start newlen?(is < 0) s ->
|
|
substr start (+ newlen (- (len s) start)) s
|
|
start newlen s ->
|
|
-raw-substring s start newlen
|
|
}
|
|
|
|
-raw-stringsearch := C.stringsearch
|
|
strsearch := {
|
|
needle haystack ->
|
|
-raw-stringsearch haystack needle
|
|
needle start?(is < 0) haystack ->
|
|
strsearch needle (+ start (len s)) haystack
|
|
needle start haystack ->
|
|
off := (strsearch needle (substr start haystack))
|
|
if (== off nil) { nil } { + start off }
|
|
}
|
|
|
|
split := ({
|
|
split-aux := { maxlen-reached sep s ->
|
|
sep-len := len sep
|
|
parts := []
|
|
loop {
|
|
if (maxlen-reached (++ (len parts))) {
|
|
parts = [~parts s]
|
|
false
|
|
} {
|
|
off := strsearch sep s
|
|
if (== nil off) {
|
|
parts = [~parts s]
|
|
false
|
|
} {
|
|
parts = [~parts (substr 0 off s)]
|
|
s = substr (+ off sep-len) s
|
|
true
|
|
}
|
|
}
|
|
}
|
|
|
|
parts
|
|
}
|
|
|
|
split := {
|
|
sep s ->
|
|
split-aux {false} sep s
|
|
sep maxlen s ->
|
|
split-aux (is >= maxlen) sep s
|
|
}
|
|
})
|
|
|
|
keach := {
|
|
d?(has type 'dict) body ->
|
|
out := nil
|
|
C.iterate-dict d { k v ->
|
|
out = body k v
|
|
true
|
|
}
|
|
out
|
|
l?(has type 'list) body ->
|
|
out := nil
|
|
for (len l) { i ->
|
|
out = body i l@i
|
|
}
|
|
out
|
|
}
|
|
|
|
each := { container body ->
|
|
keach container { _ v ->
|
|
body v
|
|
}
|
|
}
|
|
|
|
andalso := {
|
|
f ->
|
|
(f)
|
|
f ~fs ->
|
|
result := (f)
|
|
if result { andalso ~fs } { result }
|
|
}
|
|
|
|
orelse := {
|
|
f ->
|
|
(f)
|
|
f ~fs ->
|
|
result := (f)
|
|
if result { result } { orelse ~fs }
|
|
}
|
|
|
|
ifind-first := { f l ->
|
|
out := nil
|
|
i := 0
|
|
n := len l
|
|
while {andalso {== out nil} {< i n}} {
|
|
{
|
|
Some:x ->
|
|
out = Some::x
|
|
nil ->
|
|
} (f i l@i)
|
|
|
|
i = ++ i
|
|
}
|
|
|
|
out
|
|
}
|
|
|
|
find-first := { f l ->
|
|
ifind-first { _ x -> f x } l
|
|
}
|
|
|
|
find-index := { pred l ->
|
|
ifind-first { i x ->
|
|
if (pred x) { Some::i } { nil }
|
|
}
|
|
}
|
|
|
|
unwrap-some := {
|
|
Some:x then _ -> then x
|
|
x _ else -> else x
|
|
x then -> unwrap-some x then identity
|
|
}
|
|
|
|
unwrap-nil := {
|
|
nil _ else -> (else)
|
|
x then _ -> then x
|
|
x then -> unwrap-nil x then {nil}
|
|
}
|
|
|
|
pipe := {
|
|
val -> val
|
|
val [f ~args] ~fs ->
|
|
pipe (f ~args val) ~fs
|
|
val f ~fs ->
|
|
pipe (f val) ~fs
|
|
}
|
|
|
|
has-key := { k container ->
|
|
{
|
|
Some: _ -> true
|
|
nil -> false
|
|
} (get-optional k container)
|
|
}
|
|
|
|
get-or-default := { k container default ->
|
|
{
|
|
Some:x -> x
|
|
nil -> def
|
|
} (get-optional k container)
|
|
}
|
|
|
|
run-file := { f ->
|
|
((load-file f))
|
|
}
|
|
|
|
tonumber := {
|
|
x ->
|
|
tonumber 10 x
|
|
10 x?(has type 'number) ->
|
|
x
|
|
base x ->
|
|
C.tonumber base (tostring x)
|
|
}
|
|
|
|
modules := ({
|
|
loaded-modules := [->]
|
|
searchers := []
|
|
|
|
ImportError := symbol 'ImportError
|
|
|
|
add-searcher := { s ->
|
|
searchers = [~searchers s]
|
|
}
|
|
|
|
add-searcher { m ->
|
|
unwrap-some (get-optional m loaded-modules) { mod ->
|
|
Some::{ Some::mod }
|
|
}
|
|
}
|
|
|
|
add-searcher { m ->
|
|
unwrap-some (C.cmod-searcher m) { loader ->
|
|
Some::{
|
|
Some::(loader)
|
|
}
|
|
}
|
|
}
|
|
|
|
import := { name ->
|
|
maybe-mod := find-first { s ->
|
|
unwrap-some (s name) { loader ->
|
|
loader name
|
|
}
|
|
} searchers
|
|
|
|
{
|
|
Some:mod ->
|
|
loaded-modules@name = mod
|
|
mod
|
|
nil ->
|
|
raise ImportError::(& "Module " name " not found")
|
|
} maybe-mod
|
|
}
|
|
|
|
add-preloaded-module := { name mod ->
|
|
loaded-modules@name = mod
|
|
}
|
|
|
|
modules := [
|
|
'import -> import
|
|
'add-searcher -> add-searcher
|
|
'add-preloaded-module -> add-preloaded-module
|
|
'ImportError -> ImportError
|
|
]
|
|
|
|
add-preloaded-module 'modules modules
|
|
|
|
modules
|
|
})
|
|
|
|
map := {
|
|
_ [] -> []
|
|
f [x ~xs] ->
|
|
[(f x) ~(map f xs)]
|
|
}
|
|
|
|
foldl := {
|
|
f [x ~xs] -> foldl f x xs
|
|
_ carry [] -> carry
|
|
f carry [x ~xs] -> foldl f (f x carry) xs
|
|
}
|
|
|
|
splice := {
|
|
a off -> splice a off nil
|
|
a off len -> splice a off len []
|
|
a a-off a-len b -> splice a a-off a-len b 0 nil
|
|
a a-off a-len b b-off -> splice a a-off a-len b b-off nil
|
|
a a-off a-len b b-off b-len ->
|
|
C.splice a a-off a-len b b-off b-len
|
|
}
|
|
|
|
slice := {
|
|
off l -> slice off nil l
|
|
off len l -> splice [] 0 nil l off len
|
|
}
|
|
|
|
# Dictionary of exported functions
|
|
[
|
|
'if -> if
|
|
'== -> ==
|
|
'> -> >
|
|
'< -> <
|
|
'>= -> >=
|
|
'<= -> <=
|
|
'+ -> +
|
|
'- -> -
|
|
'* -> *
|
|
'/ -> /
|
|
'join -> join
|
|
'print -> print
|
|
'dump -> dump
|
|
'disasm -> disasm
|
|
'tostring -> tostring
|
|
'tonumber -> tonumber
|
|
'not -> not
|
|
'len -> len
|
|
'type -> type
|
|
'loop -> loop
|
|
'while -> while
|
|
'for -> for
|
|
'gc -> gc
|
|
'backtrace -> backtrace
|
|
'fopen -> fopen
|
|
'fread -> fread
|
|
'fwrite -> fwrite
|
|
'fclose -> fclose
|
|
'load-file -> load-file
|
|
'load-string -> load-string
|
|
'run-file -> run-file
|
|
'& -> &
|
|
'substr -> substr
|
|
'strsearch -> strsearch
|
|
'split -> split
|
|
'partial -> partial
|
|
'compose -> compose
|
|
'has -> has
|
|
'identity -> identity
|
|
'is -> is
|
|
'!= -> !=
|
|
'!> -> !>
|
|
'!< -> !<
|
|
'!>= -> !>=
|
|
'!<= -> !<=
|
|
'++ -> ++
|
|
'-- -> --
|
|
'keach -> keach
|
|
'each -> each
|
|
'get-optional -> get-optional
|
|
'raise -> raise
|
|
'has-key -> has-key
|
|
'symbol -> symbol
|
|
'Some -> Some
|
|
'get-argv -> C.get-argv
|
|
'andalso -> andalso
|
|
'orelse -> orelse
|
|
'find-first -> find-first
|
|
'find-index -> find-index
|
|
'unwrap-some -> unwrap-some
|
|
'unwrap-nil -> unwrap-nil
|
|
'import -> modules.import
|
|
'map -> map
|
|
'splice -> splice
|
|
'slice -> slice
|
|
'pipe -> pipe
|
|
'foldl -> foldl
|
|
]
|
|
}
|