From 9ce5ca1651922b0da7f8698d303151719a46e170 Mon Sep 17 00:00:00 2001 From: DualFroz Date: Thu, 27 Aug 2026 09:00:00 +0200 Subject: [PATCH] feat(prelude): add builtins and standard library --- src/Fml.Core/Prelude.fs | 178 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 178 insertions(+) create mode 100644 src/Fml.Core/Prelude.fs diff --git a/src/Fml.Core/Prelude.fs b/src/Fml.Core/Prelude.fs new file mode 100644 index 0000000..bd3ecca --- /dev/null +++ b/src/Fml.Core/Prelude.fs @@ -0,0 +1,178 @@ +module Fml.Core.Prelude + +open Fml.Core.Types +open Fml.Core.Value + +// Built-in primitives shared by the interpreter and the bytecode VM, plus a +// standard library written in fml itself that each session may load on top. + +let private genVar () = TVar(ref (Generic(newVarId ()))) + +let initialTypeEnv: Map = + Map.ofList + [ "head", (let a = genVar () in TArrow(TList a, a)) + "tail", (let a = genVar () in TArrow(TList a, TList a)) + "isEmpty", (let a = genVar () in TArrow(TList a, TBool)) + "not", TArrow(TBool, TBool) + "print", (let a = genVar () in TArrow(a, TUnit)) + "fst", (let a = genVar () in let b = genVar () in TArrow(TTuple [ a; b ], a)) + "snd", (let a = genVar () in let b = genVar () in TArrow(TTuple [ a; b ], b)) + "stringLength", TArrow(TString, TInt) + "intToString", TArrow(TInt, TString) + "boolToString", TArrow(TBool, TString) ] + +let initialValueEnv: Env = + Map.ofList + [ "head", + VBuiltin( + "head", + fun v -> + match v with + | VList(x :: _) -> x + | VList [] -> raise (RuntimeError "head of an empty list") + | _ -> raise (RuntimeError "head expects a list") + ) + "tail", + VBuiltin( + "tail", + fun v -> + match v with + | VList(_ :: xs) -> VList xs + | VList [] -> raise (RuntimeError "tail of an empty list") + | _ -> raise (RuntimeError "tail expects a list") + ) + "isEmpty", + VBuiltin( + "isEmpty", + fun v -> + match v with + | VList xs -> VBool(List.isEmpty xs) + | _ -> raise (RuntimeError "isEmpty expects a list") + ) + "not", + VBuiltin( + "not", + fun v -> + match v with + | VBool b -> VBool(not b) + | _ -> raise (RuntimeError "not expects a boolean") + ) + "print", + VBuiltin( + "print", + fun v -> + printfn "%s" (prettyValue v) + VUnit + ) + "fst", + VBuiltin( + "fst", + fun v -> + match v with + | VTuple(a :: _) -> a + | _ -> raise (RuntimeError "fst expects a pair") + ) + "snd", + VBuiltin( + "snd", + fun v -> + match v with + | VTuple(_ :: b :: _) -> b + | _ -> raise (RuntimeError "snd expects a pair") + ) + "stringLength", + VBuiltin( + "stringLength", + fun v -> + match v with + | VString s -> VInt s.Length + | _ -> raise (RuntimeError "stringLength expects a string") + ) + "intToString", + VBuiltin( + "intToString", + fun v -> + match v with + | VInt n -> VString(string n) + | _ -> raise (RuntimeError "intToString expects an int") + ) + "boolToString", + VBuiltin( + "boolToString", + fun v -> + match v with + | VBool b -> VString(if b then "true" else "false") + | _ -> raise (RuntimeError "boolToString expects a bool") + ) ] + +// Standard library implemented in fml. Loaded on demand so the base session and +// its 22 legacy tests stay untouched. Exercises ADTs, records, modules, +// mutually recursive definitions and exhaustive matching all at once. +let preludeSource = + """ +type 'a option = None | Some of 'a ;; +type ('a, 'b) result = Ok of 'a | Error of 'b ;; + +module Option = struct + let isSome = fun o -> match o with None -> false | Some _ -> true ;; + let getOr = fun d o -> match o with None -> d | Some x -> x ;; + let map = fun f o -> match o with None -> None | Some x -> Some (f x) ;; + let bind = fun o f -> match o with None -> None | Some x -> f x ;; +end ;; + +module Result = struct + let isOk = fun r -> match r with Ok _ -> true | Error _ -> false ;; + let map = fun f r -> match r with Ok x -> Ok (f x) | Error e -> Error e ;; + let mapError = fun f r -> match r with Ok x -> Ok x | Error e -> Error (f e) ;; + let getOr = fun d r -> match r with Ok x -> x | Error _ -> d ;; +end ;; + +module List = struct + let rec length = fun xs -> match xs with [] -> 0 | _ :: t -> 1 + length t ;; + let rec map = fun f xs -> match xs with [] -> [] | h :: t -> f h :: map f t ;; + let rec filter = fun p xs -> + match xs with + | [] -> [] + | h :: t -> if p h then h :: filter p t else filter p t ;; + let rec foldl = fun f acc xs -> + match xs with + | [] -> acc + | h :: t -> foldl f (f acc h) t ;; + let rec foldr = fun f acc xs -> + match xs with + | [] -> acc + | h :: t -> f h (foldr f acc t) ;; + let rec append = fun xs ys -> + match xs with + | [] -> ys + | h :: t -> h :: append t ys ;; + let rec rev = fun xs -> + match xs with + | [] -> [] + | h :: t -> append (rev t) (h :: []) ;; + let rec mem = fun x xs -> + match xs with + | [] -> false + | h :: t -> if h = x then true else mem x t ;; + let rec range = fun lo hi -> if lo >= hi then [] else lo :: range (lo + 1) hi ;; + let sum = fun xs -> foldl (fun acc x -> acc + x) 0 xs ;; +end ;; + +module Map = struct + let empty = [] ;; + let rec add = fun k v m -> + match m with + | [] -> (k, v) :: [] + | pair :: rest -> if fst pair = k then (k, v) :: rest else pair :: add k v rest ;; + let rec find = fun k m -> + match m with + | [] -> None + | pair :: rest -> if fst pair = k then Some (snd pair) else find k rest ;; + let contains = fun k m -> Option.isSome (find k m) ;; + let size = fun m -> List.length m ;; + let rec remove = fun k m -> + match m with + | [] -> [] + | pair :: rest -> if fst pair = k then rest else pair :: remove k rest ;; +end ;; +"""