Updating: very minorly improving

Updating: very minorly improving

(*
** Testing some operations on reals
*)

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
"libats/SATS/NUMBER/real.sats"
//
staload
"libats/DATS/NUMBER/real_double.dats"
//
(* ****** ****** *)
//
extern
fun
quadratic_solve1
 {A,B,C:real}
(
  A: real(A), B: real(B), C: real(C)
) : [x:real | A*x*x+B*x+C==i2r(0)] real(x)
//
extern
fun
quadratic_solve2
 {A,B,C:real}
(
  A: real(A), B: real(B), C: real(C)
) : [x:real | A*x*x+B*x+C==i2r(0)] real(x)
//
(* ****** ****** *)

#define i2r(x) int2real(x)

(* ****** ****** *)
//
implement
quadratic_solve1
  (A, B, C) = let
//
val Delta = B*B-4*A*C
val ((*void*)) = assert(Delta >= i2r(0))
//
in
  (~B+sqrt(Delta))/(2*A)
end // end of [quadratic_solve1]
//
implement
quadratic_solve2
  (A, B, C) = let
//
val Delta = B*B-4*A*C
val ((*void*)) = assert(Delta >= i2r(0))
//
in
  (~B-sqrt(Delta))/(2*A)
end // end of [quadratic_solve2]
//
(* ****** ****** *)

val root1 =
  quadratic_solve1(i2r(1), i2r(1), i2r(~1))
val root2 =
  quadratic_solve2(i2r(1), i2r(1), i2r(~1))

(* ****** ****** *)

val () = println! ("root1 = ", root1)
val () = println! ("root2 = ", root2)

(* ****** ****** *)

implement
main0() = () where
{
//
val () =
println! ("Hello from [test01]")
//
} (* end of [main0] *)

(* ****** ****** *)

(* end of [test01.dats] *)

(*
** Testing some operations on reals
*)

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload
"libats/SATS/NUMBER/real.sats"
//
staload
"libats/DATS/NUMBER/real_double.dats"
//
(* ****** ****** *)
//
extern
fun
quadratic_solve1
 {A,B,C:real}
(
  A: real(A), B: real(B), C: real(C)
) : [x:real | A*x*x+B*x+C==i2r(0)] real(x)
//
extern
fun
quadratic_solve2
 {A,B,C:real}
(
  A: real(A), B: real(B), C: real(C)
) : [x:real | A*x*x+B*x+C==i2r(0)] real(x)
//
(* ****** ****** *)

#define i2r(x) int2real(x)

(* ****** ****** *)
//
implement
quadratic_solve1
  (A, B, C) = (~B+sqrt(B*B-4*A*C))/(2*A)
//
implement
quadratic_solve2
  (A, B, C) = (~B-sqrt(B*B-4*A*C))/(2*A)
//
(* ****** ****** *)

val root1 =
  quadratic_solve1(i2r(4), i2r(4), i2r(~3))
val root2 =
  quadratic_solve2(i2r(4), i2r(4), i2r(~3))

(* ****** ****** *)

val () = println! ("root1 = ", root1)
val () = println! ("root2 = ", root2)

(* ****** ****** *)

implement
main0() = () where
{
//
val () =
println! ("Hello from [test01]")
//
} (* end of [main0] *)

(* ****** ****** *)

(* end of [test01.dats] *)


Wrap forever loop

Wrap forever loop

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

staload "SATS/arduino.sats"
staload "SATS/lcd.sats"
staload UN = "prelude/SATS/unsafe.sats"

//#define MY_DELAY_MS 400.0
#define MY_DELAY_MS 100.0
#define LCD_WIDTH 16

val g_string = "                 ATS is a statically typed programming language that unifies implementation with formal specification.                 "

implement main0 () = {
  fun loop {n:int}{i:nat | i < n}
           (lcd: !LCD, str: string (n), pos: size_t (i)): void = {
    val () = lcd_setCursor (lcd, $UN.cast 1, 0)
    val () = lcd_print (lcd, "<ATS running!>", i2sz 0, 14)
    val () = lcd_setCursor (lcd, $UN.cast 0, 1)
    val () = lcd_print (lcd, str, pos, LCD_WIDTH)
    val () = _delay_ms (MY_DELAY_MS)
    val () = if pos + LCD_WIDTH < length str then loop (lcd, str, pos + 1)
  }
  fun forever {n:int}{i:nat | i < n}
           (lcd: !LCD, str: string (n), pos: size_t (i)): void = {
    val () = loop (lcd, str, pos)
    val () = forever (lcd, str, pos)
  }
  val lcd = lcd_open ($UN.cast 8, $UN.cast 13, $UN.cast 9, $UN.cast 4, $UN.cast 5, $UN.cast 6, $UN.cast 7)
  val () = forever (lcd, g_string, i2sz 0)
  val () = lcd_close lcd
}

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

staload "SATS/arduino.sats"
staload "SATS/lcd.sats"
staload UN = "prelude/SATS/unsafe.sats"

//#define MY_DELAY_MS 400.0
#define MY_DELAY_MS 50.0

val g_string = "ATS is a statically typed programming language that unifies implementation with formal specification. It is equipped with a highly expressive type system rooted in the framework Applied Type System, which gives the language its name. In particular, both dependent types and linear types are available in ATS.                                          "

implement main0 () = {
  fun loop {n:int}{i:nat | i < n}
           (lcd: !LCD, str: string (n), pos: size_t (i), len: int): void = {
    val () = lcd_setCursor (lcd, $UN.cast 1, 0)
    val () = lcd_print (lcd, "<ATS running!>", i2sz 0, 14)
    val () = lcd_setCursor (lcd, $UN.cast 0, 1)
    val () = lcd_print (lcd, str, pos, len)
    val () = _delay_ms (MY_DELAY_MS)
    val () = if pos + 1 < length str then loop (lcd, str, pos + 1, len)
  }
  val lcd = lcd_open ($UN.cast 8, $UN.cast 13, $UN.cast 9, $UN.cast 4, $UN.cast 5, $UN.cast 6, $UN.cast 7)
  val () = loop (lcd, g_string, i2sz 0, 16)
  val () = lcd_close lcd
}


Updating: improving JSclock

Updating: improving JSclock

(*
//
An example of atscc2js: Wall Clock
//
Author: Hongwei Xi
Authoremail: hwxi AT cs DOT bu DOT edu
Start Time: September, 2014
//
This example is essentially translated from
the JS code at the following site:
//
http://www.neilwallis.com/projects/html5/clock/
//
*)

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2JS}/SATS/HTML/canvas-2d/canvas2d.sats"
//
(* ****** ****** *)

macdef PI = JSmath_PI
macdef sin = JSmath_sin and cos = JSmath_cos

(* ****** ****** *)

fun
draw_mark
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx = 110 * sa
val sy = 110 * ca
val ex = 120 * sa
val ey = 120 * ca
//
val () = ctx.lineWidth(2)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark] *)

(* ****** ****** *)

fun
draw_mark2
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx =  95 * sa
val sy = ~95 * ca
val ex =  120 * sa
val ey = ~120 * ca
val nx =  80 * sa
val ny = ~80 * ca
//
val () = ctx.fillText(toString(i/5), nx, ny)
//
val () = ctx.lineWidth(8)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark2] *)

