suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Resolve the v[s] ambiguity outside the parser.

Browse Source 
This removes the last use of typeOf* from the parser.
This commit is contained in:
Adam Sampson 2008-04-07 21:36:21 +00:00
parent 7703eab52f
commit c627214727
3 changed files with 63 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
frontends/OccamTypes.hs
View File

@ -617,9 +617,10 @@ inSubscriptedContext m body
-- | Infer types.
inferTypes :: Data t => t -> PassM t
inferTypes = applyExplicitM9 doExpression doDimension doSubscript
doArrayConstr doReplicator doAlternative
doInputMode doSpecification doProcess
inferTypes = applyExplicitM10 doExpression doDimension doSubscript
doArrayConstr doReplicator doAlternative
doInputMode doSpecification doProcess
doVariable
where
doExpression :: ExplicitTrans A.Expression
doExpression descend outer
@ -663,12 +664,13 @@ inferTypes = applyExplicitM9 doExpression doDimension doSubscript
return $ A.FunctionCall m n es'
A.IntrinsicFunctionCall _ _ _ -> noTypeContext $ descend outer
A.SubscriptedExpr m s e ->
do s' <- inferTypes s
ctx <- getTypeContext
do ctx <- getTypeContext
ctx' <- case ctx of
Just t -> unsubscriptType s t >>* Just
Nothing -> return Nothing
e' <- inTypeContext ctx' $ inferTypes e
t <- typeOfExpression e'
s' <- inferTypes s >>= fixSubscript t
return $ A.SubscriptedExpr m s' e'
A.BytesInExpr _ _ -> noTypeContext $ descend outer
-- FIXME: ExprConstr
@ -811,7 +813,7 @@ inferTypes = applyExplicitM9 doExpression doDimension doSubscript
-- Tagged protocol -- convert (wrong) variable to tag.
then case ois of
((A.OutExpression _ (A.ExprVariable _ (A.Variable _ wrong))):ois) ->
do tag <- nameToTag wrong
do tag <- nameToUnscoped wrong
ois' <- doOutputItems m v' (Just tag) ois
return $ A.OutputCase m v' tag ois'
_ -> diePC m $ formatCode "This channel carries a variant protocol; expected a list starting with a tag, but found %" ois
@ -849,12 +851,6 @@ inferTypes = applyExplicitM9 doExpression doDimension doSubscript
_ -> return False
_ -> return False
-- | Given a name that should really have been a tag, make it one.
nameToTag :: A.Name -> PassM A.Name
nameToTag n@(A.Name m nt _)
= do nd <- lookupName n
findUnscopedName (A.Name m nt (A.ndOrigName nd))
doOutputItems :: Meta -> A.Variable -> Maybe A.Name
-> Transform [A.OutputItem]
doOutputItems m v tag ois
@ -870,6 +866,28 @@ inferTypes = applyExplicitM9 doExpression doDimension doSubscript
doOutputItem A.Any o = noTypeContext $ inferTypes o
doOutputItem t o = inTypeContext (Just t) $ inferTypes o
doVariable :: ExplicitTrans A.Variable
doVariable descend (A.SubscriptedVariable m s v)
= do v' <- inferTypes v
t <- typeOfVariable v'
s' <- inferTypes s >>= fixSubscript t
return $ A.SubscriptedVariable m s' v'
doVariable descend v = descend v
-- | Resolve the @v[s]@ ambiguity: this takes the type that @v@ is, and
-- returns the correct 'Subscript'.
fixSubscript :: A.Type -> A.Subscript -> PassM A.Subscript
fixSubscript (A.Record _) (A.Subscript m _ (A.ExprVariable _ (A.Variable _ wrong)))
= do n <- nameToUnscoped wrong
return $ A.SubscriptField m n
fixSubscript t s = return s
-- | Given a name that should really have been a tag, make it one.
nameToUnscoped :: A.Name -> PassM A.Name
nameToUnscoped n@(A.Name m nt _)
= do nd <- lookupName n
findUnscopedName (A.Name m nt (A.ndOrigName nd))
-- | Process a 'LiteralRepr', taking the type it's meant to represent or
-- 'Infer', and returning the type it really is.
doLiteral :: ExplicitTrans (A.Type, A.LiteralRepr)

62
frontends/ParseOccam.hs
View File

