package minicaml

  1. Overview
  2. Docs

Source file mstdlib.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
open Types

let parser = Parser.toplevel Lexer.token

(** An helper function that helps extracting closures from strings,
to be used as functions in the standard library. An empty environment is used
since primitives in the standard library should not be able to access external values
TODO: compute at compile time *)
let closurize name str =
   try
      (match (parser (Lexing.from_string (str ^ "\n"))) with
      | Expr(Lambda(p, body)) -> LazyExpression (Lambda(p, body))
      | _ -> failwith "standard library definition error")
   with
   | e -> failwith ("standard library definition error in " ^ name ^ ": \n" ^
      (Printexc.print_backtrace stderr; Printexc.to_string e))

let mapstr =
{| fun f l ->
   let aux = fun f l ->
      (if l = [] then l else (f (head l))::(aux f (tail l))) in
   if typeof l = "list" then aux f l
   else if typeof l = "dict" then
      let keys = getkeys l and values = getvalues l in
      dictfromlists keys (aux f values)
   else failwith "value is not iterable"
|}

let filterstr =
{| fun pred l ->
   if typeof l = "list" then
      let aux = fun f l ->
      if l = [] then l else if f (head l) then
         (head l)::(aux f (tail l))
         else (aux f (tail l)) in
      aux pred l
   else if typeof l = "dict" then
      let aux = fun f kl vl acc ->
         if kl = [] && vl = [] then acc
         else if f (head vl) then
            aux f (tail kl) (tail vl) (insert (head kl) (head vl) acc)
         else aux f (tail kl) (tail vl) acc in
      aux pred (getkeys l) (getvalues l) {}
   else failwith "value is not iterable"
|}

let foldlstr =
{| fun f z l ->
   if typeof l = "list" then
      let aux = fun f z l ->
         if l = [] then z else
         aux f (f z (head l)) (tail l)
      in aux f z l
   else if typeof l = "dict" then
      let aux = fun f z kl vl ->
         if kl = [] && vl = [] then z else
         aux f (f z (head vl)) (tail kl) (tail vl)
      in aux f z (getkeys l) (getvalues l)
   else failwith "value is not iterable"
|}

let foldrstr =
{| fun f z l ->
   if typeof l = "list" then
      let aux = fun f z l ->
         if l = [] then z else
         f (head l) (aux f z (tail l))
      in aux f z l
   else if typeof l = "dict" then
      let aux = fun f z kl vl ->
         if kl = [] && vl = [] then z else
         f (head vl) (aux f z (tail kl) (tail vl))
      in aux f z (getkeys l) (getvalues l)
   else failwith "value is not iterable"
|}


let table =
  [("map", (closurize "map" mapstr));
   ("filter", (closurize "filter" filterstr));
   ("foldl", (closurize "foldl" foldlstr));
   ("foldr", (closurize "foldr" foldrstr))
  ]

let purity_table = [("map", Pure); ("filter", Pure); ("foldl", Pure); ("foldr", Pure)]