(* ****** ****** *)
//
extern
fun
draw_clock
(
  ctx: canvas2d
, nhr: double, nmin: double, nsec: double
) : void = "mac#" // end-of-fun
//
implement
draw_clock
(
  ctx, nhr, nmin, nsec
) = () where {
//
val () = ctx.clearRect(0.0, 0.0, 300.0, 300.0)
//
// Define gradients for 3D-shadow effect
//
val g1 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g1.addColorStop(0.0, "#D83040")
val () = g1.addColorStop(1.0, "#801020")
//
val g2 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g2.addColorStop(0.0, "#801020")
val () = g2.addColorStop(1.0, "#D83040")
//
val () = ctx.font("bold 20px arial")
val () = ctx.textAlign("center")
val () = ctx.textBaseline("middle")
val () = ctx.lineWidth(1)
//
val () = ctx.strokeStyle_gradient(g1)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 138.0, 0.0, 2*PI, true)
val () = ctx.closePath()
val () = ctx.shadowBlur(6)
val () = ctx.shadowOffsetX(4)
val () = ctx.shadowOffsetY(4)
val () = ctx.shadowColor("rgba(0,0,0,0.6)")
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle_gradient(g2)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 129.0, 0.0, 2*PI, true);
val () = ctx.closePath()
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle("#222")
//
val pf = ctx.save()
//
val () = ctx.translate(150.0, 150.0)
//
val () = let
//
fun loop
(
  ctx: canvas2d, i: int
) : void =
(
if
i <= 60
then let
  val () =
  (
    if i % 5 != 0
      then draw_mark (ctx, i) else draw_mark2 (ctx, i)
    // end of [if]
  ) : void // end of [val]
in
  loop (ctx, i+1)
end // end of [then]
else () // end of [else]
) (* end of [loop] *)
//
in
  loop (ctx, 1)
end // end of [val]
//
val ampm =
  (if (nhr < 12.0) then "AM" else "PM"): string
//
val () = ctx.strokeStyle("#000")
val () = ctx.lineWidth(1)
val () = ctx.strokeRect(21.0, ~14.0, 44.0, 27.0)
val () = ctx.fillText(ampm, 43.0, 0.0)
val () = ctx.lineWidth(6)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nhr*PI/6)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 10.0)
  val () = ctx.lineTo(0.0, ~60.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nmin*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.lineWidth (3)
val () = ctx.strokeStyle("#E33")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nsec*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.fillStyle("#000")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.beginPath()
  val () = ctx.arc(0.0, 0.0, 6.5, 0.0, 2*PI, true)
  val () = ctx.closePath()
  val () = ctx.fill()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.restore (pf.0 | (*none*))
//
} (* end of [where] *) // [draw_clock]
//
(* ****** ****** *)

%{$
//
var
canvas =
document.getElementById("Patsoptaas-Evaluate-canvas");
var context = canvas.getContext( '2d' );
//
var w = canvas.width
var h = canvas.height
var xc = w / 2
var yc = h / 2
var wh = Math.min (w, h)
var alpha = wh / 300
//
function
draw2_clock()
{
var date = new Date() ;
var secs = date.getSeconds()
var mins = date.getMinutes()
var mins = mins + secs / 60.0
var hours = date.getHours()
var hours = hours + mins / 60.0
//
context.save();
context.translate(xc-wh/2, yc-wh/2);
context.scale (alpha, alpha);
draw_clock(context, hours, mins, secs);
context.restore();
//
setTimeout(draw2_clock, 500);
//
return;
//
} // end of [draw2_clock]
//
jQuery(document).ready(function(){draw2_clock();});
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [myclock1-2.dats] *)

(*
//
An example of atscc2js: Wall Clock
//
Author: Hongwei Xi
Authoremail: hwxi AT cs DOT bu DOT edu
Start Time: September, 2014
//
This example is essentially translated from
the JS code at the following site:
//
http://www.neilwallis.com/projects/html5/clock/
//
*)

(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

#define ATS_DYNLOADFLAG 0

(* ****** ****** *)
//
staload
UN = "prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
#include
"{$LIBATSCC2JS}/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LIBATSCC2JS}/SATS/HTML/canvas-2d/canvas2d.sats"
//
(* ****** ****** *)

macdef PI = JSmath_PI
macdef sin = JSmath_sin and cos = JSmath_cos

(* ****** ****** *)

fun
draw_mark
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx = 110 * sa
val sy = 110 * ca
val ex = 120 * sa
val ey = 120 * ca
//
val () = ctx.lineWidth(2)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark] *)

(* ****** ****** *)

fun
draw_mark2
(
  ctx: canvas2d, i: int
) : void = {
//
val a = PI/30*i
val sa = sin(a)
val ca = cos(a)
val sx =  95 * sa
val sy = ~95 * ca
val ex =  120 * sa
val ey = ~120 * ca
val nx =  80 * sa
val ny = ~80 * ca
//
val () = ctx.fillText(toString(i/5), nx, ny)
//
val () = ctx.lineWidth(8)
//
val () = ctx.beginPath()
val () = ctx.moveTo(sx, sy)
val () = ctx.lineTo(ex, ey)
val () = ctx.closePath()
//
val () = ctx.stroke()
//
} (* end of [draw_mark2] *)

(* ****** ****** *)
//
extern
fun
draw_clock
(
  ctx: canvas2d
, nhr: double, nmin: double, nsec: double
) : void = "mac#" // end-of-fun
//
implement
draw_clock
(
  ctx, nhr, nmin, nsec
) = () where {
//
val () = ctx.clearRect(0.0, 0.0, 300.0, 300.0)
//
// Define gradients for 3D-shadow effect
//
val g1 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g1.addColorStop(0.0, "#D83040")
val () = g1.addColorStop(1.0, "#801020")
//
val g2 = ctx.createLinearGradient(0.0, 0.0, 300.0, 300.0)
val () = g2.addColorStop(0.0, "#801020")
val () = g2.addColorStop(1.0, "#D83040")
//
val () = ctx.font("bold 20px arial")
val () = ctx.textAlign("center")
val () = ctx.textBaseline("middle")
val () = ctx.lineWidth(1)
//
val () = ctx.strokeStyle_gradient(g1)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 138.0, 0.0, 2*PI, true)
val () = ctx.closePath()
val () = ctx.shadowBlur(6)
val () = ctx.shadowOffsetX(4)
val () = ctx.shadowOffsetY(4)
val () = ctx.shadowColor("rgba(0,0,0,0.6)")
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle_gradient(g2)
val () = ctx.lineWidth(10)
//
val pf = ctx.save()
val () = ctx.beginPath()
val () = ctx.arc(150.0, 150.0, 129.0, 0.0, 2*PI, true);
val () = ctx.closePath()
val () = ctx.stroke()
val () = ctx.restore(pf.0 | (*none*))
//
val () = ctx.strokeStyle("#222")
//
val pf = ctx.save()
//
val () = ctx.translate(150.0, 150.0)
//
val () = let
//
fun loop
(
  ctx: canvas2d, i: int
) : void =
(
if
i <= 60
then let
  val () =
  (
    if i % 5 != 0
      then draw_mark (ctx, i) else draw_mark2 (ctx, i)
    // end of [if]
  ) : void // end of [val]
in
  loop (ctx, i+1)
end // end of [then]
else () // end of [else]
) (* end of [loop] *)
//
in
  loop (ctx, 1)
