{-# LANGUAGE OverloadedStrings #-} module Funcons.Operations.Tuples where import Funcons.Operations.Internal library :: HasValues t => Library t library = libFromList [ ("tuples", NaryExpr tuples_) , ("tuple", NaryExpr tuple_) , ("tuple-index", BinaryExpr tuple_index) , ("empty-tuple", NullaryExpr empty_tuple) , ("tuple-prepend", BinaryExpr tuple_prepend) ] tuples_ :: HasValues t => [OpExpr t] -> OpExpr t tuples_ = NaryOp "tuples" (Normal . injectT . ADT "tuples") empty_tuple_, tuple_prepend_ :: HasValues t => [OpExpr t] -> OpExpr t empty_tuple_ = nullaryOp empty_tuple tuple_prepend_ = binaryOp tuple_prepend empty_tuple :: HasValues t => OpExpr t empty_tuple = vNullaryOp "empty-tuple" (Normal $ inject (tuple [])) tuple_prepend :: HasValues t => OpExpr t -> OpExpr t -> OpExpr t tuple_prepend = vBinaryOp "tuple-prepend" op where op v (ADTVal "tuple" vs) = Normal $ inject (ADTVal "tuple" (inject v : vs)) op _ _ = SortErr "tuple-prepend not applied to a value and a tuple" tuple_ :: HasValues t => [OpExpr t] -> OpExpr t tuple_ = vNaryOp "tuple" op where op ys = Normal $ inject (tuple ys) tuple_index_ :: HasValues t => [OpExpr t] -> OpExpr t tuple_index_ = binaryOp tuple_index tuple_index :: HasValues t => OpExpr t -> OpExpr t -> OpExpr t tuple_index = vBinaryOp "tuple-index" op where op (ADTVal "tuple" ts) v | Nat n' <- upcastNaturals v, let n :: Int; n = fromInteger n' = case () of () | n >= 1 && n <= length ts -> Normal $ ts !! (n - 1) _ -> SortErr "tuple-index not in range" | otherwise = SortErr ("tuple-index not applied to a natural number: " ++ ppValues (const "_") v) op _ _ = SortErr "tuple-index not applied to a tuple"