plunder

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

Types.hs (4395B)

      1 -- Copyright 2023 The Plunder Authors
      2 -- Use of this source code is governed by a BSD-style license that can be
      3 -- found in the LICENSE file.
      4 
      5 {-# LANGUAGE NoFieldSelectors    #-}
      6 {-# LANGUAGE OverloadedRecordDot #-}
      7 {-# OPTIONS_GHC -Wall        #-}
      8 {-# OPTIONS_GHC -Werror      #-}
      9 {-# OPTIONS_GHC -Wno-orphans #-}
     10 
     11 module Fan.Types
     12     ( Fan(..)
     13     , Any
     14     , PrimopCrash(..)
     15     , Nat
     16     , Pin(..)
     17     , Law(..)
     18     , LawName(..)
     19     , Rex
     20     , setExec
     21     , toNat
     22     , Prog(..)
     23     , Run(..)
     24     , Hash256
     25     , JetEdgeCase(..)
     26     , RtsConfig(..)
     27     )
     28 where
     29 
     30 import PlunderPrelude hiding (hash, (^))
     31 import Data.Sorted
     32 
     33 import Hash256     (Hash256)
     34 import Rex         (GRex)
     35 
     36 import qualified Data.Vector.Storable as SV
     37 
     38 -- Types -----------------------------------------------------------------------
     39 
     40 data JetEdgeCase = IGNORE | WARN | CRASH
     41   deriving (Eq, Ord, Read, Show)
     42 
     43 data RtsConfig = RTS_CONFIG
     44     { onJetFallback :: !JetEdgeCase
     45     , onJetMismatch :: !JetEdgeCase
     46     }
     47 
     48 data PrimopCrash = PRIMOP_CRASH { errCode :: !Nat, errVal :: !Fan }
     49 
     50 {-
     51     Note that `code` is lazy.  We don't "compile" it until it is
     52     first run.
     53 -}
     54 data Law = L
     55     { name :: !LawName
     56     , args :: !Nat
     57     , body :: !Fan
     58     , code :: Prog
     59     }
     60 
     61 -- All data already forced upon construction.
     62 instance NFData Law where rnf = \L{} -> ()
     63 
     64 newtype LawName = LN { nat :: Nat }
     65   deriving newtype (Eq, Ord, NFData)
     66 
     67 {-
     68     -   `hash` is the BLAKE3 hash of the concatenation of the jelly head
     69         and jelly body.
     70 
     71     -   `refs` is all the pins that we reference, in noun-traversal order.
     72         This corresponds directly to the pin length and order used in Jelly
     73         save.
     74 
     75      TODO Use on-heap data for hash and blob (ShortByteString, or similar).
     76 
     77      TODO Evaluate the performance impact of making `.hash` strict.
     78 -}
     79 data Pin = P
     80     { refs :: Vector Pin -- Edge-list
     81     , hash :: Hash256    -- Cryptographic Hash
     82     , args :: !Nat
     83     , item :: !Fan
     84     , exec :: SmallArray Fan -> Fan
     85     }
     86 
     87 -- All data already forced upon construction.
     88 instance NFData Pin where rnf = \P{} -> ()
     89 
     90 setExec :: (SmallArray Fan -> Fan) -> Pin -> Pin
     91 setExec x (P n h a i _) = P n h a i x
     92 
     93 data Fan
     94     = NAT !Nat
     95     | PIN !Pin
     96     | FUN !Law
     97     | KLO !Int {-# UNPACK #-} !(SmallArray Fan)
     98     | BAR {-# UNPACK #-} !ByteString
     99     | ROW {-# UNPACK #-} !(Array Fan)
    100     | TAb {-# UNPACK #-} !(ArrayMap Fan Fan)
    101     | SET {-# UNPACK #-} !(ArraySet Fan)
    102     | COw !Nat
    103   deriving (Generic, NFData)
    104 
    105 type Any = Fan
    106 
    107 instance Num Fan where
    108     fromInteger n = NAT (fromIntegral n)
    109     x+y           = NAT (toNat x + toNat y)
    110     x*y           = NAT (toNat x * toNat y)
    111     abs x         = x
    112     negate _      = NAT 0
    113     signum x      = case toNat x of { 0 -> NAT 0; _ -> NAT 1 }
    114 
    115 toNat :: Fan -> Nat
    116 toNat (NAT n) = n
    117 toNat _       = 0
    118 
    119 instance IsString Fan where
    120    fromString = NAT . fromString
    121 
    122 type Rex = GRex Fan
    123 
    124 
    125 -- Internal DSL used to execute Laws -------------------------------------------
    126 
    127 data Prog = PROG
    128     { arity  :: !Int
    129     , varsSz :: !Int
    130     , prgrm  :: !Run
    131     }
    132 
    133 {-
    134    GHC Will use pointer-tagging for the first 6 constructors.
    135 -}
    136 data Run
    137     = CNS !Fan
    138     | ARG {-# UNPACK #-} !Int
    139     | VAR {-# UNPACK #-} !Int
    140     | LET {-# UNPACK #-} !Int !Run !Run
    141     | IFZ !Run !Run !Run
    142     | IF_ !Run !Run !Run
    143 
    144     | EXE                !(SmallArray Fan -> Fan)  --  Precalculated Executor
    145           {-# UNPACK #-} !Int                      --  Precalculated Frame Size
    146                          !Fan                      --  Function (or closure)
    147           {-# UNPACK #-} !(SmallArray Run)         --  Arguments
    148 
    149     | SWI      !Run !Run !(SmallArray Run)
    150     | JMP      !Run !Run !(Tab Fan Run)
    151     | JMP_WORD !Run !Run !(SV.Vector Word) !(SmallArray Run)
    152 
    153     | LETREC !(SmallArray (Int, Run)) !Run
    154 
    155     | SEQ !Run !Run
    156 
    157     | REC {-# UNPACK #-} !(SmallArray Run)      -- Saturated self-application
    158 
    159     | KAL {-# UNPACK #-} !(SmallArray Run)      -- Dynamic Application
    160 
    161     | PAR {-# UNPACK #-} !Int              -- Closure arity (avoid recalculate)
    162           {-# UNPACK #-} !(SmallArray Run) -- Unsaturated Application
    163 
    164     | TRK !Run !Run
    165 
    166     | MK_ROW !(Vector Run)
    167 
    168     | MK_TAB !(Tab Fan Run)
    169 
    170     -- Inlined operations with fallback from the pin.
    171     | OP2 !String (Fan -> Fan -> Fan) !Run !Run
    172 
    173    -- Broken Spine (thunked sub-spine)
    174     | LAZ !Prog !(SmallArray Run)