end // end of [val]
//
val ampm =
  (if (nhr < 12.0) then "AM" else "PM"): string
//
val () = ctx.strokeStyle("#000")
val () = ctx.lineWidth(1)
val () = ctx.strokeRect(21.0, ~14.0, 44.0, 27.0)
val () = ctx.fillText(ampm, 43.0, 0.0)
val () = ctx.lineWidth(6)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nhr*PI/6)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 10.0)
  val () = ctx.lineTo(0.0, ~60.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nmin*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.lineWidth (3)
val () = ctx.strokeStyle("#E33")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.rotate(nsec*PI/30)
  val () = ctx.beginPath()
  val () = ctx.moveTo(0.0, 20.0)
  val () = ctx.lineTo(0.0, ~110.0)
  val () = ctx.closePath()
  val () = ctx.stroke()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.fillStyle("#000")
//
val () =
{
  val pf = ctx.save()
  val () = ctx.beginPath()
  val () = ctx.arc(0.0, 0.0, 6.5, 0.0, 2*PI, true)
  val () = ctx.closePath()
  val () = ctx.fill()
  val () = ctx.restore(pf.0 | (*none*))
} (* end of [val] *)
//
val () = ctx.restore (pf.0 | (*none*))
//
} (* end of [where] *) // [draw_clock]
//
(* ****** ****** *)

%{$
//
var
canvas =
document.getElementById("Patsoptaas-Evaluate-Canvas");
var context = canvas.getContext( '2d' );
//
var w = canvas.width
var h = canvas.height
var xc = w / 2
var yc = h / 2
var wh = Math.min (w, h)
var alpha = wh / 300
//
function
draw2_clock()
{
var date = new Date() ;
var secs = date.getSeconds()
var mins = date.getMinutes()
var mins = mins + secs / 60.0
var hours = date.getHours()
var hours = hours + mins / 60.0
//
context.save();
context.translate(xc-wh/2, yc-wh/2);
context.scale (alpha, alpha);
draw_clock(context, hours, mins, secs);
context.restore();
//
setTimeout(draw2_clock, 500);
//
return;
//
} // end of [draw2_clock]
//
jQuery(document).ready(function(){draw2_clock();});
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [myclock1-2.dats] *)


Fix LCD bug

Fix LCD bug

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/lcd.sats"

#define MY_DELAY_MS 400.0
#define LCD_WIDTH 16

val g_str_atsrun = "<ATS running!>"
val g_str_message = "                 ATS is a statically typed programming language that unifies implementation with formal specification. It is equipped with a highly expressive type system rooted in the framework Applied Type System, which gives the language its name. In particular, both dependent types and linear types are available in ATS.                 "

implement main () = {
  fun loop {n:int}{i:nat | i < n}
           (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = if pos + i2sz LCD_WIDTH <= length str then {
      val () = (lcd_setCursor (lcd, 1, 0); lcd_print (lcd, g_str_atsrun, i2sz 0, length g_str_atsrun))
      val () = (lcd_setCursor (lcd, 0, 1); lcd_print (lcd, str, pos, i2sz LCD_WIDTH))
      val () = delay_ms (MY_DELAY_MS)
      val () = loop (lcd, str, pos + 1)
    }
  }
  fun forever {n:int}{i:nat | i < n}
              (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = loop (lcd, str, pos)
    val () = forever (lcd, str, pos)
  }
  val lcd = lcd_open (8, 13, 9, 4, 5, 6, 7)
  val () = forever (lcd, g_str_message, i2sz 0)
  val () = lcd_close lcd
}

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/lcd.sats"

#define MY_DELAY_MS 400.0

val lcd_width = i2sz 16
val g_str_atsrun = "<ATS running!>"
val g_str_message = "                 ATS is a statically typed programming language that unifies implementation with formal specification. It is equipped with a highly expressive type system rooted in the framework Applied Type System, which gives the language its name. In particular, both dependent types and linear types are available in ATS.                 "

implement main () = {
  fun loop {n:int}{i:nat | i < n}
           (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = if pos + lcd_width <= length str then {
      val () = lcd_setCursor (lcd, 1, 0)
      val () = lcd_print (lcd, g_str_atsrun, i2sz 0, length g_str_atsrun)
      val () = lcd_setCursor (lcd, 0, 1)
      val () = lcd_print (lcd, str, pos, lcd_width)
      val () = delay_ms (MY_DELAY_MS)
      val () = loop (lcd, str, pos + 1)
    }
  }
  fun forever {n:int}{i:nat | i < n}
              (lcd: !lcd_t, str: string (n), pos: size_t (i)): void = {
    val () = loop (lcd, str, pos)
    val () = forever (lcd, str, pos)
  }
  val lcd = lcd_open (8, 13, 9, 4, 5, 6, 7)
  val () = forever (lcd, g_str_message, i2sz 0)
  val () = lcd_close lcd
}


Alias intbv32 and uintbv32 with int32_t  and uint32_t.

(**
  Integers indexed by fixed width bit vectors.
*)

staload "contrib/libats-/wdblair/patsolve/SATS/bitvector.sats"

(**
  The div function provided in the prelude is not very precise.
*)
typedef
g1uint_div_type
  (tk:tk) =
   {i,j:int | j > 0}
   (g1uint (tk, i), g1uint (tk, j)) -<fun0> g1uint (tk, i / j)
// end of [g1uint_div_type]

fun
{tk:tk}
g1uint_div : g1uint_div_type(tk)

overload / with g1uint_div of 100

abst@ype int_bv32 (bv:bv32) = $extype "int32_t"
typedef int (bv:bv32) = int_bv32 (bv)

castfn
bv32_of_int {n:nat} (int n): int (bv32(n))

castfn
bv32_of_bool {b:bool} (bool b): int (bv32(b))

castfn
int_of_bv32 {b:bv32} (int b): int (signed_int_of_bv32(b))

fun
neg_int_bv32 {x:bv32}
  (x: int(x)): int (~x) = "mac#%"

overload ~ with neg_int_bv32

fun
add_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x + y) = "mac#%"

overload + with add_int_int_bv32

fun
sub_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x - y) = "mac#%"

overload - with sub_int_int_bv32

fun
sub_int_bv32_int_int {x:bv32} {y:int}
  (x:int (x), y: int (y)): int (x - bv32(y)) = "mac#%"

overload - with sub_int_bv32_int_int

fun
mul_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x * y) = "mac#%"

overload * with mul_int_int_bv32

fun
div_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x / y) = "mac#%"

overload / with div_int_int_bv32

fun
udiv_int_int_bv32 {x,y:bv32}
  (x: int (x), y: int (y)): int (udiv (x, y)) = "mac#%"

overload udiv with udiv_int_int_bv32

fun
udiv_int_bv32_int_int {x:bv32}{y:int}
  (x: int (x), y: int (y)): int (udiv (x, bv32(y))) = "mac#%"

overload udiv with udiv_int_bv32_int_int

fun
eq_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x == y) = "mac#%"

