{-# LANGUAGE OverloadedStrings #-}

module Funcons.Operations.Atoms where

import Funcons.Operations.Internal

library :: (HasValues t, Eq t) => Library t
library :: Library t
library = [(OP, ValueOp t)] -> Library t
forall t. [(OP, ValueOp t)] -> Library t
libFromList [
    (OP
"atoms", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
atoms)
  , (OP
"next-atom", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
next_atom)
  , (OP
"atom-seed", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
atom_seed)
  , (OP
"atom", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
atom)
  ]

atom_seed_ :: HasValues t => [OpExpr t] -> OpExpr t
atom_seed_ :: [OpExpr t] -> OpExpr t
atom_seed_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
atom_seed 
atom_seed :: HasValues t => OpExpr t
atom_seed :: OpExpr t
atom_seed = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"atom-seed" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ OP -> Values t
forall t. OP -> Values t
Atom OP
"0")

next_atom_ :: HasValues t => [OpExpr t] -> OpExpr t
next_atom_ :: [OpExpr t] -> OpExpr t
next_atom_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
next_atom
next_atom :: HasValues t => OpExpr t -> OpExpr t
next_atom :: OpExpr t -> OpExpr t
next_atom = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"next-atom" UnaryVOp t
forall t t. HasValues t => Values t -> Result t
op
  where op :: Values t -> Result t
op (Atom OP
a) = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ OP -> Values t
forall t. OP -> Values t
Atom (Int -> OP
forall a. Show a => a -> OP
show (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
          where i::Int
                i :: Int
i = OP -> Int
forall a. Read a => OP -> a
read OP
a
        op Values t
_ = OP -> Result t
forall t. OP -> Result t
SortErr OP
"next-atom not applied to an atom"

atoms_ :: HasValues t => [OpExpr t] -> OpExpr t
atoms_ :: [OpExpr t] -> OpExpr t
atoms_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
atoms
atoms :: HasValues t => OpExpr t
atoms :: OpExpr t
atoms = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"atoms" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT Types t
forall t. Types t
Atoms)

atom_ :: HasValues t => [OpExpr t] -> OpExpr t
atom_ :: [OpExpr t] -> OpExpr t
atom_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
atom

atom :: HasValues t => OpExpr t -> OpExpr t
atom :: OpExpr t -> OpExpr t
atom = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"atom" UnaryVOp t
forall t t. (HasValues t, HasValues t) => Values t -> Result t
op
  where op :: Values t -> Result t
op Values t
v | Values t -> Bool
forall t. HasValues t => Values t -> Bool
isString_ Values t
v = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ OP -> Values t
forall t. OP -> Values t
Atom (Values t -> OP
forall t. HasValues t => Values t -> OP
unString Values t
v)
             | Bool
otherwise   = OP -> Result t
forall t. OP -> Result t
SortErr OP
"atom not applied to a string"