Merge pull request #451 from gfngfn/dev-0-1-0-refine-testing-mechanism

Refine testing mechanism

check-packages.sh

@@ -25,7 +25,13 @@ for FILE in $(find lib-satysfi -name saphe.yaml); do
                 echo "! FAILED (cannot build)"
                 FAILS+=("$DIR (cannot build)")
             else
-                echo "* OK: $DIR"
+                "$SAPHE" test "$DIR"
+                if [ $? -ne  0 ]; then
+                    echo "! FAILED (test failed)"
+                    FAILS+=("$DIR (test failed)")
+                else
+                    echo "* OK: $DIR"
+                fi
             fi
         else
             echo "! FAILED (envelope config mismatch): $DIR"

default-registry-commit-hash.txt

@@ -1 +1 @@
-6f999952b41a3e7480a833f72ac173327765ddba	refs/heads/temp-dev-saphe
+7ffc504e51d1bc5bf4ad5ce7e8cb333616eb8f7e	refs/heads/temp-dev-saphe

doc/math1.saty

@@ -8,6 +8,24 @@ use package open StdJa
 let math ctx \overwrite mf ma mb =
   read-math ctx ${#mf\sqbracket{#ma \mapsto #mb}}
 in
+let math-space =
+  embed-inline-to-math MathOrd (inline-skip 30pt)
+in
+let math ctx \and-also =
+  math-space
+in
+let math ctx \tyjd tyenv tm ty =
+  read-math ctx ${#tyenv \vdash #tm \colon-rel #ty}
+in
+let math ctx \synteq =
+  read-math ctx ${\equiv}
+in
+let math ctx \dot-punct =
+  math-char ctx MathPunct `.`
+in
+let math ctx \tmabstyped var ty body =
+  read-math ctx ${\lambda #var \colon-rel #ty \dot-punct #body}
+in
 
 document ?(
   show-title = false,

lib-satysfi/packages/math/math.0.0.1/src/math.satyh

@@ -417,12 +417,6 @@ module Math :> sig
   val bar-middle : paren
   val slash-middle : paren
 
-%   % -- temporary -- %TODO: remove this
-   val \synteq : math []
-   val \tyjd : math [math-text, math-text, math-text]
-   val \and-also : math []
-   val \tmabstyped : math [math-text, math-text, math-text]
-%
 end = struct
 
   val join (msep : math-text) (ms : list math-text) =
@@ -1020,29 +1014,9 @@ end = struct
 %    let kernfR fontsize ypos = fontsize *' 0.2 in
 %      math-big-char-with-kern MathOp `∫` kernfL kernfR
 
-  val math-space =
-    embed-inline-to-math MathOrd (inline-skip 30pt)
-
-  val math ctx \and-also = math-space
-
-  val math ctx \tyjd tyenv tm ty =
-    read-math ctx ${#tyenv \vdash #tm \colon-rel #ty}
-
-  val math ctx \synteq =
-    read-math ctx ${\equiv}
-
   val math ctx \dot-punct =
     math-char ctx MathPunct `.`
 
-  val math ctx \tmabstyped var ty body =
-    read-math ctx ${\lambda #var \colon-rel #ty \dot-punct #body}
-
-  val math ctx \npe =
-    read-math (ctx |> set-text-color (RGB(1., 0., 0.)) |> set-math-char-class MathRoman) ${e}
-
-  val math ctx \bi m =
-    read-math (ctx |> set-math-char-class MathBoldItalic) m
-
   val half-length hgt dpt hgtaxis fontsize =
     let minhalflen = fontsize *' 0.5 in
     let lenappend = fontsize *' 0.1 in

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/basic.satyg

@@ -2,6 +2,8 @@ module Basic = struct
 
   type ordering = Less | Equal | Greater
 
+  type vector = length * length
+
   type point = length * length
 
   type paren = length -> length -> context -> inline-boxes * (length -> length)

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/block.satyh

@@ -1,4 +1,8 @@
+use List
+
 module Block :> sig
+  val nil : block-boxes
+  val concat : list block-boxes -> block-boxes
   val form-paragraph : context -> inline-boxes -> block-boxes
   val +skip : block [length]
   val \skip : inline [length]
@@ -7,6 +11,12 @@ module Block :> sig
   val +centering : block [inline-text]
 end = struct
 
+  val nil =
+    block-nil
+
+  val concat bbs =
+    List.fold ( +++ ) nil bbs
+
   val form-paragraph =
     line-break true true
 

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/float.satyg

@@ -0,0 +1,37 @@
+use open Basic
+
+module Float :> sig
+  type t = float
+  val ~lift : float -> code float
+  val persistent ~abs : float -> float
+  val persistent ~max : float -> float -> float
+  val persistent ~min : float -> float -> float
+  val persistent ~pi : float
+  val persistent ~power : float -> float -> float
+  val persistent ~sqrt : float -> float
+end = struct
+
+  type t = float
+
+  val ~lift x =
+    lift-float x
+
+  val persistent ~abs x =
+    if x >=. 0. then x else 0. -. x
+
+  val persistent ~max x1 x2 =
+    if x1 >=. x2 then x1 else x2
+
+  val persistent ~min x1 x2 =
+    if x1 <=. x2 then x1 else x2
+
+  val persistent ~pi =
+    3.1415926536
+
+  val persistent ~power y x =
+    exp (y *. log x)
+
+  val persistent ~sqrt =
+    power 0.5
+
+end

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/graphics.satyh

@@ -1,6 +1,6 @@
 use open Basic
-use Arith
-use Geom
+use Float
+use Point
 use Path
 use List
 use Length
@@ -30,7 +30,7 @@ end = struct
 
   val rotate centpt angle gr =
     let (centx, centy) = centpt in
-    let rad = angle *. Arith.pi /. 180. in
+    let rad = angle *. Float.pi /. 180. in
     gr |> shift (0pt -' centx, 0pt -' centy)
        |> linear-transform (cos rad) (0. -. (sin rad)) (sin rad) (cos rad)
        |> shift centpt
@@ -66,10 +66,10 @@ end = struct
     shift (0pt -' wid, 0pt) gr
 
   val arrow-scheme strokef color lenL lenM lenP ((x1, y1) as pt1) ((x2, y2) as pt2) =
-    let theta = Geom.atan2-point pt2 pt1 in
+    let theta = Point.atan2 pt2 pt1 in
     let (cx, cy) = (x2 +' lenL *' (cos theta), y2 +' lenL *' (sin theta)) in
     let (mx, my) = (x2 +' lenM *' (cos theta), y2 +' lenM *' (sin theta)) in
-    let phi = theta +. Arith.pi /. 2. in
+    let phi = theta +. Float.pi /. 2. in
     let (p1, q1) = (cx +' lenP *' (cos phi), cy +' lenP *' (sin phi)) in
     let (p2, q2) = (cx -' lenP *' (cos phi), cy -' lenP *' (sin phi)) in
     overlay [

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/inline.satyh

@@ -1,5 +1,9 @@
+use List
+
 module Inline :> sig
   val get-natural-advance : inline-boxes -> length
+  val nil : inline-boxes
+  val concat : list inline-boxes -> inline-boxes
   val kern : length -> inline-boxes
   val \skip : inline [length]
   val no-break : inline-boxes -> inline-boxes
@@ -14,6 +18,12 @@ end = struct
     let (wid, _, _) = get-natural-metrics ib in
     wid
 
+  val nil =
+    inline-nil
+
+  val concat ibs =
+    List.fold ( ++ ) nil ibs
+
   val kern len = inline-skip (0pt -' len)
 
   val inline ctx \skip len =

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/int.satyg

@@ -5,6 +5,7 @@ module Int :> sig
   val ~lift : int -> code int
   val persistent ~compare : int -> int -> ordering
   val persistent ~equal : int -> int -> bool
+  val persistent ~abs : int -> int
   val persistent ~max : int -> int -> int
   val persistent ~min : int -> int -> int
 end = struct
@@ -23,6 +24,9 @@ end = struct
 
   val persistent ~equal = ( == )
 
+  val persistent ~abs n =
+    if n >= 0 then n else - n
+
   val persistent ~max n1 n2 =
     if n1 >= n2 then n1 else n2
 

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/length.satyh

@@ -4,6 +4,7 @@ module Length :> sig
   val persistent ~max : length -> length -> length
   val persistent ~min : length -> length -> length
   val persistent ~abs : length -> length
+  val persistent ~atan2 : length -> length -> float
 end = struct
 
   type t = length
@@ -20,4 +21,7 @@ end = struct
   val persistent ~abs len =
     if len <' 0pt then 0pt -' len else len
 
+  val persistent ~atan2 y x =
+    atan2 (y /' 1pt) (x /' 1pt)
+
 end

lib-satysfi/packages/stdlib/stdlib.0.0.1/src/list.satyg

@@ -6,6 +6,7 @@ module List :> sig
   val ~lift 'a : ('a -> code 'a) -> list 'a -> code (list 'a)
   val persistent ~compare 'a : ('a -> 'a -> ordering) -> list 'a -> list 'a -> ordering
   val persistent ~equal 'a : ('a -> 'a -> bool) -> list 'a -> list 'a -> bool
+  val persistent ~show 'a : ('a -> string) -> list 'a -> string
   val persistent ~fold 'a 'b : ('a -> 'b -> 'a) -> 'a -> list 'b -> 'a
   val persistent ~fold-indexed 'a 'b : ('a -> int -> 'b -> 'a) -> 'a -> list 'b -> 'a
   val persistent ~fold-back 'a 'b : ('a -> 'b -> 'b) -> list 'a -> 'b -> 'b
@@ -25,7 +26,8 @@ module List :> sig
   val persistent ~iter-indexed 'a : (int -> 'a -> unit) -> list 'a -> unit
   val persistent ~filter 'a : ('a -> bool) -> list 'a -> list 'a
   val persistent ~filter-map 'a 'b : ('a -> option 'b) -> list 'a -> list 'b
-  val persistent ~assoc 'a 'b : ('a -> 'a -> bool) -> 'a -> list ('a * 'b) -> option 'b
+  val persistent ~find 'a : ('a -> bool) -> list 'a -> option 'a
+  val persistent ~find-map 'a 'b : ('a -> option 'b) -> list 'a -> option 'b
   val persistent ~length 'a : list 'a -> int
   val persistent ~nth 'a : int -> list 'a -> option 'a
   val persistent ~is-empty 'a : list 'a -> bool
@@ -61,6 +63,16 @@ end = struct
     | _                      -> false
     end
 
+  val persistent ~show sh =
+    let rec aux xs =
+      match xs with
+      | []      -> ` `
+      | [x]     -> sh x
+      | x :: ys -> sh x ^ `, `# ^ aux ys
+      end
+    in
+    (fun xs -> `[` ^ aux xs ^ `]`)
+
   val persistent ~rec fold f acc ys =
     match ys with
     | []      -> acc
@@ -187,23 +199,37 @@ end = struct
         end
     end
 
-  val persistent ~rec assoc eq a ys =
+  val persistent ~rec find p ys =
     match ys with
-    | []           -> None
-    | (x, y) :: xs -> if eq a x then Some(y) else assoc eq a xs
+    | []      -> None
+    | x :: xs -> if p x then Some(x) else find p ys
     end
 
+  val persistent ~find-map f =
+    let rec aux ys =
+      match ys with
+      | [] ->
+          None
+      | x :: xs ->
+          match f x with
+          | Some(v) -> Some(v)
+          | None    -> aux xs
+          end
+      end
+    in
+    aux
+
   val persistent ~length xs =
     fold (fun i _ -> i + 1) 0 xs
 
-  val persistent ~nth lst =
-    let rec aux i n xs =
-      match xs with
-      | []           -> None
-      | head :: tail -> if n == i then Some(head) else aux (i + 1) n tail
+  val persistent ~nth n =
+    let rec aux i ys =
+      match ys with
+      | []      -> None
+      | x :: xs -> if i == n then Some(x) else aux (i + 1) xs
       end
     in
-    aux 0 lst
+    aux 0
 
   val persistent ~is-empty xs =
     match xs with