fa264dd · elk · git.iko.soy

30import qualified Transform.SortDefinitions as Transform

31import qualified Transform.Declaration as Transform

32

33+

33module' :: Module.Interfaces -> Module.ValidModule -> Either [Doc] Module.CanonicalModule

34module' :: Module.Interfaces -> Module.ValidModule -> Either [Doc] Module.CanonicalModule

34module' interfaces modul =

35module' interfaces modul =

35 filterImports <$> modul'

36 filterImports <$> modul'

41 let used (name,_) = Set.member name usedModules

42 let used (name,_) = Set.member name usedModules

42 in m { Module.imports = filter used (Module.imports m) }

43 in m { Module.imports = filter used (Module.imports m) }

43

44

45+

44moduleHelp :: Module.Interfaces -> Module.ValidModule

46moduleHelp :: Module.Interfaces -> Module.ValidModule

45 -> Canonicalizer [Doc] Module.CanonicalModule

47 -> Canonicalizer [Doc] Module.CanonicalModule

46moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =

48moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =

47− do env <- Setup.environment interfaces modul

49+ do env <- Setup.environment interfaces modul

48− canonicalDecls <- mapM (declaration env) decls

50+ canonicalDecls <- mapM (declaration env) decls

49− exports' <- resolveExports locals exports

51+ exports' <- resolveExports locals exports

52+ return $ modul

50− return $ modul { Module.exports = exports'

53+ { Module.exports = exports'

51− , Module.body = body canonicalDecls

54+ , Module.body = body canonicalDecls

52− }

55+ }

53 where

56 where

54 locals :: [Var.Value]

57 locals :: [Var.Value]

55 locals = concatMap declToValue decls

58 locals = concatMap declToValue decls

71 [ D.portName port | D.Port port <- decls ]

74 [ D.portName port | D.Port port <- decls ]

72 }

75 }

73

76

77+

74resolveExports :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]

78resolveExports :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]

75resolveExports fullList (Var.Listing partialList open) =

79resolveExports fullList (Var.Listing partialList open) =

76 if open

80 if open

121 commaSep (map pretty xs)

125 commaSep (map pretty xs)

122 ]

126 ]

123

127

128+

124{-| Split a list of values into categories so we can work with them

129{-| Split a list of values into categories so we can work with them

125independently.

130independently.

126-}

131-}

131 x:xs ->

136 x:xs ->

132 let (values, aliases, adts) = splitValues xs in

137 let (values, aliases, adts) = splitValues xs in

133 case x of

138 case x of

139+ Var.Value name ->

134− Var.Value name -> (name : values, aliases, adts)

140+ (name : values, aliases, adts)

141+

142+ Var.Alias name ->

135− Var.Alias name -> (values, name : aliases, adts)

143+ (values, name : aliases, adts)

144+

136 Var.ADT name listing ->

145 Var.ADT name listing ->

137 (values, aliases, (name, listing) : adts)

146 (values, aliases, (name, listing) : adts)

138

147

155

164

156 _ -> []

165 _ -> []

157

166

167+

158declaration :: Environment -> D.ValidDecl -> Canonicalizer [Doc] D.CanonicalDecl

168declaration :: Environment -> D.ValidDecl -> Canonicalizer [Doc] D.CanonicalDecl

159declaration env decl =

169declaration env decl =

160 let canonicalize kind context pattern env v =

170 let canonicalize kind context pattern env v =

165 in

175 in

166 case decl of

176 case decl of

167 D.Definition (Valid.Definition p e t) ->

177 D.Definition (Valid.Definition p e t) ->

168− do p' <- canonicalize pattern "definition" p env p

178+ do p' <- canonicalize pattern "definition" p env p

169− e' <- expression env e

179+ e' <- expression env e

170− t' <- T.traverse (canonicalize Canonicalize.tipe "definition" p env) t

