-- An example for the use of plural arguments:
-- An expression parser which has the possible operators as a plural argument.
-- This version does not use the standard parser combinators
-- in order to avoid the use of higher-order features and logic variables.

import Plural

data Nat = Z | S Nat

data List a = Nil | Cons a (List a)

add Z x = x
add (S x) y = S (add x y)

mult Z _ = Z
mult (S x) y = add y (mult x y)

two = S (S Z)
four = add two two
six  = add four two
eight = add four four
ten = add eight two
n12 = add eight four
n16 = add eight eight
n20 = add n16 four 
n32 = add n16 n16 
n256 = mult n16 n16 
n1024 = mult four n256

-----------------------------------------------------------------

-- This operation ensures that the argument is an empty list.
isNil :: List a -> Bool
isNil Nil = True

ifThen :: Bool -> a -> a
ifThen True x = x

-- An alternative definition of a number parser without
-- higher-order functions, logic variables etc:
number :: Plural Char -> List Char -> List Char
number d (Cons x xs) = ifThen (x==d) (numberStar (d?'0') xs)

numberStar :: Plural Char -> List Char -> List Char
numberStar _ xs = xs
numberStar d (Cons x xs) = ifThen (x==d) (numberStar d xs)

decNzDigit = '1'?'2'?'3'?'4'?'5'?'6'?'7'?'8'?'9'
decNum = number decNzDigit

main1 = isNil (decNum (Cons '1' (Cons '2' (Cons '0' Nil))))

-- An alternative definition of an expression parser without
-- higher-order functions, logic variables etc:
exp :: Plural Char -> Plural Char -> List Char -> List Char
exp digit _ xs = number digit xs
exp digit op (Cons x xs) = ifThen (x=='(') (exp1 digit op (exp digit op xs))

exp1 :: Plural Char -> Plural Char -> List Char -> List Char
exp1 digit op (Cons x xs) = ifThen (x==op) (exp2 (exp digit op xs))

exp2 :: List Char -> List Char
exp2 (Cons x xs) = ifThen (x==')') xs

natOp = '+' ? '-' ? '*' ? '%'
natExp = exp decNzDigit natOp

main2 = isNil (natExp (Cons '(' (Cons '1' (Cons '2'
                         (Cons '*' (Cons '4' (Cons '0' (Cons ')' Nil))))))))

-----------------------------------------------------------------
-- Generate test data:

len Nil = 0
len (Cons _ xs) = 1 + len xs

genNum Z xs = Cons '1' (Cons '2' (Cons '0' (Cons '2' (Cons '0' xs))))
genNum (S n) xs = genNum n (genNum n xs)

mnum n = isNil (decNum (genNum n Nil))

mnum3 = mnum (S Z) -- len: 10      time: 0
mnum4 = mnum two   -- len: 20      time: 0
mnum5 = mnum four  -- len: 80      time: 5ms
mnum6 = mnum six   -- len: 320     time: 50ms
mnum7 = mnum eight -- len: 1280    time: 640ms
mnum8 = mnum ten   -- len: 5120    time: 10100ms


genExp Z xs = Cons '1' (Cons '2' (Cons '0' xs))
genExp (S n) xs = Cons '(' (genExp n (Cons '*' (genExp n (Cons ')' xs))))

main n = isNil (natExp (genExp n Nil))

main3 = main (S Z) -- len: 9       time: 0
main4 = main two   -- len: 21      time: 0
main5 = main four  -- len: 93      time: 0ms
main6 = main eight -- len: 1533    time: 30ms
main7 = main ten   -- len: 6141    time: 120ms
main8 = main n12   -- len: 24573   time: 520ms
main9 = main n16   -- len: 393213  time: 9700ms