| -- |
| -- Copyright 2017, NICTA |
| -- |
| -- This software may be distributed and modified according to the terms of |
| -- the GNU General Public License version 2. Note that NO WARRANTY is provided. |
| -- See "LICENSE_GPLv2.txt" for details. |
| -- |
| -- @TAG(NICTA_GPL) |
| -- |
| |
| include <gum/common/common.cogent> |
| |
| type CString |
| |
| type Index = U32 |
| type Node = { |
| len : U32 |
| , key : #CString |
| } |
| |
| type Buffer -- stores a list of `Node`s |
| |
| find_str : (SysState, Buffer!, (#CString)!) -> (SysState, Option Node) |
| find_str (ex,buf,s) = |
| let ((ex,_),r) = seq32 [(SysState, Index), (Buffer!, (#CString)!), Node] #{frm = upcast 0, to = upcast 3, step = upcast 1, f = cmp_inc, acc = (ex,0), obsv = (buf,s)} |
| in r | Iterate _ -> (ex, None) |
| | Break node -> (ex, Some node) |
| |
| cmp_inc : #{acc : (SysState, Index), obsv : (Buffer!, (#CString)!), idx : U32} -> LRR (SysState, Index) Node |
| cmp_inc r {acc=(ex,idx), obsv=(buf,str)} = |
| let (ex,r) = deserialise_Node (ex,buf,idx) |
| in r | Success (node,idx') -> if string_cmp (node.key, str) !node |
| then ((ex,idx'), Break node) -- found! |
| else let node {len, key} = node |
| and ex = free_Node (ex,node) |
| in ((ex,idx'), Iterate ()) |
| | Error err -> ((ex,idx), Iterate ()) |
| |
| |
| string_cmp : ((#CString)!, (#CString)!) -> Bool |
| |
| malloc_Node : SysState -> RR SysState (Node take (..)) ErrCode |
| free_Node : (SysState, Node take (..)) -> SysState |
| |
| free_CString : (SysState, #CString) -> SysState |
| |
| deserialise_Node : (SysState, Buffer!, Index) -> RR SysState (Node, Index) ErrCode |
| deserialise_Node (ex,buf,idx) = |
| let (ex,r) = malloc_Node ex |
| in r |
| | Success node -> |
| let (ex,l,idx') = deserialise_U32 (ex,buf,idx) |
| and (ex,r) = deserialise_CString (ex,buf,idx',l) !node |
| in r |
| | Success (key,idx'') -> (ex, Success (node {len=l,key}, idx'')) |
| | Error err -> let ex = free_Node (ex,node) |
| in (ex, Error err) |
| | Error err -> (ex, Error err) |
| |
| deserialise_CString : (SysState, Buffer!, Index, U32) -> RR SysState (#CString, Index) ErrCode |
| deserialise_U32 : (SysState, Buffer!, Index) -> (SysState, U32, Index) |
| |
| array_print : (SysState, (#CString)!) -> SysState |