overload = with eq_int_int_bv32

fun
eq_int_bv32_int_int {x:bv32} {y:int}
  (x: int(x), y: int(y)): bool (x == bv32(y)) = "mac#%"

overload = with eq_int_bv32_int_int

fun
lt_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x < y) = "mac#%"

overload < with lt_int_int_bv32

fun
lte_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x <= y) = "mac#%"

overload <= with lte_int_int_bv32

fun
gte_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x >= y) = "mac#%"

overload >= with gte_int_int_bv32

fun
gt_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x > y) = "mac#%"

overload > with gt_int_int_bv32

fun
gt_int_bv32_int_int {x:bv32} {y:int}
  (x: int (x), y: int (y)): bool (x > bv32(y)) = "mac#%"

overload > with gt_int_bv32_int_int

fun
land_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x land y) = "mac#%"

overload land with land_int_int_bv32

fun
land_int_bv32_int_int {x:bv32} {y:int} (
  x: int (x), y: int (y)
): int (x land bv32(y)) = "mac#%"

overload land with land_int_bv32_int_int

fun
lor_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x lor y) = "mac#%"

overload lor with lor_int_int_bv32

fun
lxor_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x lxor y) = "mac#%"

overload lxor with lxor_int_int_bv32

fun
lnot_int_bv32 {x:bv32}
  (x:int (x)): int (lnot x) = "mac#%"

overload lnot with lnot_int_bv32

fun
lnot_int_int {x:int}
  (x: int (x)): int (lnot (bv32(x))) = "mac#%"

overload lnot with lnot_int_int

fun
lshl_int_bv32_int {x,i:bv32}
  (x: int (x), i: int (i)): int (x << i) = "mac#%"

overload << with lshl_int_bv32_int

(**
  This may be a wrong assumption, but if our argument
  is signed, then shifting right incurs an arithmetic
  shift. Therefore, a logical shift is unavailable for
  signed integers.

  I'm basing this off of information I read about gcc's
  behavior for this case.
*)
fun
ashr_int_bv32_int {x,i:bv32}
  (x: int (x), i: int (i)): int (ashr(x, i)) = "mac#%"

overload >> with ashr_int_bv32_int

(**
  Unsigned ints.
*)
abst@ype uint_bv32 (bv:bv32) = $extype "uint32_t"
typedef uint (bv:bv32) = uint_bv32 (bv)

castfn
ubv32_of_uint {n:nat} (uint n): uint (bv32(n))

castfn
ubv32_of_bool {b:bool} (bool b): uint (bv32(b))

castfn
uint_of_bv32 {b:bv32} (uint b): uint (int_of_bv32(b))

fun
lshr_int_bv32_int {x,i:bv32}
  (x: uint (x), i: uint (i)): uint (lshr(x, i)) = "mac#%"

overload >> with lshr_int_bv32_int

fun
lshr_int_bv32_int_int {x:bv32}{i:int}
  (x: uint (x), i: uint (i)): uint (lshr(x, bv32(i))) = "mac#%"

overload >> with lshr_int_bv32_int_int

fun
neg_uint_bv32 {x:bv32}
  (x: uint(x)): uint (~x) = "mac#%"

overload ~ with neg_uint_bv32

fun
add_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x + y) = "mac#%"

overload + with add_uint_uint_bv32

fun
sub_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x - y) = "mac#%"

overload - with sub_uint_uint_bv32

fun
sub_uint_bv32_uint_uint {x:bv32} {y:int}
  (x:uint (x), y: uint (y)): uint (x - bv32(y)) = "mac#%"

overload - with sub_uint_bv32_uint_uint

fun
mul_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x * y) = "mac#%"

overload * with mul_uint_uint_bv32

fun
div_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x / y) = "mac#%"

overload / with div_uint_uint_bv32

fun
udiv_uint_uint_bv32 {x,y:bv32}
  (x: uint (x), y: uint (y)): uint (udiv (x, y)) = "mac#%"

overload udiv with udiv_uint_uint_bv32

fun
udiv_uint_bv32_uint_uint {x:bv32} {y:int}
  (x: uint (x), y: uint (y)): uint (udiv (x, bv32(y))) = "mac#%"

overload udiv with udiv_uint_bv32_uint_uint

fun
eq_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x == y) = "mac#%"

overload = with eq_uint_uint_bv32

fun
eq_uint_bv32_uint_uint {x:bv32} {y:int}
  (x: uint(x), y: uint(y)): bool (x == bv32(y)) = "mac#%"

overload = with eq_uint_bv32_uint_uint

fun
lt_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x < y) = "mac#%"

overload < with lt_uint_uint_bv32

fun
lte_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x <= y) = "mac#%"

overload <= with lte_uint_uint_bv32

fun
gte_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x >= y) = "mac#%"

overload >= with gte_uint_uint_bv32

fun
gt_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x > y) = "mac#%"

overload > with gt_uint_uint_bv32

fun
gt_uint_bv32_uint_uint {x:bv32} {y:int}
  (x: uint (x), y: uint (y)): bool (x > bv32(y)) = "mac#%"

overload > with gt_uint_bv32_uint_uint

fun
land_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x land y) = "mac#%"

overload land with land_uint_uint_bv32

fun
land_uint_bv32_uint_uint {x:bv32} {y:int} (
  x: uint (x), y: uint (y)
): uint (x land bv32(y)) = "mac#%"

overload land with land_uint_bv32_uint_uint

fun
lor_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x lor y) = "mac#%"

overload lor with lor_uint_uint_bv32

fun
lxor_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x lxor y) = "mac#%"

overload lxor with lxor_uint_uint_bv32

fun
lnot_uint_bv32 {x:bv32}
  (x:uint (x)): uint (lnot x) = "mac#%"

overload lnot with lnot_uint_bv32 of 100

fun
lnot_uint_uint {x:int}
  (x: uint (x)): uint (lnot (bv32(x))) = "mac#%"

overload lnot with lnot_uint_uint of 100

fun
lshl_uint_bv32_uint {x,i:bv32}
  (x: uint (x), i: uint (i)): uint (x << i) = "mac#%"

overload << with lshl_uint_bv32_uint

(**
  Integers indexed by fixed width bit vectors.
*)

staload "contrib/libats-/wdblair/patsolve/SATS/bitvector.sats"

(**
  The div function provided in the prelude is not very precise.
*)
typedef
g1uint_div_type
  (tk:tk) =
   {i,j:int | j > 0}
   (g1uint (tk, i), g1uint (tk, j)) -<fun0> g1uint (tk, i / j)
// end of [g1uint_div_type]

fun
{tk:tk}
g1uint_div : g1uint_div_type(tk)

overload / with g1uint_div of 100

abst@ype int_bv32 (bv:bv32) = int
typedef int (bv:bv32) = int_bv32 (bv)

castfn
bv32_of_int {n:nat} (int n): int (bv32(n))

castfn
bv32_of_bool {b:bool} (bool b): int (bv32(b))

castfn
int_of_bv32 {b:bv32} (int b): int (signed_int_of_bv32(b))

fun
neg_int_bv32 {x:bv32}
  (x: int(x)): int (~x) = "mac#%"

overload ~ with neg_int_bv32

fun
add_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x + y) = "mac#%"

