Commit a274e93b authored by Axel Simon's avatar Axel Simon
Browse files

generalize more libarally

parent acf6ab6c
...@@ -205,9 +205,9 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let ...@@ -205,9 +205,9 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
val env = List.foldl E.pushFunction env fs val env = List.foldl E.pushFunction env fs
val envFun = E.pushSymbol (sym, s, env) val envFun = E.pushSymbol (sym, s, env)
(*val _ = TextIO.print ("pushed instance " ^ SymbolTable.getString(!SymbolTables.varTable, sym) ^ " symbol:\n" ^ E.topToString envFun)*) (*val _ = TextIO.print ("pushed instance " ^ SymbolTable.getString(!SymbolTables.varTable, sym) ^ " symbol:\n" ^ E.kappaToString envFun)*)
val envCall = E.pushUsage (sym, s, !sm, env) val envCall = E.pushUsage (sym, s, !sm, env)
(*val _ = TextIO.print ("pushed usage:\n" ^ E.topToString envCall)*) (*val _ = TextIO.print ("pushed usage:\n" ^ E.kappaToString envCall)*)
(*inform about a unification failure when checking call site (*inform about a unification failure when checking call site
with definition*) with definition*)
fun raiseError str = fun raiseError str =
...@@ -774,8 +774,8 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let ...@@ -774,8 +774,8 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
SymbolTable.getString(!SymbolTables.fieldTable, f)) SymbolTable.getString(!SymbolTables.fieldTable, f))
val (_,fsStr) = List.foldl genFieldStr ("", "") fs val (_,fsStr) = List.foldl genFieldStr ("", "") fs
in in
Error.errorAt (errStrm, s, Error.warningAt (errStrm, s,
[decStr," cannot be exported due to lacking fields: ", fsStr] [decStr," is exported but requires fields: ", fsStr]
) )
end end
fun checkExports _ (AST.MARKdecl {span=s, tree=t}) = checkExports s t fun checkExports _ (AST.MARKdecl {span=s, tree=t}) = checkExports s t
......
...@@ -137,6 +137,7 @@ structure Environment : sig ...@@ -137,6 +137,7 @@ structure Environment : sig
val toStringSI : environment * TVar.varmap -> string * TVar.varmap val toStringSI : environment * TVar.varmap -> string * TVar.varmap
val topToString : environment -> string val topToString : environment -> string
val topToStringSI : environment * TVar.varmap -> string * TVar.varmap val topToStringSI : environment * TVar.varmap -> string * TVar.varmap
val kappaToString : environment -> string
val kappaToStringSI : environment * TVar.varmap -> string * TVar.varmap val kappaToStringSI : environment * TVar.varmap -> string * TVar.varmap
val funTypeToStringSI : environment * VarInfo.symid * TVar.varmap -> val funTypeToStringSI : environment * VarInfo.symid * TVar.varmap ->
string * TVar.varmap string * TVar.varmap
...@@ -372,7 +373,7 @@ end = struct ...@@ -372,7 +373,7 @@ end = struct
let fun lG other [] = l scs let fun lG other [] = l scs
| lG other ((b as {name, ty, width, uses})::bs) = | lG other ((b as {name, ty, width, uses})::bs) =
if ST.eq_symid (sym,name) then if ST.eq_symid (sym,name) then
(varsOfBinding (GROUP (other @ bs), prevTVars scs), ((*varsOfBinding (GROUP (other @ bs), *)prevTVars scs,
COMPOUND { ty = ty, width = width, uses = uses }) COMPOUND { ty = ty, width = width, uses = uses })
else lG (b :: other) bs else lG (b :: other) bs
in in
...@@ -455,8 +456,10 @@ end = struct ...@@ -455,8 +456,10 @@ end = struct
fun prBTyOpt (NONE, str, si) = ("", si) fun prBTyOpt (NONE, str, si) = ("", si)
| prBTyOpt (SOME (t,bFun), str, si) = let | prBTyOpt (SOME (t,bFun), str, si) = let
val (tStr, si) = showTypeSI (t, si) val (tStr, si) = showTypeSI (t, si)
val bStr = if concisePrint then "" else
", flow:" ^ BD.showBFun bFun
in in
(str ^ tStr ^ ", flow:" ^ BD.showBFun bFun, si) (str ^ tStr ^ bStr, si)
end end
fun printU (({span=(p1,p2),file=_}, (ctxt, t)), (str, sep, si)) = fun printU (({span=(p1,p2),file=_}, (ctxt, t)), (str, sep, si)) =
let let
...@@ -683,6 +686,13 @@ end = struct ...@@ -683,6 +686,13 @@ end = struct
| _ => raise InferenceBug | _ => raise InferenceBug
) )
fun kappaToString env =
let
val (str, _) = kappaToStringSI (env,TVar.emptyShowInfo)
in
str
end
fun funTypeToStringSI (env, f, si) = (case Scope.lookup (f,env) of fun funTypeToStringSI (env, f, si) = (case Scope.lookup (f,env) of
(_, COMPOUND { ty = SOME (t,_), width, uses }) => showTypeSI (t,si) (_, COMPOUND { ty = SOME (t,_), width, uses }) => showTypeSI (t,si)
| _ => raise InferenceBug | _ => raise InferenceBug
......
Markdown is supported
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