180+ t' <- T.traverse (canonicalize Canonicalize.tipe "definition" p env) t

171− return $ D.Definition (Canonical.Definition p' e' t')

181+ return $ D.Definition (Canonical.Definition p' e' t')

172

182

173 D.Datatype name tvars ctors ->

183 D.Datatype name tvars ctors ->

174 D.Datatype name tvars <$> mapM canonicalize' ctors

184 D.Datatype name tvars <$> mapM canonicalize' ctors

175− where

185+ where

176− canonicalize' (ctor,args) =

186+ canonicalize' (ctor,args) =

177− (,) ctor <$> mapM (canonicalize Canonicalize.tipe "datatype" name env) args

187+ (,) ctor <$> mapM (canonicalize Canonicalize.tipe "datatype" name env) args

178

188

179 D.TypeAlias name tvars expanded ->

189 D.TypeAlias name tvars expanded ->

180− do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded

190+ do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded

181− return (D.TypeAlias name tvars expanded')

191+ return (D.TypeAlias name tvars expanded')

182−

192+

183− D.Port port -> do

193+ D.Port port ->

184− Env.uses ["Native","Ports"]

194+ do Env.uses ["Native","Ports"]

185− Env.uses ["Native","Json"]

195+ Env.uses ["Native","Json"]

186− D.Port <$>

196+ D.Port <$>

187− case port of

197+ case port of

188− D.In name t ->

198+ D.In name t ->

189− do t' <- canonicalize Canonicalize.tipe "port" name env t

199+ do t' <- canonicalize Canonicalize.tipe "port" name env t

190− return (D.In name t')

200+ return (D.In name t')

191− D.Out name e t ->

201+ D.Out name e t ->

192− do e' <- expression env e

202+ do e' <- expression env e

193− t' <- canonicalize Canonicalize.tipe "port" name env t

203+ t' <- canonicalize Canonicalize.tipe "port" name env t

194− return (D.Out name e' t')

204+ return (D.Out name e' t')

195−

205+

206+ D.Fixity assoc prec op ->

196− D.Fixity assoc prec op -> return $ D.Fixity assoc prec op

207+ return $ D.Fixity assoc prec op

197

208

198

209

199expression :: Environment -> Valid.Expr -> Canonicalizer [Doc] Canonical.Expr

210expression :: Environment -> Valid.Expr -> Canonicalizer [Doc] Canonical.Expr

200expression env (A.A ann expr) =

211expression env (A.A ann expr) =

201 let go = expression env

212 let go = expression env

202 tipe' environ = format . Canonicalize.tipe environ

213 tipe' environ = format . Canonicalize.tipe environ

214+ throw err =

215+ P.vcat

203− throw err = P.vcat [ P.text "Error" <+> pretty ann <> P.colon

216+ [ P.text "Error" <+> pretty ann <> P.colon

204− , P.text err ]

217+ , P.text err

218+ ]

205 format = Env.onError throw

219 format = Env.onError throw

206 in

220 in

207 A.A ann <$>

221 A.A ann <$>

208 case expr of

222 case expr of

223+ Literal lit ->

209− Literal lit -> return (Literal lit)

224+ return (Literal lit)

210

225

226+ Range e1 e2 ->

211− Range e1 e2 -> Range <$> go e1 <*> go e2

227+ Range <$> go e1 <*> go e2

212

228

229+ Access e x ->

213− Access e x -> Access <$> go e <*> return x

230+ Access <$> go e <*> return x

214

231

232+ Remove e x ->

215− Remove e x -> flip Remove x <$> go e

233+ flip Remove x <$> go e

216

234

235+ Insert e x v ->

217− Insert e x v -> flip Insert x <$> go e <*> go v

236+ flip Insert x <$> go e <*> go v

218

237

219 Modify e fs ->

238 Modify e fs ->

220 Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fs

239 Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fs

221

240

241+ Record fs ->

222− Record fs -> Record <$> mapM (\(k,v) -> (,) k <$> go v) fs

242+ Record <$> mapM (\(k,v) -> (,) k <$> go v) fs

223

243

224 Binop (Var.Raw op) e1 e2 ->

244 Binop (Var.Raw op) e1 e2 ->

225− do op' <- format (Canonicalize.variable env op)

245+ do op' <- format (Canonicalize.variable env op)

226− Binop op' <$> go e1 <*> go e2

246+ Binop op' <$> go e1 <*> go e2

227

247

228 Lambda p e ->

248 Lambda p e ->

229 let env' = update p env in

249 let env' = update p env in

230 Lambda <$> format (pattern env' p) <*> expression env' e

250 Lambda <$> format (pattern env' p) <*> expression env' e

231

251

252+ App e1 e2 ->

232− App e1 e2 -> App <$> go e1 <*> go e2

253+ App <$> go e1 <*> go e2

233

254

255+ MultiIf ps ->

234− MultiIf ps -> MultiIf <$> mapM go' ps

256+ MultiIf <$> mapM go' ps

257+ where

235− where go' (b,e) = (,) <$> go b <*> go e

258+ go' (b,e) = (,) <$> go b <*> go e

236

259

260+ Let defs e ->

237− Let defs e -> Let <$> mapM rename' defs <*> expression env' e

261+ Let <$> mapM rename' defs <*> expression env' e

238− where

262+ where

239− env' = foldr update env $ map (\(Valid.Definition p _ _) -> p) defs

263+ env' = foldr update env $ map (\(Valid.Definition p _ _) -> p) defs

240− rename' (Valid.Definition p body mtipe) =

264+ rename' (Valid.Definition p body mtipe) =

241− Canonical.Definition

265+ Canonical.Definition

242− <$> format (pattern env' p)

266+ <$> format (pattern env' p)

243− <*> expression env' body

267+ <*> expression env' body

244− <*> T.traverse (tipe' env') mtipe

268+ <*> T.traverse (tipe' env') mtipe

245

269

270+ Var (Var.Raw x) ->

246− Var (Var.Raw x) -> Var <$> format (Canonicalize.variable env x)

271+ Var <$> format (Canonicalize.variable env x)

247

272

273+ Data name es ->

248− Data name es -> Data name <$> mapM go es

274+ Data name <$> mapM go es

249

275

276+ ExplicitList es ->

250− ExplicitList es -> ExplicitList <$> mapM go es

277+ ExplicitList <$> mapM go es

251

278

279+ Case e cases ->

252− Case e cases -> Case <$> go e <*> mapM branch cases

280+ Case <$> go e <*> mapM branch cases

253− where

281+ where

282+ branch (p,b) =

254− branch (p,b) = (,) <$> format (pattern env p)

283+ (,) <$> format (pattern env p)

255− <*> expression (update p env) b

284+ <*> expression (update p env) b

256

285

257 Markdown uid md es ->

286 Markdown uid md es ->

258− do Env.uses ["Text"]

287+ do Env.uses ["Text"]

259− Markdown uid md <$> mapM go es

288+ Markdown uid md <$> mapM go es

289+

290+ PortIn name st ->

291+ PortIn name <$> tipe' env st

260

292

293+ PortOut name st signal ->

261− PortIn name st -> PortIn name <$> tipe' env st

294+ PortOut name <$> tipe' env st <*> go signal

262

295

263− PortOut name st signal -> PortOut name <$> tipe' env st <*> go signal

296+ GLShader uid src tipe ->

297+ return (GLShader uid src tipe)

264

298

265− GLShader uid src tipe -> return (GLShader uid src tipe)

266

299

267pattern :: Environment -> P.RawPattern -> Canonicalizer String P.CanonicalPattern

300pattern :: Environment -> P.RawPattern -> Canonicalizer String P.CanonicalPattern

268pattern env ptrn =

301pattern env ptrn =