overload + with add_int_int_bv32

fun
sub_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x - y) = "mac#%"

overload - with sub_int_int_bv32

fun
sub_int_bv32_int_int {x:bv32} {y:int}
  (x:int (x), y: int (y)): int (x - bv32(y)) = "mac#%"

overload - with sub_int_bv32_int_int

fun
mul_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x * y) = "mac#%"

overload * with mul_int_int_bv32

fun
div_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x / y) = "mac#%"

overload / with div_int_int_bv32

fun
udiv_int_int_bv32 {x,y:bv32}
  (x: int (x), y: int (y)): int (udiv (x, y)) = "mac#%"

overload udiv with udiv_int_int_bv32

fun
udiv_int_bv32_int_int {x:bv32}{y:int}
  (x: int (x), y: int (y)): int (udiv (x, bv32(y))) = "mac#%"

overload udiv with udiv_int_bv32_int_int

fun
eq_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x == y) = "mac#%"

overload = with eq_int_int_bv32

fun
eq_int_bv32_int_int {x:bv32} {y:int}
  (x: int(x), y: int(y)): bool (x == bv32(y)) = "mac#%"

overload = with eq_int_bv32_int_int

fun
lt_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x < y) = "mac#%"

overload < with lt_int_int_bv32

fun
lte_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x <= y) = "mac#%"

overload <= with lte_int_int_bv32

fun
gte_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x >= y) = "mac#%"

overload >= with gte_int_int_bv32

fun
gt_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): bool (x > y) = "mac#%"

overload > with gt_int_int_bv32

fun
gt_int_bv32_int_int {x:bv32} {y:int}
  (x: int (x), y: int (y)): bool (x > bv32(y)) = "mac#%"

overload > with gt_int_bv32_int_int

fun
land_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x land y) = "mac#%"

overload land with land_int_int_bv32

fun
land_int_bv32_int_int {x:bv32} {y:int} (
  x: int (x), y: int (y)
): int (x land bv32(y)) = "mac#%"

overload land with land_int_bv32_int_int

fun
lor_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x lor y) = "mac#%"

overload lor with lor_int_int_bv32

fun
lxor_int_int_bv32 {x,y:bv32}
  (x:int (x), y: int (y)): int (x lxor y) = "mac#%"

overload lxor with lxor_int_int_bv32

fun
lnot_int_bv32 {x:bv32}
  (x:int (x)): int (lnot x) = "mac#%"

overload lnot with lnot_int_bv32

fun
lnot_int_int {x:int}
  (x: int (x)): int (lnot (bv32(x))) = "mac#%"

overload lnot with lnot_int_int

fun
lshl_int_bv32_int {x,i:bv32}
  (x: int (x), i: int (i)): int (x << i) = "mac#%"

overload << with lshl_int_bv32_int

(**
  This may be a wrong assumption, but if our argument
  is signed, then shifting right incurs an arithmetic
  shift. Therefore, a logical shift is unavailable for
  signed integers.

  I'm basing this off of information I read about gcc's
  behavior for this case.
*)
fun
ashr_int_bv32_int {x,i:bv32}
  (x: int (x), i: int (i)): int (ashr(x, i)) = "mac#%"

overload >> with ashr_int_bv32_int

(**
  Unsigned ints.
*)
abst@ype uint_bv32 (bv:bv32) = uint
typedef uint (bv:bv32) = uint_bv32 (bv)

castfn
ubv32_of_uint {n:nat} (uint n): uint (bv32(n))

castfn
ubv32_of_bool {b:bool} (bool b): uint (bv32(b))

castfn
uint_of_bv32 {b:bv32} (uint b): uint (int_of_bv32(b))

fun
lshr_int_bv32_int {x,i:bv32}
  (x: uint (x), i: uint (i)): uint (lshr(x, i)) = "mac#%"

overload >> with lshr_int_bv32_int

fun
lshr_int_bv32_int_int {x:bv32}{i:int}
  (x: uint (x), i: uint (i)): uint (lshr(x, bv32(i))) = "mac#%"

overload >> with lshr_int_bv32_int_int

fun
neg_uint_bv32 {x:bv32}
  (x: uint(x)): uint (~x) = "mac#%"

overload ~ with neg_uint_bv32

fun
add_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x + y) = "mac#%"

overload + with add_uint_uint_bv32

fun
sub_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x - y) = "mac#%"

overload - with sub_uint_uint_bv32

fun
sub_uint_bv32_uint_uint {x:bv32} {y:int}
  (x:uint (x), y: uint (y)): uint (x - bv32(y)) = "mac#%"

overload - with sub_uint_bv32_uint_uint

fun
mul_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x * y) = "mac#%"

overload * with mul_uint_uint_bv32

fun
div_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x / y) = "mac#%"

overload / with div_uint_uint_bv32

fun
udiv_uint_uint_bv32 {x,y:bv32}
  (x: uint (x), y: uint (y)): uint (udiv (x, y)) = "mac#%"

overload udiv with udiv_uint_uint_bv32

fun
udiv_uint_bv32_uint_uint {x:bv32} {y:int}
  (x: uint (x), y: uint (y)): uint (udiv (x, bv32(y))) = "mac#%"

overload udiv with udiv_uint_bv32_uint_uint

fun
eq_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x == y) = "mac#%"

overload = with eq_uint_uint_bv32

fun
eq_uint_bv32_uint_uint {x:bv32} {y:int}
  (x: uint(x), y: uint(y)): bool (x == bv32(y)) = "mac#%"

overload = with eq_uint_bv32_uint_uint

fun
lt_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x < y) = "mac#%"

overload < with lt_uint_uint_bv32

fun
lte_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x <= y) = "mac#%"

overload <= with lte_uint_uint_bv32

fun
gte_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x >= y) = "mac#%"

overload >= with gte_uint_uint_bv32

fun
gt_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): bool (x > y) = "mac#%"

overload > with gt_uint_uint_bv32

fun
gt_uint_bv32_uint_uint {x:bv32} {y:int}
  (x: uint (x), y: uint (y)): bool (x > bv32(y)) = "mac#%"

overload > with gt_uint_bv32_uint_uint

fun
land_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x land y) = "mac#%"

overload land with land_uint_uint_bv32

fun
land_uint_bv32_uint_uint {x:bv32} {y:int} (
  x: uint (x), y: uint (y)
): uint (x land bv32(y)) = "mac#%"

overload land with land_uint_bv32_uint_uint

fun
lor_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x lor y) = "mac#%"

overload lor with lor_uint_uint_bv32

fun
lxor_uint_uint_bv32 {x,y:bv32}
  (x:uint (x), y: uint (y)): uint (x lxor y) = "mac#%"

overload lxor with lxor_uint_uint_bv32

fun
lnot_uint_bv32 {x:bv32}
  (x:uint (x)): uint (lnot x) = "mac#%"

overload lnot with lnot_uint_bv32 of 100

fun
lnot_uint_uint {x:int}
  (x: uint (x)): uint (lnot (bv32(x))) = "mac#%"

overload lnot with lnot_uint_uint of 100

fun
lshl_uint_bv32_uint {x,i:bv32}
  (x: uint (x), i: uint (i)): uint (x << i) = "mac#%"

