Commit 5ba53009 authored by Gilles Coremans's avatar Gilles Coremans
Browse files

a commit!

sorry, no useful commit message today
parent ed31b248
......@@ -34,6 +34,8 @@ data Expression
| EQExpr Expression Expression
| ListExpr [Expression]
| LambdaExpr [Parameter] Expression
| AppFnCall Name [Expression] -- <$> and <*> from Applicative typeclass
| AltExpr Expression Expression -- <|> from Alternative typeclass
-- | Functions are made up of a name and multiple head (parameter list)
-- and body (expression) pairs
......
......@@ -238,6 +238,63 @@ substFunctions (nsd, sd, _, _) =
else LambdaExpr [VarParam "c", VarParam "x"] (VarExpr "x")
| INH inst' _ <- ctxs]
-- | Generate functions defining a 'Comble', a kind of trie that acts as an enumeration of every possible sort, given a limit on sort size.
generatorFunctions :: Language -> [Function]
generatorFunctions (nsd, sd, _, _) =
let varAccessBySname = varAccessBySortName sd
sortsWithVarAccess = filter (\sort -> fromJust (lookup (sname sort) varAccessBySname)) sd
in concatMap (\s@(MkDefSort sortName ctxs ctors rewrite) ->
[Fn ("gen" ++ sortName)
[(replaceInParams (params s) s (IntParam 1), alternatives sizeOneCtors),
(params s , alternatives sizeNCtors)],
Fn ("get" ++ sortName ++ "vars")
[([ConstrParam (S ++ "")],
)]]
) sortsWithVarAccess
where
params s@(MkDefSort name _ _ _) = VarParam "env" : map (\(MkDefSort sname _ _ _) -> VarParam ("n" ++ sname)) sd
replaceInParams params (MkDefSort name _ _ _) replacewith = map (\param -> case param of
(VarParam ("n" ++ name)) = replacewith
_ = param
) params
ctorSize :: ConstructorDef -> SortDef -> Integer
ctorSize MkVarConstructor{} _ = 0
ctorSize MkDefConstructor{csorts=sorts} s = countSorts sorts s
ctorSize MkBindConstructor{csorts=sorts} s = countSorts sorts s
countSorts [] _ = 0
countSorts ((_, name):sorts) s@(MkDefSort sname _ _ _) = (if name == sname
then 1
else 0) + countSorts sorts s
alternatives :: [Expression] -> Expression
alternatives e:[] = e
alternatives e:es = AltExpr e $ alternatives es
mkCtorGen :: ConstructorDef -> SortDef -> Expression
mkCtorGen MkVarConstructor{cname=name, cinst=inst} s@(MkDefSort sname _ _ _) = FnCall ("get" ++ sname ++ "vars") [VarExpr "env"]
getVarGenFunctions :: Language -> [Function]
getVarGenFunctions (nsd, _, _, _) =
Fn "reverseVar"
(([ConstrParam "Z" [], VarParam "res"], VarExpr "res")
: map (MkNameSpace{nname=name, nsort=sort} ->
([ConstrParam ("S" ++ name) [VarParam "next"], VarParam "res"], FnCall "reverseVar" [VarExpr "next", ConstrInst ("S" ++ name) [VarExpr "res"]])
) nsd)
: map (\n ->
let constrName = "S" ++ nname n
funName = "get" ++ nname n
in Fn funName
[([ConstrParam "Z" [] , VarParam "_"] , FnCall "empty" [])
([ConstrParam constrName [VarParam "next"], VarParam "abs"], AltExpr (FnCall "reverseVar" [VarExpr "abs"])
(FnCall funName [VarExpr "next", ConstrInst constrName [VarExpr "abs"]]))]
++ map (\other ->
let otherCName = "S" ++ nname other
in ([ConstrParam otherCName [VarParam "next"], VarParam "abs"], FnCall funName [VarExpr "next", ConstrInst otherCName [VarExpr "abs"]])
) (filter (/= n) nsd)
) nsd
_getCtorParams :: ConstructorDef -> [Parameter]
_getCtorParams (MkVarConstructor consName _) = [ConstrParam consName [VarParam "var"]]
_getCtorParams cons = [ConstrParam consName (firstToVarParams (dropFold folds ++ lists ++ sorts) ++ [VarParam (x ++ show n) | (x, n) <- zip hTypes [1 :: Int ..]])]
......
Supports Markdown
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