*** empty log message ***

libraries/Hilde/EstherBackend.dcl

@@ -20,6 +20,7 @@ import EstherParser, StdMaybe
 	| CoreCode !Dynamic 
 	| CoreVariable !String
 	| CoreDynamic
+//	| CoreEta
 
 class resolveFilename env :: !String !*env -> (!Maybe (Dynamic, GenConsPrio), !*env)
 

libraries/Hilde/EstherBackend.icl

@@ -20,27 +20,40 @@ overloaded3 :: !String !String !String !Dynamic -> Dynamic
 overloaded3 c1 c2 c3 ((_, _, _, e) :: (v1, v2, v3, d1 d2 d3 -> t)) = dynamic (\(dict1 &&& dict2 &&& dict3) -> e dict1 dict2 dict3) ||| Class c1 &&& Class c2 &&& Class c3 :: Overloaded (Contexts d1 (Contexts d2 d3)) t (Contexts (Context v1) (Contexts (Context v2) (Context v3)))
 
 abstract :: !String !Core -> Core
-abstract v e | freeVar v e = coreK @ e
+abstract v e | noVarOf v e = coreK @ e
 abstract v (CoreVariable x) = coreI
+//abstract v (srcf @ CoreVariable x) | noVarOf v srcf = srcf //dangerous!
+/*abstract v (srcf @ CoreVariable x) | noVarOf v srcf = case srcf of
+	CoreCode (f :: a -> b) -> srcf
+	_ -> CoreEta @ srcf*/
 abstract v (srcf @ srcx @ srcy)