overload << with lshl_uint_bv32_uint


Updating: very minorly improving

Updating: very minorly improving

(*
** For trying out some OOP ideas
*)

(* ****** ****** *)

(*
abstype symbol_type
typedef symbol = symbol_type
*)
typedef symbol = string

(* ****** ****** *)

abstype class_type = ptr
typedef class = class_type

(* ****** ****** *)

abstype class_vars = ptr
abstype class_methods = ptr

(* ****** ****** *)

abstype object_type = ptr
typedef object = object_type

(* ****** ****** *)

fun class_get_vars (class): class_vars
fun class_get_methods (class): class_methods

(* ****** ****** *)
//
fun object_new(class): object
//
fun object_new_int(int): object
fun object_new_float(double): object
fun object_new_string(string): object
//
(* ****** ****** *)

fun object_get_class(object): class
overload .class with object_get_class

(* ****** ****** *)
//
datatype value =
  | VALnil of ()
  | VALint of int
  | VALfloat of double
  | VALstring of string
  | VALobject of object
//
(*
  | {a:type} VALboxed of (a)
*)
//
typedef valuelst = List0 (value)
//
(* ****** ****** *)
//
datatype method =
  | MTDnil of ()
  | MTDfun of (valuelst -> value)
  | MTDclo of (valuelst -<cloref1> value)
//
(* ****** ****** *)
//
fun print_value : value -> void
fun fprint_value: fprint_type(value)
//
fun print_object : object -> void
fun fprint_object: fprint_type(object)
//
overload print with print_value
overload fprint with fprint_value
//
overload print with print_object
overload fprint with fprint_object
//
(* ****** ****** *)
//
fun
class_getmtd(class, symbol): method
fun
class_setmtd(class, symbol, m0: method): bool
//
(* ****** ****** *)
//
fun
object_getvar(object, symbol): value
fun
object_setvar(object, symbol, v0: value): bool
//
(* ****** ****** *)

fun
object_evalmsg(object, symbol, valuelst): value

(* ****** ****** *)

fun theEnv_get_class(symbol): Option_vt(class)

(* ****** ****** *)

(* end of [OOPLATS.sats] *)

(*
** For trying out some OOP ideas
*)

(* ****** ****** *)

(*
abstype symbol_type
typedef symbol = symbol_type
*)
typedef symbol = string

(* ****** ****** *)

abstype class_type = ptr
typedef class = class_type

(* ****** ****** *)

abstype class_vars = ptr
abstype class_methods = ptr

(* ****** ****** *)

abstype object_type = ptr
typedef object = object_type

(* ****** ****** *)

fun class_get_vars (class): class_vars
fun class_get_methods (class): class_methods

(* ****** ****** *)
//
fun object_new(class): object
//
fun object_new_int(int): object
fun object_new_float(double): object
fun object_new_string(string): object
//
(* ****** ****** *)

fun object_get_class(object): class
overload .class with object_get_class

(* ****** ****** *)
//
datatype value =
  | VALnil of ()
  | VALint of int
  | VALfloat of double
  | VALstring of string
  | VALobject of object
//
typedef valuelst = List0 (value)
//
(* ****** ****** *)
//
datatype method =
  | MTDnil of ()
  | MTDfun of (valuelst -> value)
  | MTDclo of (valuelst -<cloref1> value)
//
(* ****** ****** *)
//
fun print_value : value -> void
fun fprint_value: fprint_type(value)
//
fun print_object : object -> void
fun fprint_object: fprint_type(object)
//
overload print with print_value
overload fprint with fprint_value
//
overload print with print_object
overload fprint with fprint_object
//
(* ****** ****** *)
//
fun
class_getmtd(class, symbol): method
fun
class_setmtd(class, symbol, m0: method): bool
//
(* ****** ****** *)
//
fun
object_getvar(object, symbol): value
fun
object_setvar(object, symbol, v0: value): bool
//
(* ****** ****** *)

fun
object_evalmsg(object, symbol, valuelst): value

(* ****** ****** *)

fun theEnv_get_class(symbol): Option_vt(class)

(* ****** ****** *)

