Commit 5ab843be authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Implement the 'showExpr' builtin for macro debugging purposes

parent 7bbc63aa
......@@ -423,7 +423,7 @@ data Builtin = B_Undefined
| B_Relocatable Bool Hash [(Bytes,BinaryRelocation)] Bytes
| B_RawIndex Int
| B_ShowExpr | B_ShowInd
| B_ShowExpr | B_ShowSyntax
deriving (Eq,Ord,Show,Generic)
instance Documented Builtin where
document = Pure . show'
......
......@@ -394,16 +394,25 @@ libSymbol _ (GlobalID _ (Just (i,lid))) = findLib lid >>= \l -> l^.flLibrary.sym
builtinsLib :: FileLibrary
builtinsLib = rawLibrary False blib (serialize blib) Nothing
where
blib = blib_5
blib = blib_6
blib_6 = blib_5 & defSym ["syntax"] "showExpr" (mkBLeaf "showExpr" B_ShowExpr showExprDoc)
. defSym ["syntax"] "showSyntax" (mkBLeaf "showSyntax" B_ShowSyntax showSyntaxDoc)
. setMeta ["version"] "0.5.3"
where showSyntaxDoc = ""; showExprDoc = ""
blib_5 = blib_4 & setMeta ["name"] "curly-builtins"
blib_4 = blib_3 & setMeta ["author","email"] "marc.coiffier@curly-lang.org"
blib_3 = blib_2 & set (sym ["string"] "showInt".leafDoc) (mkDoc "leafDoc" showIntDoc)
where showIntDoc = "{section {title Show Number} {p Produces a string representation of its argument}}"
blib_2 = blib_1 & setMeta ["author","email"] "marc.coiffier@curly-lang.net"
blib_1 = blib_0 & setMeta ["version"] "0.5.2"
defSym p s (i,v) = set (symbols.at s) (Just v) . set (exports.atMs (p+[s])) (Pure (i,v))
sym :: [String] -> String -> FixFold' Library (LeafExpr GlobalID)
sym p s = (symbols.at s.t'Just .+ exports.atMs (p + [s]).t'Pure.l'2)
setMeta (h:t) v = metadata.from i'Metadata.at h.l'Just zero.at t %- Just (Pure v)
setMeta [] _ = id
undefBuiltin = (pureIdent "undefined",undefLeaf "The 'undefined' builtin")
mkBLeaf n b d = (pureIdent n,undefLeaf "" & leafVal %- mkSymbol (pureIdent n,Pure (Builtin (builtinType b) b)) & leafDoc %- mkDoc "leafDoc" d)
blib_0 = zero
& set symbols (fromAList [(foldl' (flip const) ph pt,v) | (ph:pt,(_,v)) <- allBuiltins])
. set exports builtinsMod
......@@ -414,7 +423,7 @@ builtinsLib = rawLibrary False blib (serialize blib) Nothing
,(["version"],Pure "0.5.1")]
builtinsMod = fromPList (map2 Pure allBuiltins)
allBuiltins = [
(["undefined"],(pureIdent "undefined",undefLeaf "The 'undefined' builtin")),
(["undefined"],undefBuiltin),
(["seq"],mkBLeaf "seq" B_Seq seqDoc),
(["unit"],mkBLeaf "unit" B_Unit unitDoc),
(["file","open"],mkBLeaf "open" B_Open openDoc),
......@@ -445,8 +454,7 @@ builtinsLib = rawLibrary False blib (serialize blib) Nothing
(["syntax","mkExprSym"],mkBLeaf "mkExprSym" B_ExprSym mkExprSymDoc),
(["syntax","exprInd"],mkBLeaf "exprInd" B_ExprInd exprIndDoc)
]
where mkBLeaf n b d = (pureIdent n,undefLeaf "" & leafVal %- mkSymbol (pureIdent n,Pure (Builtin (builtinType b) b)) & leafDoc %- mkDoc "leafDoc" d)
seqDoc = unlines [
where seqDoc = unlines [
"{section {title Sequence Expressions}",
" {p {em Usage:} seq x y}",
" {p Evaluates its two arguments in order.}}"
......@@ -539,6 +547,7 @@ builtinsLib = rawLibrary False blib (serialize blib) Nothing
mkExprSymDoc = ""
exprIndDoc = ""
type Template = Documentation
defaultTemplate :: Template
defaultTemplate = mkDoc "template"
......@@ -571,8 +580,8 @@ availableLibs :: IO [(LibraryID,Metadata)]
availableLibs = do
conn <- readIORef libraryVCS
ks <- getKeyStore
allLibs <- for (ks^.ascList) $ \(kn,(_,k,_,m,_)) -> forkValue $ do
case m^.from i'Metadata.at "branches" of
allLibs <- for (ks^.ascList) $ \(kn,(_,k,_,meta,_)) -> forkValue $ do
case meta^.from i'Metadata.at "branches" of
Just (Join bs) -> do
let branches = [b | (b,m) <- bs^.ascList, lookup ["follow"] m == Just (Pure "true")]
for branches $ \b -> forkValue $ do
......
......@@ -4,7 +4,7 @@ module Curly.Core.Security(
Access(..),PrivateKey,PublicKey,SharedSecret,KeyFingerprint,Signature,Signed,
genPrivateKey,publicKey,fingerprint,sharedSecret,signBytes,isValidSignatureFrom,signValue,extractSignedBy,unsafeExtractSigned,
-- * Encryption/Decryption
decrypt,encrypt,
decrypt,encrypt,signedDatum,
-- * Environment
KeyStore,curlyKeysFile,getKeyStore,modifyKeyStore,
-- * Showing and reading formats
......@@ -148,7 +148,7 @@ extractSignedBy pub (Signed a s) | isValidSignatureFrom pub s (serialize a) = Ju
signValue :: (MonadIO m,Serializable Bytes a) => PrivateKey -> a -> m (Signed a)
signValue priv a = Signed a <$> signBytes priv (serialize a)
signedDatum :: Format Bytes a => PublicKey -> Parser Bytes (Signed a)
signedDatum :: Format Bytes a => PublicKey -> Parser Bytes a
signedDatum pub = datum >>= maybe zero return . extractSignedBy pub
timingRef :: IORef Seconds
......@@ -228,7 +228,7 @@ modifyKeyStore m = seq identities $ liftIO $ while $ trylog (threadDelay 1000 >>
ks' = m ks
newFile = serialize ks'
runKeyState (put ks')
logLine Debug $ "New store : "+show (map (\(f,pub,_,m,ac) -> (f,pub,m,ac)) ks')+" {{"+show newFile+"}}"
logLine Debug $ "New store : "+show (map (\(f,pub,_,meta,ac) -> (f,pub,meta,ac)) ks')+" {{"+show newFile+"}}"
newFile `deepseq` return ()
logLine Debug "New key store ready for write"
hSeek h AbsoluteSeek 0
......
......@@ -541,6 +541,11 @@ builtinType b = (zero :: Type s) & i'typeRel %~ case b of
. ln [Out,In,Out,Out] [Out,Out,Out,In,Out] poly
. ln [Out,In,Out,Out] [Out,Out,Out,Out] poly
B_ShowExpr -> ln' [] (exprT --> poly --> poly)
. ln [Out,In] [Out,Out] poly
B_ShowSyntax -> ln' [] (synT --> poly --> poly)
. ln [Out,In] [Out,Out] poly
B_Relocatable _ _ _ _ -> ln' [] intT
B_RawIndex _ -> ln' [] (intT --> intT)
where
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment