Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 9 additions & 3 deletions src/BodyBuilder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
{-# LANGUAGE LambdaCase #-}

module BodyBuilder (
BodyBuilder, buildBody, freshVarName, instr, buildFork, completeFork,
BodyBuilder, buildBody, freshVarName, freshTmp, instr, buildFork, completeFork,
beginBranch, endBranch, definiteVariableValue, argExpandedPrim
) where

Expand Down Expand Up @@ -217,11 +217,17 @@ type ComputedCalls = Map Prim [PrimArg]
-- |Allocate the next temp variable name and ensure it's not allocated again
freshVarName :: BodyBuilder PrimVarName
freshVarName = do
tmp <- gets tmpCount
tmp <- freshTmp
logBuild $ "Generating fresh variable " ++ mkTempName tmp
modify (\st -> st {tmpCount = tmp + 1})
return $ PrimVarName (mkTempName tmp) 0

-- |Generate the next tmp number
freshTmp :: BodyBuilder Int
freshTmp = do
tmp <- gets tmpCount
modify (\st -> st {tmpCount = tmp + 1})
return tmp



----------------------------------------------------------------
Expand Down
77 changes: 56 additions & 21 deletions src/Expansion.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ import Data.List as List
import Data.Map as Map
import Data.Set as Set
import Data.Maybe as Maybe
import Data.Function (on)
import Options (LogSelection (Expansion))
import Distribution.Simple.Setup (emptyGlobalFlags)
import Snippets
Expand Down Expand Up @@ -137,6 +138,8 @@ data ExpanderState = Expander {
-- being inlined
renaming :: Renaming, -- ^The current variable renaming
writeNaming :: Renaming, -- ^Renaming for new assignments
typeRenaming :: Map TypeVarName TypeSpec,
-- ^Renaming for type variables
noFork :: Bool, -- ^There's no fork at the end of this body
nextCallSiteID :: CallSiteID -- ^The next callSiteID to use
}
Expand Down Expand Up @@ -204,7 +207,7 @@ addInstr prim pos = do

-- init a expander state based on the given call site count
initExpanderState :: CallSiteID -> ExpanderState
initExpanderState = Expander Nothing identityRenaming identityRenaming True
initExpanderState = Expander Nothing identityRenaming identityRenaming Map.empty True


----------------------------------------------------------------
Expand Down Expand Up @@ -338,9 +341,12 @@ inlineCall proto args body pos = do
logExpansion $ " Before inlining:"
logExpansion $ " renaming = " ++ show (renaming saved)
modify (\s -> s { renaming = identityRenaming,
typeRenaming = Map.empty,
inlining = Just pos })
mapM_ (addOutputNaming pos) $ zip (primProtoParams proto) args
mapM_ (addInputAssign pos) $ zip (primProtoParams proto) args
let paramsArgs = zip (primProtoParams proto) args
mapM_ (addOutputNaming pos) paramsArgs
mapM_ (addInputAssign pos) paramsArgs
mapM_ (uncurry addParamTypeRenaming) paramsArgs
logExpansion $ " Inlining defn: " ++ showBlock 4 body
expandBody body
-- restore the saved state except the "nextCallSiteID"
Expand All @@ -352,12 +358,22 @@ inlineCall proto args body pos = do


expandArg :: PrimArg -> Expander PrimArg
expandArg arg = do
arg' <- expandArg' arg
renaming <- isJust <$> gets inlining
if renaming
then do
ty' <- expandType $ argType arg'
return $ setArgType ty' arg'
else return arg'

expandArg' :: PrimArg -> Expander PrimArg
-- termToExp (StringConst pos "" DoubleQuote)
-- = return $ Placed (Fncall ["wybe","string"] "empty" False []) pos
-- termToExp (StringConst pos [chr] DoubleQuote)
-- = return $ Placed (Fncall ["wybe","string"] "singleton" False
-- [Unplaced (CharValue chr)]) pos
expandArg arg@(ArgString "" WybeString ty) = do
expandArg' arg@(ArgString "" WybeString ty) = do
logExpansion "Optimising empty string"
newVarName <- lift freshVarName
let defVar = ArgVar newVarName ty FlowOut Ordinary False
Expand All @@ -368,7 +384,7 @@ expandArg arg@(ArgString "" WybeString ty) = do
expandPrim (PrimCall callID emptyStringProc Pure [defVar] emptyGlobalFlows) Nothing
logExpansion $ "Empty string variable = " ++ show useVar
return useVar
expandArg arg@(ArgString [ch] WybeString ty) = do
expandArg' arg@(ArgString [ch] WybeString ty) = do
logExpansion $ "Optimising singleton string \"" ++ [ch] ++ "\""
newVarName <- lift freshVarName
let defVar = ArgVar newVarName ty FlowOut Ordinary False
Expand All @@ -380,7 +396,7 @@ expandArg arg@(ArgString [ch] WybeString ty) = do
[ArgChar ch charType, defVar] emptyGlobalFlows) Nothing
logExpansion $ "Singleton string variable = " ++ show useVar
return useVar
expandArg arg@(ArgVar var ty flow ft _) = do
expandArg' arg@(ArgVar var ty flow ft _) = do
renameAll <- isJust <$> gets inlining
if renameAll
then case flow of
Expand All @@ -391,10 +407,30 @@ expandArg arg@(ArgVar var ty flow ft _) = do
FlowOutByReference -> shouldnt "FlowOutByReference not available at this stage of compilation"
FlowTakeReference -> shouldnt "FlowTakeReference not available at this stage of compilation"
else return arg
expandArg arg@(ArgClosure ps as ty) = do
expandArg' arg@(ArgClosure ps as ty) = do
as' <- mapM expandArg as
return $ ArgClosure ps as' ty
expandArg arg = return arg
expandArg' arg = return arg