(* end of [OOPLATS.sats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
**
** HX-2014-09-14:
** [weboxy] is a small package that
** does webpage layout by generating CSS;
** it also generats HTML for reviewing purpose
**
*)

(* ****** ****** *)
//
abstype
charptr = $extype"atstype_string"
//
(* ****** ****** *)

abstype webox_type = ptr
typedef webox = webox_type
typedef weboxlst = List (webox)
typedef weboxopt = Option (webox)

(* ****** ****** *)

typedef color = string

(* ****** ****** *)

fun randcolor ((*void*)): color
fun randcolor_initize ((*void*)): void

(* ****** ****** *)

datatype
tabstyle =
  | TSnone of () | TShbox of () | TSvbox of ()
// end of [tabstyle]

(* ****** ****** *)
//
fun tabstyle_isbox (ts: tabstyle): bool
fun tabstyle_ishbox (ts: tabstyle): bool
fun tabstyle_isvbox (ts: tabstyle): bool
//
overload .isbox with tabstyle_isbox
overload .ishbox with tabstyle_ishbox
overload .isvbox with tabstyle_isvbox
//
(* ****** ****** *)
//
#define UID "uid"
#define NAME "name"
//
#define WIDTH "width"
#define PWIDTH "pwidth"
//
#define HEIGHT "height"
#define PHEIGHT "pheight"
//
#define COLOR "color"
#define BGCOLOR "bgcolor"
//
#define PARENT "parent"
#define CHILDREN "children"
//
#define TABSTYLE "tabstyle"
#define PERCENTLST "percentlst"
//
#define CONTENT "content"
//
(* ****** ****** *)
//
// HX-2014-09-13:
// uid: unique indentification
//
fun{}
webox_get_uid (webox): int
//
// HX-2014-09-13:
// name: name given by the user
//
fun{}
webox_get_name (webox): string
//
overload .uid with webox_get_uid
overload .name with webox_get_name
//
(* ****** ****** *)
//
fun{}
webox_get_width (webox): int
fun{}
webox_set_width (webox, width: int): void
//
overload .width with webox_get_width
overload .width with webox_set_width
//
(* ****** ****** *)
//
// HX: p...: percentage
//
fun{}
webox_get_pwidth (webox): int
fun{}
webox_set_pwidth (webox, pwidth: int): void
//
overload .pwidth with webox_get_pwidth
overload .pwidth with webox_set_pwidth
//
(* ****** ****** *)
//
fun{}
webox_get_height (webox): int
fun{}
webox_set_height (webox, height: int): void
//
overload .height with webox_get_height
overload .height with webox_set_height
//
(* ****** ****** *)
//
// HX: p...: percentage
//
fun{}
webox_get_pheight (webox): int
fun{}
webox_set_pheight (webox, pheight: int): void
//
overload .pheight with webox_get_pheight
overload .pheight with webox_set_pheight
//
(* ****** ****** *)
//
fun{}
webox_get_color (webox): color
fun{}
webox_set_color (webox, c: color): void
//
overload .color with webox_get_color
overload .color with webox_set_color
//
(* ****** ****** *)
//
fun{}
webox_get_bgcolor (webox): color
fun{}
webox_set_bgcolor (webox, c: color): void
//
overload .bgcolor with webox_get_bgcolor
overload .bgcolor with webox_set_bgcolor
//
(* ****** ****** *)
//
fun{}
webox_isrt (x: webox): bool
fun{}
webox_get_parent (webox): weboxopt
fun{}
webox_set_parent (webox, opt: weboxopt): void
//
overload .isrt with webox_isrt
overload .parent with webox_get_parent
overload .parent with webox_set_parent
//
(* ****** ****** *)
//
fun{}
webox_get_children (webox): weboxlst
fun{}
webox_set_children (webox, xs: weboxlst): void
fun{}
webox_set_children_1 (webox, x: webox): void
fun{}
webox_set_children_2 (webox, x1: webox, x2: webox): void
fun{}
webox_set_children_3 (webox, x1: webox, x2: webox, x3: webox): void
//
overload .children with webox_get_children
overload .children with webox_set_children
overload .children with webox_set_children_1
overload .children with webox_set_children_3
overload .children with webox_set_children_2
//
(* ****** ****** *)
//
fun{}
webox_get_tabstyle (webox): tabstyle
fun{}
webox_set_tabstyle (webox, sty: tabstyle): void
//
overload .tabstyle with webox_get_tabstyle
overload .tabstyle with webox_set_tabstyle
//
(* ****** ****** *)
//
fun{}
webox_get_percentlst (webox): List0(int)
fun{}
webox_set_percentlst (webox, pcs: List(int)): void
//
overload .percentlst with webox_get_percentlst
overload .percentlst with webox_set_percentlst
//
(* ****** ****** *)
//
fun{}
percentlst_get_at (pcs: List0(int), i: intGte(0)): int
//
(* ****** ****** *)
//
fun{}
webox_get_content (webox): string
fun{}
webox_set_content (webox, content: string): void
//
overload .content with webox_get_content
overload .content with webox_set_content
//
(* ****** ****** *)
//
fun
webox0_make ((*void*)): webox
//
fun{}
webox_make ((*void*)): webox
fun{}
webox_make_name (name: string): webox
fun{}
webox_make_name_width (name: string, width: int): webox
fun{}
webox_make_name_pwidth (name: string, pwidth: int): webox
//
(* ****** ****** *)

fun{}
fprint_webox_width (out: FILEref, wbx: webox): void

(* ****** ****** *)

fun{}
fprint_webox_height (out: FILEref, wbx: webox): void

(* ****** ****** *)

fun{}
fprint_webox_color (out: FILEref, wbx: webox): void
fun{}
fprint_webox_bgcolor (out: FILEref, wbx: webox): void

(* ****** ****** *)

fun{}
fprint_css_preamble (out: FILEref): void
fun{}
fprint_css_postamble (out: FILEref): void

(* ****** ****** *)

fun{}
fprint_webox_css_one (out: FILEref, webox): void
fun{}
fprint_webox_css_all (out: FILEref, webox): void
fun{}
fprint_weboxlst_css_all (out: FILEref, weboxlst): void

(* ****** ****** *)

fun{}
fprint_webox_head_beg (out: FILEref): void
fun{}
fprint_webox_head_end (out: FILEref): void

(* ****** ****** *)

fun{}
fprint_webox_body_end (out: FILEref): void
fun{}
fprint_webox_body_after (out: FILEref): void

(* ****** ****** *)

fun{}
fprint_webox_html_all (out: FILEref, webox): void

(* ****** ****** *)

(* end of [weboxy.sats] *)

(*
**
** HX-2014-09-14:
** [weboxy] is a small package that
** does webpage layout by generating CSS;
** it also generats HTML for reviewing purpose
**
*)

(* ****** ****** *)
//
%{#
//
#ifdef CHARPTR
#define CHARPTR
typedef char *charptr ;
#endif // #ifndef
//
%} ; // end of [%{#]
//
abstype charptr = $extype"charptr"
//
(* ****** ****** *)

abstype webox_type = ptr
typedef webox = webox_type
typedef weboxlst = List (webox)
typedef weboxopt = Option (webox)

(* ****** ****** *)

typedef color = string

(* ****** ****** *)

fun randcolor ((*void*)): color
fun randcolor_initize ((*void*)): void

(* ****** ****** *)

datatype
tabstyle =
  | TSnone of () | TShbox of () | TSvbox of ()
// end of [tabstyle]

(* ****** ****** *)
//
fun tabstyle_isbox (ts: tabstyle): bool
fun tabstyle_ishbox (ts: tabstyle): bool
fun tabstyle_isvbox (ts: tabstyle): bool
//
overload .isbox with tabstyle_isbox
overload .ishbox with tabstyle_ishbox
overload .isvbox with tabstyle_isvbox
//
(* ****** ****** *)
//
#define UID "uid"
#define NAME "name"
//
#define WIDTH "width"
#define PWIDTH "pwidth"
//
#define HEIGHT "height"
#define PHEIGHT "pheight"
//
#define COLOR "color"
#define BGCOLOR "bgcolor"
//
#define PARENT "parent"
#define CHILDREN "children"
//
#define TABSTYLE "tabstyle"
#define PERCENTLST "percentlst"
//
#define CONTENT "content"
//
(* ****** ****** *)
//
// HX-2014-09-13:
// uid: unique indentification
//
fun{}
webox_get_uid (webox): int
//
// HX-2014-09-13:
// name: name given by the user
//
fun{}
webox_get_name (webox): string
//
overload .uid with webox_get_uid
overload .name with webox_get_name
//
(* ****** ****** *)
//
fun{}
webox_get_width (webox): int
fun{}
webox_set_width (webox, width: int): void
//
overload .width with webox_get_width
overload .width with webox_set_width
//
(* ****** ****** *)
//
// HX: p...: percentage
//
fun{}
webox_get_pwidth (webox): int
fun{}
webox_set_pwidth (webox, pwidth: int): void
//
overload .pwidth with webox_get_pwidth
overload .pwidth with webox_set_pwidth
//
(* ****** ****** *)
//
fun{}
webox_get_height (webox): int
fun{}
webox_set_height (webox, height: int): void
//
overload .height with webox_get_height
overload .height with webox_set_height
//
(* ****** ****** *)
//
// HX: p...: percentage
//
fun{}
webox_get_pheight (webox): int
fun{}
webox_set_pheight (webox, pheight: int): void
//
overload .pheight with webox_get_pheight
overload .pheight with webox_set_pheight
//
(* ****** ****** *)
//
fun{}
webox_get_color (webox): color
fun{}
webox_set_color (webox, c: color): void
//
overload .color with webox_get_color
overload .color with webox_set_color
//
(* ****** ****** *)
//
fun{}
webox_get_bgcolor (webox): color
fun{}
webox_set_bgcolor (webox, c: color): void
//
overload .bgcolor with webox_get_bgcolor
overload .bgcolor with webox_set_bgcolor
//
(* ****** ****** *)
//
fun{}
webox_isrt (x: webox): bool
fun{}
webox_get_parent (webox): weboxopt
fun{}
webox_set_parent (webox, opt: weboxopt): void
//
overload .isrt with webox_isrt
overload .parent with webox_get_parent
overload .parent with webox_set_parent
//
(* ****** ****** *)
//
fun{}
webox_get_children (webox): weboxlst
fun{}
webox_set_children (webox, xs: weboxlst): void
fun{}
webox_set_children_1 (webox, x: webox): void
fun{}
webox_set_children_2 (webox, x1: webox, x2: webox): void
fun{}
webox_set_children_3 (webox, x1: webox, x2: webox, x3: webox): void
//
overload .children with webox_get_children
overload .children with webox_set_children
overload .children with webox_set_children_1
overload .children with webox_set_children_3
overload .children with webox_set_children_2
//
(* ****** ****** *)
//
fun{}
webox_get_tabstyle (webox): tabstyle
fun{}
webox_set_tabstyle (webox, sty: tabstyle): void
//
overload .tabstyle with webox_get_tabstyle
overload .tabstyle with webox_set_tabstyle
//
(* ****** ****** *)
//
fun{}
webox_get_percentlst (webox): List0(int)
fun{}
webox_set_percentlst (webox, pcs: List(int)): void
//
overload .percentlst with webox_get_percentlst
overload .percentlst with webox_set_percentlst
//
(* ****** ****** *)
//
fun{}
percentlst_get_at (pcs: List0(int), i: intGte(0)): int
//
(* ****** ****** *)
//
fun{}
webox_get_content (webox): string
fun{}
webox_set_content (webox, content: string): void
//
overload .content with webox_get_content
overload .content with webox_set_content
//
(* ****** ****** *)
//
fun
webox0_make ((*void*)): webox
//
fun{}
webox_make ((*void*)): webox
fun{}
webox_make_name (name: string): webox
fun{}
webox_make_name_width (name: string, width: int): webox
fun{}
webox_make_name_pwidth (name: string, pwidth: int): webox
//
(* ****** ****** *)

fun{}
fprint_webox_width (out: FILEref, wbx: webox): void

(* ****** ****** *)

fun{}
fprint_webox_height (out: FILEref, wbx: webox): void

(* ****** ****** *)

fun{}
fprint_webox_color (out: FILEref, wbx: webox): void
fun{}
fprint_webox_bgcolor (out: FILEref, wbx: webox): void

(* ****** ****** *)

fun{}
fprint_css_preamble (out: FILEref): void
fun{}
fprint_css_postamble (out: FILEref): void

(* ****** ****** *)

fun{}
fprint_webox_css_one (out: FILEref, webox): void
fun{}
fprint_webox_css_all (out: FILEref, webox): void
fun{}
fprint_weboxlst_css_all (out: FILEref, weboxlst): void

(* ****** ****** *)

fun{}
fprint_webox_head_beg (out: FILEref): void
fun{}
fprint_webox_head_end (out: FILEref): void

(* ****** ****** *)

fun{}
fprint_webox_body_end (out: FILEref): void
fun{}
fprint_webox_body_after (out: FILEref): void

(* ****** ****** *)

fun{}
fprint_webox_html_all (out: FILEref, webox): void

(* ****** ****** *)

(* end of [weboxy.sats] *)


Updating: very minorly improving

Updating: very minorly improving

(*
** For writing ATS code
** that translates into JavaScript
*)

(* ****** ****** *)
//
// HX-2014-08:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2jspre_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)

staload "./../basics_js.sats"

(* ****** ****** *)
//
#include "{$LIBATSCC}/SATS/gvalue.sats"
//
(* ****** ****** *)
//
datatype gvalue =
//
  | GVnil of ()
//
  | GVint of (int)
//
  | GVbool of (bool)
//
  | GVfloat of (double)
//
  | GVstring of (string)
//
  | GVobject of (JSobj)
//
  | GVlist of gvlist
  | GVarray of gvarray
  | GVhashtbl of gvhashtbl
//
(* ****** ****** *)
//
fun gvalue_nil(): gvalue = "mac#%"
//
fun gvalue_int(int): gvalue = "mac#%"
//
fun gvalue_bool(bool): gvalue = "mac#%"
//
fun gvalue_float(double): gvalue = "mac#%"
//
fun gvalue_string(string): gvalue = "mac#%"
//
(* ****** ****** *)
//
fun
gvhashtbl_get_atkey
  (tbl: gvhashtbl, k: string): gvalue = "mac#%"
fun
gvhashtbl_set_atkey
  (tbl: gvhashtbl, k: string, x: gvalue): void = "mac#%"
fun
gvhashtbl_exch_atkey
  (tbl: gvhashtbl, k: string, x: gvalue): gvalue = "mac#%"
//
(* ****** ****** *)
//
overload [] with gvhashtbl_get_atkey
overload [] with gvhashtbl_set_atkey
//
(* ****** ****** *)

(* end of [gvalue.sats] *)

(*
** For writing ATS code
** that translates into JavaScript
*)

(* ****** ****** *)
//
// HX-2014-08:
// prefix for external names
//
#define
ATS_EXTERN_PREFIX "ats2jspre_"
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)

