tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

Wire.hs (1904B)

      1 -- Pure v2 wire decoding, shared by native and browser embeddings. No resource,
      2 -- scheduler, host effects or facility resolution imports. Payloads are borrowed
      3 -- lazy trees: decoding never traverses arguments, callbacks or continuations.
      4 module IOV2.Wire (Action(..), canonicalNat, decodeAction) where
      5 
      6 import Runtime.Tree (T(..))
      7 
      8 canonicalNat :: Int -> T -> Maybe Integer
      9 canonicalNat _ Leaf = Just 0
     10 canonicalNat 0 _ = Nothing
     11 canonicalNat _ (Fork Leaf Leaf) = Nothing
     12 canonicalNat depth (Fork Leaf rest) = (2 *) <$> canonicalNat (depth-1) rest
     13 canonicalNat depth (Fork (Stem Leaf) rest) = (\n -> 2*n+1) <$> canonicalNat (depth-1) rest
     14 canonicalNat _ _ = Nothing
     15 
     16 -- Names are nonempty ASCII identifiers, at most 64 characters. Do not inspect
     17 -- an excess element or tail, or demand arguments while resolving a header.
     18 name :: T -> Maybe String
     19 name value = do
     20   text <- walk (64 :: Int) value
     21   case text of c:_ | c >= 'a' && c <= 'z' -> Just text; _ -> Nothing
     22   where
     23     walk _ Leaf = Just []
     24     walk 0 _ = Nothing
     25     walk n (Fork c rest) = do
     26       code <- canonicalNat 7 c
     27       if (code >= 97 && code <= 122) || (code >= 48 && code <= 57) || code == 45
     28         then (toEnum (fromInteger code) :) <$> walk (n-1) rest
     29         else Nothing
     30     walk _ _ = Nothing
     31 
     32 data Action = Core Integer T | Request String Integer String T
     33 
     34 decodeAction :: T -> Either String Action
     35 decodeAction (Fork tag payload) = case canonicalNat 8 tag of
     36   Just n | n <= 9 -> Right (Core n payload)
     37   Just 10 -> case payload of
     38     Fork group (Fork revision (Fork operation arguments)) ->
     39       case (name group, canonicalNat 16 revision, name operation) of
     40         (Just g, Just v, Just op) | v > 0 -> Right (Request g v op arguments)
     41         _ -> Left "invalid facility header"
     42     _ -> Left "invalid facility header"
     43   _ -> Left "unknown computation constructor"
     44 decodeAction _ = Left "invalid computation shape"
     45