giles
88c02c7c73
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
List: concat/flatten, init, find/find_opt, partition, mapi/iteri, assoc/assoc_opt. Option: iter/fold/to_list. Result: get_ok/get_error/ map_error/to_option. Fixed skip-to-boundary! in parser to track let..in / begin..end / struct..end / for/while..done nesting via a depth counter — without this, nested-let inside a top-level decl body trips over the decl-boundary detector. Stdlib functions like List.init / mapi / iteri use begin..end to make their nested-let intent explicit.
304 lines
7.6 KiB
Plaintext
304 lines
7.6 KiB
Plaintext
;; lib/ocaml/runtime.sx — minimal OCaml stdlib slice, written in OCaml.
|
|
;;
|
|
;; Defines List and Option modules with the most-used functions. Loaded
|
|
;; on demand via `(ocaml-load-stdlib! env)` from eval.sx, which parses
|
|
;; this source through `ocaml-parse-program` and evaluates each decl,
|
|
;; threading the env so stdlib bindings become available to user code.
|
|
;;
|
|
;; What's here is intentionally minimal — Phase 6 grows this into the
|
|
;; full ~150-function slice. Everything is defined in OCaml syntax (not
|
|
;; SX) on purpose, both as substrate validation and as documentation.
|
|
|
|
(define ocaml-stdlib-src
|
|
"module List = struct
|
|
let rec length lst =
|
|
match lst with
|
|
| [] -> 0
|
|
| _ :: t -> 1 + length t
|
|
|
|
let rec rev_append xs acc =
|
|
match xs with
|
|
| [] -> acc
|
|
| h :: t -> rev_append t (h :: acc)
|
|
|
|
let rev xs = rev_append xs []
|
|
|
|
let rec map f lst =
|
|
match lst with
|
|
| [] -> []
|
|
| h :: t -> f h :: map f t
|
|
|
|
let rec filter p lst =
|
|
match lst with
|
|
| [] -> []
|
|
| h :: t -> if p h then h :: filter p t else filter p t
|
|
|
|
let rec fold_left f init lst =
|
|
match lst with
|
|
| [] -> init
|
|
| h :: t -> fold_left f (f init h) t
|
|
|
|
let rec fold_right f lst init =
|
|
match lst with
|
|
| [] -> init
|
|
| h :: t -> f h (fold_right f t init)
|
|
|
|
let rec append xs ys =
|
|
match xs with
|
|
| [] -> ys
|
|
| h :: t -> h :: append t ys
|
|
|
|
let rec iter f lst =
|
|
match lst with
|
|
| [] -> ()
|
|
| h :: t -> f h; iter f t
|
|
|
|
let rec mem x lst =
|
|
match lst with
|
|
| [] -> false
|
|
| h :: t -> if h = x then true else mem x t
|
|
|
|
let rec for_all p lst =
|
|
match lst with
|
|
| [] -> true
|
|
| h :: t -> if p h then for_all p t else false
|
|
|
|
let rec exists p lst =
|
|
match lst with
|
|
| [] -> false
|
|
| h :: t -> if p h then true else exists p t
|
|
|
|
let hd lst =
|
|
match lst with
|
|
| [] -> failwith \"List.hd: empty\"
|
|
| h :: _ -> h
|
|
|
|
let tl lst =
|
|
match lst with
|
|
| [] -> failwith \"List.tl: empty\"
|
|
| _ :: t -> t
|
|
|
|
let rec nth lst n =
|
|
match lst with
|
|
| [] -> failwith \"List.nth: out of range\"
|
|
| h :: t -> if n = 0 then h else nth t (n - 1)
|
|
|
|
let rec concat lst =
|
|
match lst with
|
|
| [] -> []
|
|
| h :: t -> append h (concat t)
|
|
|
|
let flatten = concat
|
|
|
|
let rec init n f =
|
|
if n = 0 then [] else
|
|
begin
|
|
let rec build i =
|
|
if i = n then [] else f i :: build (i + 1)
|
|
in build 0
|
|
end
|
|
|
|
let rec find_opt p lst =
|
|
match lst with
|
|
| [] -> None
|
|
| h :: t -> if p h then Some h else find_opt p t
|
|
|
|
let rec find p lst =
|
|
match find_opt p lst with
|
|
| None -> failwith \"List.find: not found\"
|
|
| Some x -> x
|
|
|
|
let rec partition p lst =
|
|
match lst with
|
|
| [] -> ([], [])
|
|
| h :: t ->
|
|
(match partition p t with
|
|
| (yes, no) ->
|
|
if p h then (h :: yes, no) else (yes, h :: no))
|
|
|
|
let rec mapi f lst =
|
|
begin
|
|
let rec go i xs =
|
|
match xs with
|
|
| [] -> []
|
|
| h :: t -> f i h :: go (i + 1) t
|
|
in go 0 lst
|
|
end
|
|
|
|
let rec iteri f lst =
|
|
begin
|
|
let rec go i xs =
|
|
match xs with
|
|
| [] -> ()
|
|
| h :: t -> f i h; go (i + 1) t
|
|
in go 0 lst
|
|
end
|
|
|
|
let rec assoc k lst =
|
|
match lst with
|
|
| [] -> failwith \"List.assoc: not found\"
|
|
| (k2, v) :: t -> if k = k2 then v else assoc k t
|
|
|
|
let rec assoc_opt k lst =
|
|
match lst with
|
|
| [] -> None
|
|
| (k2, v) :: t -> if k = k2 then Some v else assoc_opt k t
|
|
end ;;
|
|
|
|
module Option = struct
|
|
let map f o =
|
|
match o with
|
|
| None -> None
|
|
| Some x -> Some (f x)
|
|
|
|
let bind o f =
|
|
match o with
|
|
| None -> None
|
|
| Some x -> f x
|
|
|
|
let value o default =
|
|
match o with
|
|
| None -> default
|
|
| Some x -> x
|
|
|
|
let get o =
|
|
match o with
|
|
| None -> failwith \"Option.get: None\"
|
|
| Some x -> x
|
|
|
|
let is_none o =
|
|
match o with
|
|
| None -> true
|
|
| Some _ -> false
|
|
|
|
let is_some o =
|
|
match o with
|
|
| None -> false
|
|
| Some _ -> true
|
|
|
|
let iter f o =
|
|
match o with
|
|
| None -> ()
|
|
| Some x -> f x
|
|
|
|
let fold none_v f o =
|
|
match o with
|
|
| None -> none_v
|
|
| Some x -> f x
|
|
|
|
let to_list o =
|
|
match o with
|
|
| None -> []
|
|
| Some x -> [x]
|
|
end ;;
|
|
|
|
module Result = struct
|
|
let map f r =
|
|
match r with
|
|
| Ok x -> Ok (f x)
|
|
| Error e -> Error e
|
|
|
|
let bind r f =
|
|
match r with
|
|
| Ok x -> f x
|
|
| Error e -> Error e
|
|
|
|
let is_ok r =
|
|
match r with
|
|
| Ok _ -> true
|
|
| Error _ -> false
|
|
|
|
let is_error r =
|
|
match r with
|
|
| Ok _ -> false
|
|
| Error _ -> true
|
|
|
|
let get_ok r =
|
|
match r with
|
|
| Ok x -> x
|
|
| Error _ -> failwith \"Result.get_ok: Error\"
|
|
|
|
let get_error r =
|
|
match r with
|
|
| Ok _ -> failwith \"Result.get_error: Ok\"
|
|
| Error e -> e
|
|
|
|
let map_error f r =
|
|
match r with
|
|
| Ok x -> Ok x
|
|
| Error e -> Error (f e)
|
|
|
|
let to_option r =
|
|
match r with
|
|
| Ok x -> Some x
|
|
| Error _ -> None
|
|
end ;;
|
|
|
|
module String = struct
|
|
let length s = _string_length s
|
|
let get s i = _string_get s i
|
|
let sub s i n = _string_sub s i n
|
|
let concat sep xs = _string_concat sep xs
|
|
let uppercase_ascii s = _string_upper s
|
|
let lowercase_ascii s = _string_lower s
|
|
let starts_with prefix s = _string_starts_with prefix s
|
|
end ;;
|
|
|
|
module Char = struct
|
|
let code c = _char_code c
|
|
let chr n = _char_chr n
|
|
let lowercase_ascii c = _string_lower c
|
|
let uppercase_ascii c = _string_upper c
|
|
end ;;
|
|
|
|
module Int = struct
|
|
let to_string i = _string_of_int i
|
|
let of_string s = _int_of_string s
|
|
let abs n = if n < 0 then 0 - n else n
|
|
let max a b = if a > b then a else b
|
|
let min a b = if a < b then a else b
|
|
end ;;
|
|
|
|
module Float = struct
|
|
let to_string f = _string_of_float f
|
|
end ;;
|
|
|
|
module Printf = struct
|
|
let sprintf fmt = fmt
|
|
let printf fmt = print_string fmt
|
|
end")
|
|
|
|
(define ocaml-stdlib-loaded false)
|
|
(define ocaml-stdlib-env nil)
|
|
|
|
;; Build a stdlib env once, cache it. ocaml-run / ocaml-run-program both
|
|
;; layer the user program on top of this base env.
|
|
(define ocaml-load-stdlib!
|
|
(fn ()
|
|
(when (not ocaml-stdlib-loaded)
|
|
(let ((env (ocaml-empty-env)))
|
|
(begin
|
|
(define run-decl
|
|
(fn (decl)
|
|
(let ((tag (ocaml-tag-of decl)))
|
|
(cond
|
|
((= tag "module-def")
|
|
(let ((mn (nth decl 1)) (ds (nth decl 2)))
|
|
(let ((mv (ocaml-eval-module ds env)))
|
|
(set! env (ocaml-env-extend env mn mv)))))
|
|
((= tag "def")
|
|
(let ((nm (nth decl 1)) (ps (nth decl 2)) (rh (nth decl 3)))
|
|
(let ((v (if (= (len ps) 0)
|
|
(ocaml-eval rh env)
|
|
(ocaml-make-curried ps rh env))))
|
|
(set! env (ocaml-env-extend env nm v)))))))))
|
|
(let ((prog (ocaml-parse-program ocaml-stdlib-src)))
|
|
(begin
|
|
(define loop
|
|
(fn (xs)
|
|
(when (not (= xs (list)))
|
|
(begin (run-decl (first xs)) (loop (rest xs))))))
|
|
(loop (rest prog))
|
|
(set! ocaml-stdlib-env env)
|
|
(set! ocaml-stdlib-loaded true))))))))
|