expandType :: TypeSpec -> Expander TypeSpec
expandType (TypeVariable var) = do
renaming <- gets typeRenaming
case Map.lookup var renaming of
Just ty' -> return ty'
Nothing -> do
ty' <- TypeVariable . FauxTypeVar <$> lift freshTmp
modify $ \s -> s { typeRenaming=Map.insert var ty' $ typeRenaming s }
return ty'
expandType ty@TypeSpec{typeParams=tys} = do
tys' <- mapM expandType tys
return ty{typeParams=tys'}
expandType ty@HigherOrderType{higherTypeParams=tyFlows} = do
let (tys, flows) = unzipTypeFlows tyFlows
tys' <- mapM expandType tys
return ty{higherTypeParams=zipWith TypeFlow tys' flows}
expandType ty = return ty


inputOutputParams :: PrimProto -> (Set PrimVarName,Set PrimVarName)
Expand Down Expand Up @@ -433,21 +469,20 @@ addInputAssign pos (param@(PrimParam name ty FlowIn ft _),v) = do
addInputAssign _ _ = return ()



-- renameParam :: Renaming -> PrimParam -> PrimParam
-- renameParam renaming param@(PrimParam name typ FlowOut ftype inf ) =
-- maybe param
-- (\arg -> case arg of
-- ArgVar name' _ _ _ _ -> PrimParam name' typ FlowOut ftype inf
-- _ -> param) $
-- Map.lookup name renaming
-- renameParam _ param = param
-- |Add type renamings for all types in the PrimParam with the corresponding types from the PrimArg
addParamTypeRenaming :: PrimParam -> PrimArg -> Expander ()
addParamTypeRenaming param arg =
addTypeRenaming (primParamType param) (argType arg)


-- singleCaller :: ProcDef -> Bool
-- singleCaller def =
-- let m = procCallers def
-- in Map.size m == 1 && (snd . Map.findMin) m == 1
-- |Add type renamings for all types in the first operand with the second.
addTypeRenaming :: TypeSpec -> TypeSpec -> Expander ()
addTypeRenaming (TypeVariable var) ty = modify $ \s -> s{typeRenaming=Map.insert var ty $ typeRenaming s}
addTypeRenaming TypeSpec{typeParams=paramTys} TypeSpec{typeParams=argTys} =
zipWithM_ addTypeRenaming paramTys argTys
addTypeRenaming HigherOrderType{higherTypeParams=paramTyFlows} HigherOrderType{higherTypeParams=argTyFlows} =
(zipWithM_ addTypeRenaming `on` fst . unzipTypeFlows) paramTyFlows argTyFlows
addTypeRenaming _ _ = return ()


-- |Log a message, if we are logging inlining and code expansion activity.
Expand Down
12 changes: 6 additions & 6 deletions test-cases/complex/exp/testcase_multi_specz-drone.exp
Original file line number Diff line number Diff line change
Expand Up @@ -70,9 +70,9 @@ module top-level code > {terminal,inline,impure} (0 calls)
foreign lpvm store(0:wybe.phantom, <<wybe.io.io>>:wybe.phantom) @io:nn:nn
foreign c {impure} gc_init @memory_management:nn:nn
drone.<0><{<<wybe.io.io>>}; {<<wybe.io.io>>}; {}> #1
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(T)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(T), ?tmp#10##0:wybe.c_array(T), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(T), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(wybe.c_string), ?tmp#10##0:wybe.c_array(wybe.c_string), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(wybe.c_string), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm store(~tmp#0##0:wybe.c_array(wybe.c_string), <<command_line.arguments>>:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm store(c"":wybe.c_string, <<command_line.command>>:wybe.c_string) @command_line:nn:nn
foreign lpvm store(0:wybe.int, <<command_line.exit_code>>:wybe.int) @command_line:nn:nn
Expand Down Expand Up @@ -613,9 +613,9 @@ module top-level code > {terminal,inline,impure} (0 calls)
foreign lpvm store(0:wybe.phantom, <<wybe.io.io>>:wybe.phantom) @io:nn:nn
foreign c {impure} gc_init @memory_management:nn:nn
drone.<0><{<<wybe.io.io>>}; {<<wybe.io.io>>}; {}> #1
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(T)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(T), ?tmp#10##0:wybe.c_array(T), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(T), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(wybe.c_string), ?tmp#10##0:wybe.c_array(wybe.c_string), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(wybe.c_string), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm store(~tmp#0##0:wybe.c_array(wybe.c_string), <<command_line.arguments>>:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm store(c"":wybe.c_string, <<command_line.command>>:wybe.c_string) @command_line:nn:nn
foreign lpvm store(0:wybe.int, <<command_line.exit_code>>:wybe.int) @command_line:nn:nn
Expand Down
12 changes: 6 additions & 6 deletions test-cases/complex/exp/testcase_multi_specz-int_list.exp
Original file line number Diff line number Diff line change
Expand Up @@ -139,9 +139,9 @@ module top-level code > {terminal,inline,impure} (0 calls)
foreign lpvm store(0:wybe.phantom, <<wybe.io.io>>:wybe.phantom) @io:nn:nn
foreign c {impure} gc_init @memory_management:nn:nn
int_list_test.<0><{<<wybe.io.io>>}; {<<wybe.io.io>>}; {}> #1
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(T)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(T), ?tmp#10##0:wybe.c_array(T), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(T), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(wybe.c_string), ?tmp#10##0:wybe.c_array(wybe.c_string), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(wybe.c_string), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm store(~tmp#0##0:wybe.c_array(wybe.c_string), <<command_line.arguments>>:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm store(c"":wybe.c_string, <<command_line.command>>:wybe.c_string) @command_line:nn:nn
foreign lpvm store(0:wybe.int, <<command_line.exit_code>>:wybe.int) @command_line:nn:nn
Expand Down Expand Up @@ -976,9 +976,9 @@ module top-level code > {terminal,inline,impure} (0 calls)
foreign lpvm store(0:wybe.phantom, <<wybe.io.io>>:wybe.phantom) @io:nn:nn
foreign c {impure} gc_init @memory_management:nn:nn
int_list_test.<0><{<<wybe.io.io>>}; {<<wybe.io.io>>}; {}> #1
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(T)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(T), ?tmp#10##0:wybe.c_array(T), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(T), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm alloc(16:wybe.int, ?tmp#9##0:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm mutate(~tmp#9##0:wybe.c_array(wybe.c_string), ?tmp#10##0:wybe.c_array(wybe.c_string), 0:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argc##0:wybe.int) @command_line:nn:nn
foreign lpvm mutate(~tmp#10##0:wybe.c_array(wybe.c_string), ?tmp#0##0:wybe.c_array(wybe.c_string), 8:wybe.int, 1:wybe.int, 16:wybe.int, 0:wybe.int, ~argv##0:wybe.c_array.raw_array) @command_line:nn:nn
foreign lpvm store(~tmp#0##0:wybe.c_array(wybe.c_string), <<command_line.arguments>>:wybe.c_array(wybe.c_string)) @command_line:nn:nn
foreign lpvm store(c"":wybe.c_string, <<command_line.command>>:wybe.c_string) @command_line:nn:nn
foreign lpvm store(0:wybe.int, <<command_line.exit_code>>:wybe.int) @command_line:nn:nn
Expand Down
6 changes: 3 additions & 3 deletions test-cases/final-dump/anon_field_variable.exp
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,8 @@ module top-level code > public {semipure} (0 calls)
()<{<<wybe.io.io>>}; {<<wybe.io.io>>}; {}>:
AliasPairs: []
InterestingCallProperties: []
foreign lpvm alloc(8:wybe.int, ?tmp#5##0:anon_field_variable(T)) @anon_field_variable:nn:nn
foreign lpvm mutate(~tmp#5##0:anon_field_variable(T), ?tmp#0##0:anon_field_variable(wybe.bool), 0:wybe.int, 1:wybe.int, 8:wybe.int, 0:wybe.int, 0:T) @anon_field_variable:nn:nn
foreign lpvm alloc(8:wybe.int, ?tmp#5##0:anon_field_variable(wybe.bool)) @anon_field_variable:nn:nn
foreign lpvm mutate(~tmp#5##0:anon_field_variable(wybe.bool), ?tmp#0##0:anon_field_variable(wybe.bool), 0:wybe.int, 1:wybe.int, 8:wybe.int, 0:wybe.int, 0:wybe.bool) @anon_field_variable:nn:nn
foreign llvm and(~tmp#0##0:1 bit unsigned, 1:1 bit unsigned, ?tmp#7##0:1 bit unsigned) @anon_field_variable:nn:nn
foreign llvm icmp_eq(~tmp#7##0:1 bit unsigned, 0:1 bit unsigned, ?tmp#8##0:wybe.bool) @anon_field_variable:nn:nn
case ~tmp#8##0:wybe.bool of
Expand Down Expand Up @@ -142,7 +142,7 @@ define external fastcc void @"anon_field_variable.<0>"() {
%"tmp#12##0" = call ccc ptr @wybe_malloc(i32 8)
%"tmp#5##0" = ptrtoint ptr %"tmp#12##0" to i64
%"tmp#13##0" = inttoptr i64 %"tmp#5##0" to ptr
store i64 0, ptr %"tmp#13##0"
store i1 0, ptr %"tmp#13##0"
%"tmp#14##0" = trunc i64 %"tmp#5##0" to i1
%"tmp#7##0" = and i1 %"tmp#14##0", 1
%"tmp#8##0" = icmp eq i1 %"tmp#7##0", 0
Expand Down
Loading