Changeset 7035 for src/Pugs/Prim.hs

Timestamp:

09/17/05 22:55:58 (3 years ago)

Author:

gaal

Message:

Lexical pragmas (WIP). See Pugs.AST.Prag. Dominus++.
This doesn't work yet, my pragmas got lost somewhere between the parser
and the evaluator.
TODO after it's fixed:
- throw away the cons list in favor of a primitive [] - it's enough
- figure out how to install other kinds of pragma data, not just Int

And, the fun part:
- use fatal
- use sort 'mergesort'
- no strict :-)
- other ideas from http://perl.plover.com/TPF/Pragmas/PROPOSAL

Files:

• src/Pugs/Prim.hs (modified) (3 diffs)

src/Pugs/Prim.hs

@@ -598 +598 @@
         VRule MkRulePCRE{rxAdverbs=hash} -> return hash
         _ -> fail $ "Not a rule: " ++ show v
+op1 "Pugs::Internals::current_pragma_value" = \v -> do
+    name <- fromVal v
+    prags <- asks envPragmas
+    return $ findPrag name prags
+    where
+        findPrag :: String -> Pragmas -> Val
+        findPrag _ PrNil = VUndef
+        findPrag n PrPrags {pragma=this, pragmas=rest}
+            | n == pragName this = VInt $ toInteger $ pragDat this
+            | otherwise          = findPrag n rest
+op1 "Pugs::Internals::caller_pragma_value" = \v -> do
+    caller <- asks envCaller
+    case caller of
+        Just env -> local (const env) (op1 "Pugs::Internals::current_pragma_value" v)
+        _        -> return $ VUndef
 op1 other   = \_ -> fail ("Unimplemented unaryOp: " ++ other)
 
@@ -927 +942 @@
 op2 "IO::print" = op2Print hPutStr
 op2 "BUILDALL" = op1WalkAll reverse "BUILD"
+op2 "Pugs::Internals::install_pragma_value" = \x y -> do
+    name <- fromVal x
+    val  <- fromVal y
+    idat <- asks envInitDat
+    idatval <- liftSTM $ readTVar idat
+    trace ("installing " ++ name ++ "/" ++ (show val)) $ return ()
+    let prag = initPragmas idatval
+    liftSTM $ writeTVar idat idatval{initPragmas = 
+        prag ++ [MkPrag{ pragName=name, pragDat=val }]}
+    return (VBool True)
 op2 other = \_ _ -> fail ("Unimplemented binaryOp: " ++ other)
 
@@ -1678 +1703 @@
 \\n   Str       pre     Pugs::Internals::rule_pattern safe (Pugs::Internals::VRule)\
 \\n   Hash      pre     Pugs::Internals::rule_adverbs safe (Pugs::Internals::VRule)\
+\\n   Int       pre     Pugs::Internals::install_pragma_value safe (Str, Int)\
+\\n   Bool      pre     Pugs::Internals::current_pragma_value safe (Str)\
+\\n   Bool      pre     Pugs::Internals::caller_pragma_value safe (Str)\
 \\n"