staload "./../basics_js.sats"

(* ****** ****** *)
//
#include "{$LIBATSCC}/SATS/gvalue.sats"
//
(* ****** ****** *)
//
datatype gvalue =
//
  | GVnil of ()
//
  | GVint of (int)
//
  | GVbool of (bool)
//
  | GVfloat of (double)
//
  | GVstring of (string)
//
  | GVlist of gvlist
  | GVarray of gvarray
  | GVhashtbl of gvhashtbl
//
(* ****** ****** *)
//
fun gvalue_nil(): gvalue = "mac#%"
//
fun gvalue_int(int): gvalue = "mac#%"
//
fun gvalue_bool(bool): gvalue = "mac#%"
//
fun gvalue_float(double): gvalue = "mac#%"
//
fun gvalue_string(string): gvalue = "mac#%"
//
(* ****** ****** *)
//
fun
gvhashtbl_get_atkey
  (tbl: gvhashtbl, k: string): gvalue = "mac#%"
fun
gvhashtbl_set_atkey
  (tbl: gvhashtbl, k: string, x: gvalue): void = "mac#%"
fun
gvhashtbl_exch_atkey
  (tbl: gvhashtbl, k: string, x: gvalue): gvalue = "mac#%"
//
(* ****** ****** *)
//
overload [] with gvhashtbl_get_atkey
overload [] with gvhashtbl_set_atkey
//
(* ****** ****** *)

(* end of [gvalue.sats] *)


Updating: very very minorly

Updating: very very minorly

(* ****** ****** *)
//
// CATS-parsemit
//
(* ****** ****** *)
//
// HX-2014-07-02: start
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

staload UN = $UNSAFE

(* ****** ****** *)

staload "./catsparse.sats"
staload "./catsparse_parsing.sats"

(* ****** ****** *)
//
implement abort() =
  let val () = ($raise(FatalErrorExn())): void in () end
//
(* ****** ****** *)

(* end of [catsparse_error.dats] *)

(* ****** ****** *)
//
// CATS-parsemit
//
(* ****** ****** *)
//
// HX-2014-07-02: start
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

staload UN = $UNSAFE

(* ****** ****** *)

staload "./catsparse.sats"
staload "./catsparse_parsing.sats"

(* ****** ****** *)

implement abort() = $raise(FatalErrorExn())

(* ****** ****** *)

(* end of [catsparse_error.dats] *)