-	| freeVar v srcf
-		| freeVar v srcx = coreB` @ srcf @ srcx @ abstract v srcy
-		| freeVar v srcy = coreC` @ srcf @ abstract v srcx @ srcy
+	| noVarOf v srcf
+		| noVarOf v srcx = coreB` @ srcf @ srcx @ abstract v srcy
+		| noVarOf v srcy = coreC` @ srcf @ abstract v srcx @ srcy
 		= coreS` @ srcf @ abstract v srcx @ abstract v srcy
 abstract v (srcf @ srcx)
-	| freeVar v srcf = coreB @ srcf @ abstract v srcx
-	| freeVar v srcx = coreC @ abstract v srcf @ srcx
+	| noVarOf v srcf = coreB @ srcf @ abstract v srcx
+	| noVarOf v srcx = coreC @ abstract v srcf @ srcx
 	= coreS @ abstract v srcf @ abstract v srcx
 
 abstract_ :: !Core -> Core
 abstract_ e = coreK @ e
 
-freeVar :: !String !Core -> Bool
-freeVar v (f @ x) = freeVar v f && freeVar v x
-freeVar v (CoreVariable x) = v <> x
-freeVar _ _ = True
+noVarOf :: !String !Core -> Bool
+noVarOf v (f @ x) = noVarOf v f && noVarOf v x
+noVarOf v (CoreVariable x) = v <> x
+noVarOf _ _ = True
+
+coreF = dynamic F :: A.a b: (a -> b) a -> b
+F f x = f x
 
 generateCode :: !Core !*env -> (!Dynamic, !*env) | resolveFilename env
+/*generateCode CoreEta env = (coreF, env)
+generateCode (CoreEta @ e) env 
+	# (codef, env) = generateCode e env
+	= case codef of
+		(f :: a -> b) -> (dynamic f :: a -> b, env)
+		_ -> raise (ApplyTypeError codef (dynamic Omega :: A.a b: a -> b))*/
 generateCode CoreDynamic env = (dynamic I ||| Class "TC" :: A.z: Overloaded (z -> Dynamic) (z -> Dynamic) (Context z), env)
 generateCode (CoreDynamic @ e) env 
 	# (codex, env) = generateCode e env
@@ -252,9 +265,17 @@ toStringDynamic d = prettyDynamic d
 prettyDynamic :: !Dynamic -> ([String], String)
 prettyDynamic d = (v, t)
 where
-	v = case d of (x :: a) -> debugShowWithOptions [DebugTerminator "", DebugMaxChars (80 * 22)] x
+//	v = case d of (x :: a) -> debugShowWithOptions [DebugTerminator "", DebugMaxChars (80 * 22)] x
+	v = case d of (x :: a) -> debugShowWithOptions [DebugTerminator "", DebugMaxChars 79] x
 
 	t = removeForAll (typeCodeOfDynamic d)
 	where
 		removeForAll (TypeScheme _ t) = toString t
 		removeForAll t = toString t
+
+instance toString Core where
+	toString (CoreApply f x) = toString f +++ " (" +++ toString x +++ ")"
+	toString (CoreVariable x) = x
+	toString (CoreCode x) = foldr (+++) "" xs
+	where
+		(xs, t) = toStringDynamic x

libraries/Hilde/EstherTransform.icl

@@ -117,43 +117,43 @@ where
 	patternMatch _ (VariablePattern (NTvariable x _)) then _ = abstract x then
 	patternMatch _ (AnyPattern _) then _ = abstract_ then
 
-match :: !Dynamic !Int -> Core
-match (x :: Real) 1 = ifEqual x
-match (x :: Int) 1 = ifEqual x
-match (x :: Char) 1 = ifEqual x
-match (x :: String) 1 = ifEqual x
-match (x :: Bool) 1 = ifEqual x
-match constr n = case constructorNode constr of
-	(arity, x :: a) -> if (n <> arity) (ifMatch x) (raise CaseBadConstructorArity)
-where
-	ifMatch :: !a -> Core | TC a
-	ifMatch x = CoreCode (dynamic IfConstr :: A.b: (a^ -> b) b a^ -> b)
+	match :: !Dynamic !Int -> Core
+	match (x :: Real) 1 = ifEqual x
+	match (x :: Int) 1 = ifEqual x
+	match (x :: Char) 1 = ifEqual x
+	match (x :: String) 1 = ifEqual x
+	match (x :: Bool) 1 = ifEqual x
+	match constr n = case constructorNode constr of
+		(arity, x :: a) -> if (n <> arity) (ifMatch x) (raise CaseBadConstructorArity)
 	where
-		IfConstr th el y = if (matchConstructor x y) (th y) el
-
-	constructorNode :: !Dynamic -> (!Int, !Dynamic)
-	constructorNode (f :: a -> b) = (n + 1, d)
+		ifMatch :: !a -> Core | TC a
+		ifMatch x = CoreCode (dynamic IfConstr :: A.b: (a^ -> b) b a^ -> b)
+		where
+			IfConstr th el y = if (matchConstructor x y) (th y) el
+	
+		constructorNode :: !Dynamic -> (!Int, !Dynamic)
+		constructorNode (f :: a -> b) = (n + 1, d)
+		where
+			(n, d) = constructorNode (dynamic f (unsafeTypeCast []) :: b)
+		constructorNode d = (0, d)
+		
+	ifEqual :: !a -> Core | TC a & == a
+	ifEqual x = CoreCode (dynamic IfEq :: A.b: (a^ -> b) b a^ -> b)
 	where
-		(n, d) = constructorNode (dynamic f (unsafeTypeCast []) :: b)
-	constructorNode d = (0, d)
+		IfEq th el y = if (x == y) (th y) el
+	
+	codeApply :: !Dynamic -> Core
+	codeApply (_ :: a b c d e f g h i -> j) = raise (NotSupported "constructors with arity above eight")
+	codeApply (_ :: a b c d e f g h -> i) = CoreCode (dynamic \f n -> f (unsafeSelect1of8 n) (unsafeSelect2of8 n) (unsafeSelect3of8 n) (unsafeSelect4of8 n) (unsafeSelect5of8 n) (unsafeSelect6of8 n) (unsafeSelect7of8 n) (unsafeSelect8of8 n) :: A.j: (a b c d e f g h -> j) i -> j)
+	codeApply (_ :: a b c d e f g -> h) = CoreCode (dynamic \f n -> f (unsafeSelect1of7 n) (unsafeSelect2of7 n) (unsafeSelect3of7 n) (unsafeSelect4of7 n) (unsafeSelect5of7 n) (unsafeSelect6of7 n) (unsafeSelect7of7 n) :: A.i: (a b c d e f g -> i) h -> i)
+	codeApply (_ :: a b c d e f -> g) = CoreCode (dynamic \f n -> f (unsafeSelect1of6 n) (unsafeSelect2of6 n) (unsafeSelect3of6 n) (unsafeSelect4of6 n) (unsafeSelect5of6 n) (unsafeSelect6of6 n) :: A.h: (a b c d e f -> h) g -> h)
+	codeApply (_ :: a b c d e -> f) = CoreCode (dynamic \f n -> f (unsafeSelect1of5 n) (unsafeSelect2of5 n) (unsafeSelect3of5 n) (unsafeSelect4of5 n) (unsafeSelect5of5 n) :: A.g: (a b c d e -> g) f -> g)
+	codeApply (_ :: a b c d -> e) = CoreCode (dynamic \f n -> f (unsafeSelect1of4 n) (unsafeSelect2of4 n) (unsafeSelect3of4 n) (unsafeSelect4of4 n) :: A.f: (a b c d -> f) e -> f)
+	codeApply (_ :: a b c -> d) = CoreCode (dynamic \f n -> f (unsafeSelect1of3 n) (unsafeSelect2of3 n) (unsafeSelect3of3 n) :: A.e: (a b c -> e) d -> e)
+	codeApply (_ :: a b -> c) = CoreCode (dynamic \f n -> f (unsafeSelect1of2 n) (unsafeSelect2of2 n) :: A.d: (a b -> d) c -> d)
+	codeApply (_ :: a -> b) = CoreCode (dynamic \f n -> f (unsafeSelect1of1 n) :: A.c: (a -> c) b -> c)
+	codeApply (_ :: a) = CoreCode (dynamic \f n -> f :: A.b: b a -> b)
 	
-ifEqual :: !a -> Core | TC a & == a
-ifEqual x = CoreCode (dynamic IfEq :: A.b: (a^ -> b) b a^ -> b)
-where
-	IfEq th el y = if (x == y) (th y) el
-
-codeApply :: !Dynamic -> Core
-codeApply (_ :: a b c d e f g h i -> j) = raise (NotSupported "constructors with arity above eight")
-codeApply (_ :: a b c d e f g h -> i) = CoreCode (dynamic \f n -> f (unsafeSelect1of8 n) (unsafeSelect2of8 n) (unsafeSelect3of8 n) (unsafeSelect4of8 n) (unsafeSelect5of8 n) (unsafeSelect6of8 n) (unsafeSelect7of8 n) (unsafeSelect8of8 n) :: A.j: (a b c d e f g h -> j) i -> j)
-codeApply (_ :: a b c d e f g -> h) = CoreCode (dynamic \f n -> f (unsafeSelect1of7 n) (unsafeSelect2of7 n) (unsafeSelect3of7 n) (unsafeSelect4of7 n) (unsafeSelect5of7 n) (unsafeSelect6of7 n) (unsafeSelect7of7 n) :: A.i: (a b c d e f g -> i) h -> i)
-codeApply (_ :: a b c d e f -> g) = CoreCode (dynamic \f n -> f (unsafeSelect1of6 n) (unsafeSelect2of6 n) (unsafeSelect3of6 n) (unsafeSelect4of6 n) (unsafeSelect5of6 n) (unsafeSelect6of6 n) :: A.h: (a b c d e f -> h) g -> h)
-codeApply (_ :: a b c d e -> f) = CoreCode (dynamic \f n -> f (unsafeSelect1of5 n) (unsafeSelect2of5 n) (unsafeSelect3of5 n) (unsafeSelect4of5 n) (unsafeSelect5of5 n) :: A.g: (a b c d e -> g) f -> g)
-codeApply (_ :: a b c d -> e) = CoreCode (dynamic \f n -> f (unsafeSelect1of4 n) (unsafeSelect2of4 n) (unsafeSelect3of4 n) (unsafeSelect4of4 n) :: A.f: (a b c d -> f) e -> f)
-codeApply (_ :: a b c -> d) = CoreCode (dynamic \f n -> f (unsafeSelect1of3 n) (unsafeSelect2of3 n) (unsafeSelect3of3 n) :: A.e: (a b c -> e) d -> e)
-codeApply (_ :: a b -> c) = CoreCode (dynamic \f n -> f (unsafeSelect1of2 n) (unsafeSelect2of2 n) :: A.d: (a b -> d) c -> d)
-codeApply (_ :: a -> b) = CoreCode (dynamic \f n -> f (unsafeSelect1of1 n) :: A.c: (a -> c) b -> c)
-codeApply (_ :: a) = CoreCode (dynamic \f n -> f :: A.b: b a -> b)
-
 dynamicTuple :: !Int -> Dynamic
 dynamicTuple 2 = dynamicTuple2
 dynamicTuple 3 = dynamicTuple3