module TestPrims // module declaration

imports
  Prelude // import declaration.  pulls in the declarations from Prelude.pec

where

// single line comment

/*
  multi-line comment
  /*
    nests properly
  */
*/

// some top-level declarations.
// macro decls (i.e. the ones with the "=>") are simply inlined

// "do" notation, similar to haskell
// in pec it is syntactic sugar for let [v=e] in r
// where r is the "return" value
// note the 0 at the end

main :: () -> I32
// main has type function of () to W32
// where () is the type 'unit' (similar to void in C)
main () = do // unit pattern match
  putLn "starting test..."
  testChar () // procedure call.  calls are made using juxtaposition like in Haskell, not tupling like in C
  testI32 ()
  testW16 ()
  testBool ()
  testIString ()
  testDouble ()
  putLn "...test complete"
  0

gchar :: Char // type signature like in Haskell
gchar => 'a'
    // char literal
    // chars are type char, not ints like in C

gi32 :: I32 // 32 bit integer
gi32 => (3 :: I32) // type ascription
// pec can have arbitrary sized ints and uints, like in llvm

gw16 => (12 :: W16) // 16 bit word (unsigned int)
gw16_2 => gw16 + 1

gbool :: Bool // boolean type
gbool => True
// booleans aren't primitive, they are defined in Prelude.pec

gistring :: IString
gistring => "global istring"
// string literals are IStrings, immutable strings

gSideEffect :: Bool
gSideEffect => do
  putLn "side effect" // print an IString to the screen
  True
// pec is impure.
// This definition will get inlined.

testI32 :: () -> ()
testI32 () = do
  putLn "testI32"
  assert (gi32 == 3) // assert is just a library function
  assert ((0 :: I32) == 0) // type ascription
  assert (0xFF == (0o377 :: I32))
  assert (0Xff == (0b11111111 :: I32))
  putLn "done"

testDouble :: () -> ()
testDouble () = do
  putLn "testDouble"
  assert ((0 :: Double) >= 0x0)
  assert (((-1) :: Float) >= (-1.0))
// broken in llvm version:  assert (((-1) :: Float) >= (-1.1))
  assert (((-1) :: Float) >= (-1.25))
  assert (((-0.1) :: Double) < (-0.0))
  assert ((10e-2 :: Double) >= (-9.1e-1))
  assert (gi32 == 3)
  putLn "done"

testW16 :: () -> ()
testW16 () = do
  putLn "testW16"
  assert ((0 :: W16) == 0)
  x = (4 :: W16) // name binding
// names in pec are single static assignment (SSA)
// i.e. x has a constant value

// like a C switch statement
  switch x of
    4 -> assert True // pattern on the left, expression on the right
    _ -> assert False // default

  switch (7 :: W16) of // type ascription can be most anywhere
    4 -> assert False
    7 -> assert True
    _ -> assert False

  p = new (3 :: W16) // 'new' allocates memory on the stack and stores the given value there.  p :: Ptr W16

  switch @p of // '@' is the load operator.  It returns the value stored at the given location.
    3 -> assert True
    _ -> assert False

  p <- 12 // '<-' is the store operator.  It takes a value and stores it at the given location.

  switch @p of
    3 -> assert False
    x -> assert (x == 12)

  assert (gw16 == 12)
  assert (gw16_2 == 13)
  assert ((1 << 1) == (2 :: W16)) // left shift operator

// branch expression.  like switch except each arm has a boolean operator.
// Its purpose in life is to reduce the number of nested ifs.
  branch
    @p < 3 -> assert False // boolean expression on the left, value on the right
    False -> assert False
    | assert True // all branch expressions must have a default

  putLn "done"

testBool :: () -> ()
testBool () = do
  putLn "testBool"
  assert True
  assert (not False)
  assert (True == True)
  assert (gbool == True)
  assert gSideEffect // will output to the screen
  assert gSideEffect // will also output to the screen
  x = gSideEffect // will output to the screen
// x is evaluated immediately
  assert x // won't output anything
  assert x // won't output anything
  putLn "done"

testIString :: () -> ()
testIString () = do
  putLn "testIString"
  assert ("hi" == "hi")
  assert (gistring == "global istring")
  switch "hi" of
    "bye" -> assert False
    "hi" -> assert True
    s -> do // default pattern match, so that we can use the switch scrutinee
      putLn s
      assert False
  s = "blah" // at a different scope than the previous "s".  This feature might be removed in the future.
  switch s of
    "blah" -> assert (s == "blah")
    _ -> assert False
  putLn "done"

type MyChar a = Char // polymorphic type

getT :: () -> Char
getT (()) = 'T' // same as getT (), just getting coverage on that pattern

funptr :: (Char -> Bool) -> Char -> Bool // type of a function that takes a function argument, a character, and returns a bool
funptr f c = f c

funptr2 :: (Char -> Char) -> Char -> Char
funptr2 f c = f c

testChar :: () -> ()
testChar () = do // character literals
  putLn "testChar"
  assert (is_lower 'a')
  assert (is_upper 'A')
  assert (gchar == 'a')
  putCh 't'

  if ('m' == 'm') (putCh 't') (putCh 'f')

  switch 'm' of
    'n' -> putCh 'n'
    'm' -> putCh 't'
    v -> putCh v
    
  switch 't' of
    'm' -> putCh 'm'
    'n' -> putCh 'n'
    v -> putCh v
    
  x = 't'
  putCh x

  if (x != 'm') (putCh 't') (putCh 'f')

  switch x of
    'm' -> putCh 'm'
    'n' -> putCh 'n'
    v -> putCh v
    
  p = new 't'
  
  putCh @p

  if (@p == 'm')
    (putCh 'f')
    (putCh 't')

  switch @p of
    'm' -> putCh 'm'
    'n' -> putCh 'n'
    v -> do
      putCh @p
      putCh v
  
  p <- 'T'

  putCh @p

  assert (@p == 'T')

  putCh @p
  
  p <- x
  
  putCh @p
  
  p <- @p
  
  putCh @p
  
  p <- switch 'l' of
    'l' -> 't'
    'n' -> 'n'
    _ -> 'a'
  
  putCh @p
  
  p <- getT ()
  
  putCh @p

  let c = ('a' :: MyChar W32) in putCh c // let expression

  (v) = 'c' // parens used for grouping
  putCh v
  assert (is_lower v)
  putCh (to_upper v)
  putCh (to_lower (to_upper @p))
  assert (is_upper (to_upper v))
  assert (funptr is_lower 'c') // making a call using a function pointer
  assert (funptr is_upper 'C') // again, but with different arguments
  w = funptr2 to_lower 'A'
  x = funptr2 to_upper 'a'
  putCh w
  putCh x
  assert (is_lower w)
  assert (is_upper x)
  putCh '\n'
  f = pickfun True
  assert (f 'a')
  g = pickfun False
  assert (g 'B')
  putLn "done"

pickfun :: Bool -> (Char -> Bool) // returning a function
pickfun x = if x is_lower is_upper