rose-ash/lib/ocaml/runtime.sx

;; 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)
   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
   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
   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))))))))