@ -21,9 +21,7 @@ module ParseOccam (parseOccamProgram) where
import Control.Monad (liftM)
import Control.Monad.State (MonadState, modify, get, put)
import Control.Monad.Writer (tell)
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Text.ParserCombinators.Parsec
@ -259,44 +257,26 @@ tryVVXV a b c d = try (do { av <- a; bv <- b; c; dv <- d; return (av, bv, dv) })
--}}}
--{{{ subscripts
-- FIXME: This shouldn't need to care about types.
-- At the moment it does in order to resolve the c[x] ambiguity -- is x a field
-- or a variable?
maybeSubscripted :: String -> OccParser a -> (Meta -> A.Subscript -> a -> a) -> (a -> OccParser A.Type) -> OccParser a
maybeSubscripted prodName inner subscripter typer
maybeSubscripted :: String -> OccParser a -> (Meta -> A.Subscript -> a -> a) -> OccParser a
maybeSubscripted prodName inner subscripter
= do m <- md
v <- inner
t <- typer v
subs <- postSubscripts t
subs <- many postSubscript
return $ foldl (\var sub -> subscripter m sub var) v subs
<?> prodName
postSubscripts :: A.Type -> OccParser [A.Subscript]
postSubscripts t
= (do sub <- postSubscript t
t' <- subscriptType sub t
rest <- postSubscripts t'
return $ sub : rest)
<|> return []
postSubscript :: A.Type -> OccParser A.Subscript
postSubscript t
= do m <- md
t' <- resolveUserType m t
case t' of
A.Record _ ->
do f <- tryXV sLeft fieldName
sRight
return $ A.SubscriptField m f
-- FIXME: This is a hack (that we're not matching A.Array here); if
-- we aren't *sure* it's a record, then we assume it's an array.
-- This will break on code like:
-- VAL a IS some.record:
-- ... a[field]
_ ->
do e <- tryXV sLeft expression
sRight
return $ A.Subscript m A.CheckBoth e
postSubscript :: OccParser A.Subscript
postSubscript
-- AMBIGUITY: in [x], x may be a variable or a field name.
= do m <- md
e <- tryXV sLeft expression
sRight
return $ A.Subscript m A.CheckBoth e
<|> do m <- md
f <- tryXV sLeft fieldName
sRight
return $ A.SubscriptField m f
<?> "subscript"
maybeSliced :: OccParser a -> (Meta -> A.Subscript -> a -> a) -> OccParser a
maybeSliced inner subscripter
@ -609,7 +589,7 @@ byte
-- literals collapsed, and record literals are array literals of type []ANY.
table :: OccParser A.Expression
table
= maybeSubscripted "table" table' A.SubscriptedExpr typeOfExpression
= maybeSubscripted "table" table' A.SubscriptedExpr
table' :: OccParser A.Expression
table'
@ -814,7 +794,7 @@ conversionMode
--{{{ operands
operand :: OccParser A.Expression
operand
= maybeSubscripted "operand" operand' A.SubscriptedExpr typeOfExpression
= maybeSubscripted "operand" operand' A.SubscriptedExpr
operand' :: OccParser A.Expression
operand'
@ -838,7 +818,7 @@ operand'
--{{{ variables, channels, timers, ports
variable :: OccParser A.Variable
variable
= maybeSubscripted "variable" variable' A.SubscriptedVariable typeOfVariable
= maybeSubscripted "variable" variable' A.SubscriptedVariable
variable' :: OccParser A.Variable
variable'
@ -848,7 +828,7 @@ variable'
channel :: OccParser A.Variable
channel
= maybeSubscripted "channel" channel' A.SubscriptedVariable typeOfVariable
= maybeSubscripted "channel" channel' A.SubscriptedVariable
<?> "channel"
channel' :: OccParser A.Variable
@ -859,7 +839,7 @@ channel'
timer :: OccParser A.Variable
timer
= maybeSubscripted "timer" timer' A.SubscriptedVariable typeOfVariable
= maybeSubscripted "timer" timer' A.SubscriptedVariable
<?> "timer"
timer' :: OccParser A.Variable
@ -870,7 +850,7 @@ timer'
port :: OccParser A.Variable
port
= maybeSubscripted "port" port' A.SubscriptedVariable typeOfVariable
= maybeSubscripted "port" port' A.SubscriptedVariable
<?> "port"
port' :: OccParser A.Variable

12
testcases/ambiguity-subscript.occ Normal file
View File

@ -0,0 +1,12 @@
DATA TYPE FOO
RECORD
INT x:
:
PROC P ()
INT x:
SEQ
FOO v:
x := v[x]
[1]INT v:
x := v[x]
: