Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
  • 4 commits
  • 16 files changed
  • 0 commit comments
  • 1 contributor
View
1  EHC/LICENSE
@@ -7,7 +7,6 @@ template can be found here:
http://www.opensource.org/licenses/bsd-license.php
UHC uses the following libraries with their own license:
-- Boehm Garbage Collector (BGC) library, see extlibs/bgc
- Library code from the GHC distribution, see comment in the modules in ehclib
License text
View
2  EHC/Makefile
@@ -215,7 +215,7 @@ www: $(WWW_DOC_FILES)
www/DoneSyncStamp: www
(date "+%G%m%d %H:%M") > www/DoneSyncStamp ; \
chmod 664 www/* ; \
- rsync --progress -azv -e ssh www/* `whoami`@shell.cs.uu.nl:/users/www/groups/ST/Projects/ehc
+ rsync --progress -azv -e ssh www/* dijks106@csstaff.science.uu.nl:/users/www/groups/ST/Projects/ehc
www-sync: www/DoneSyncStamp
View
28 EHC/ehclib/base/Data/String.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, FlexibleInstances #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Data.String
@@ -10,18 +11,31 @@
-- Stability : experimental
-- Portability : portable
--
--- Things related to the String type.
+-- The @String@ type and associated operations.
--
-----------------------------------------------------------------------------
module Data.String (
- IsString(..)
+ String
+ , IsString(..)
+
+ -- * Functions on strings
+ , lines
+ , words
+ , unlines
+ , unwords
) where
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#endif
+#ifdef __UHC__
+import UHC.Base
+#endif
+
+import Data.List (lines, words, unlines, unwords)
+
-- | Class for string-like datastructures; used by the overloaded string
-- extension (-foverloaded-strings in GHC).
class IsString a where
@@ -30,3 +44,9 @@ class IsString a where
instance IsString [Char] where
fromString xs = xs
+#ifdef __UHC_TARGET_JS__
+foreign import prim "primStringToPackedString" primStringToPackedString :: String -> PackedString
+
+instance IsString PackedString where
+ fromString = primStringToPackedString
+#endif
View
2  EHC/src/ehc/EH/FinalInfo.cag
@@ -66,7 +66,7 @@ SEM AGItf
%%[(9 hmtyinfer)
SEM Expr
- | Let loc . finTyVarMp = varUpd @tmpoTyVarMp $
+ | Let loc . finTyVarMp = -- varUpd @tmpoTyVarMp $
@lhs.finTyVarMp
%%]
View
2  EHC/src/ehc/EH/Infer.cag
@@ -131,7 +131,7 @@ SEM Expr
. (quValGam_qu_,quTyVarMp, (cycTyVarMp_l,tqoGam))
:= @doValGamQuantify True @tyVarMpDeclsQuant @toQuantOverPrOccL
. tmpoTyVarMp = foldr (\tmpo c -> tmpoImplsVarMp tmpo `varUpd` c) emptyVarMp (gamElts @tqoGam)
- . bodyVarMp2 := @chrSolve1SimpTyVarMp `varUpd` (@exTyVarMp2 :: VarMp) `varUpd` @bodyVarMp1
+ . bodyVarMp2 := @tmpoTyVarMp `varUpd` @chrSolve1SimpTyVarMp `varUpd` (@exTyVarMp2 :: VarMp) `varUpd` @bodyVarMp1
%%]
decls . patTyVarMp := foVarMp @foKnRes `varUpd` @exTyVarMp1b -- @forExprTyVarMp `varUpd` @exTyVarMp1b
View
4 EHC/src/ehc/EH/PrettyAST.cag
@@ -309,7 +309,7 @@ SEM TyExpr
%%[(3 hmtyinfer)
SEM Expr
- | Let loc . info_3 := [ -- mkInfo1 "valGam_l_ (+ decls.tyVarMp)" (ppGam $ @tyVarMpDeclsL0 `varUpd` @valGam_l_)
+ | Let loc . info_3 := [ mkInfo1 "cycTyVarMp_l" (ppVarMpV @cycTyVarMp_l)
]
| TypeAs loc . info_3 := [ mkInfo1 "knTy+lhs.tyVarMp" (ppTy (@lhs.tyVarMp `varUpd` @lhs.knTy))
, mkInfo1 "lhs.tyVarMp" (ppVarMpV @lhs.tyVarMp)
@@ -888,6 +888,7 @@ SEM Decl
SEM AGItf
| AGItf loc . info_9 := [ mkInfo1 "chrSolveSimpTyVarMp" (pp @chrSolveSimpTyVarMp)
+ , mkInfo1 "finTyVarMp" (pp @finTyVarMp)
]
++ mkInfo1Dbg @lhs.opts "chrStore" (ppCHRStore @chrStore)
%%]
@@ -943,6 +944,7 @@ SEM Expr
, mkInfo1 "toQuantOverPrOccL (decl)" (ppBracketsCommasV @toQuantOverPrOccL)
, mkInfo1 "quantCnstrMp" (ppAssocLV $ assocLMapElt ppBracketsCommas $ Map.toList @quantCnstrMp)
, mkInfo1 "tqoGam" (ppGam @tqoGam)
+ -- , mkInfo1 "quTyVarMp" (pp @quTyVarMp)
, mkInfo1 "tmpoTyVarMp" (pp @tmpoTyVarMp)
, mkInfo1 "chrSolve1RedGraph" (pp $ show @chrSolve1RedGraph)
, mkInfo1 "chrSimplifyResult1 redgraphs" (ppAssocLV $ assocLMapElt show $ simpresRedGraphs @chrSimplifyResult1)
View
3  EHC/src/ehc/Foreign/Parser.chs
@@ -108,6 +108,7 @@ pPrimCall dfltNm
where nm = maybe "" id dfltNm
pKnownPrim = pMb (pAnyFromMap pKeyTk allKnownPrimMp)
+%%[[(90 javascript)
pJavaScriptCall :: Maybe String -> ForeignParser JavaScriptCall
pJavaScriptCall dfltNm
= JavaScriptCall_Id nm <$> pMb pForeignExpr
@@ -137,6 +138,6 @@ pForeignExpr
mk = \pre e post -> let pre' = maybe [] ((flip (:)) []) pre
in foldr ($) e $ pre' ++ reverse post
-
+%%]]
%%]
View
73 EHC/src/ehc/Ty.cag
@@ -152,6 +152,18 @@ type LabelVarId = UID
%%]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Lookup types
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%[(2 hmtyinfer) hs export(LookupTy)
+type LookupTy = TyVarId -> Maybe Ty
+%%]
+
+%%[(9 hmtyinfer) hs export(LookupImpls)
+type LookupImpls = ImplsVarId -> Maybe Impls
+%%]
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Misc types
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1048,18 +1060,18 @@ tyString o = appCon (ehcOptBuiltin o ehbnPrelString)
Substitution aware variants
%%[(9 hmtyinfer || hmtyast) hs export(tyArrowArgResWithLkup)
-tyArrowArgResWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> (Ty,Ty)
+tyArrowArgResWithLkup :: LookupTy -> Ty -> (Ty,Ty)
tyArrowArgResWithLkup lookup = tyVarChkVisitLift lookup appUn1Arr appUn1Arr
%%]
%%[(9 hmtyinfer || hmtyast) hs export(tyArrowImplsResWithLkup,tyArrowImplsArgResWithLkup)
-tyArrowImplsArgResWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> (TyL,Ty,Ty)
+tyArrowImplsArgResWithLkup :: LookupTy -> Ty -> (TyL,Ty,Ty)
tyArrowImplsArgResWithLkup lookup t
= (i,a,r)
where (i,t') = tyArrowImplsResWithLkup lookup t
(a,r) = tyArrowArgResWithLkup lookup t'
-tyMbArrowImplsResWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> Maybe (TyL,Ty)
+tyMbArrowImplsResWithLkup :: LookupTy -> Ty -> Maybe (TyL,Ty)
tyMbArrowImplsResWithLkup lookup t
= extr t
where extr t = case appMb1Arr t of
@@ -1075,7 +1087,7 @@ tyMbArrowImplsResWithLkup lookup t
isImpls _ = False
_ -> tyVarLift lookup extr (const Nothing) t
-tyArrowImplsResWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> (TyL,Ty)
+tyArrowImplsResWithLkup :: LookupTy -> Ty -> (TyL,Ty)
tyArrowImplsResWithLkup lookup t = maybe ([],t) id $ tyMbArrowImplsResWithLkup lookup t
%%]
@@ -1098,7 +1110,7 @@ tyLHdAndTl :: [Ty] -> (Ty,TyL)
%%[(6 hmtyinfer || hmtyast) hs export(tyAppFunArgsWithLkup)
-- Substitution aware
-tyAppFunArgsWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> (Ty,TyL)
+tyAppFunArgsWithLkup :: LookupTy -> Ty -> (Ty,TyL)
tyAppFunArgsWithLkup lookup = tyVarChkVisitLift lookup appUnApp appUnApp
{-# INLINE tyAppFunArgsWithLkup #-}
%%]
@@ -1137,7 +1149,7 @@ tyConNm = maybe hsnUnknown id . tyMbCon
%%]
%%[(7 hmtyinfer || hmtyast) hs export(tyMbConWithLkup)
-tyMbConWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> Maybe HsName
+tyMbConWithLkup :: LookupTy -> Ty -> Maybe HsName
tyMbConWithLkup lookup = tyVarChkVisitLift lookup tyMbCon tyMbCon
{-# INLINE tyMbConWithLkup #-}
%%]
@@ -1269,13 +1281,13 @@ mkTyRecExt recd al
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%[(6 hmtyinfer || hmtyast) hs
-tyVarChkVisitLift :: (TyVarId -> Maybe Ty) -> (Ty -> x) -> (Ty -> x) -> Ty -> x
+tyVarChkVisitLift :: LookupTy -> (Ty -> x) -> (Ty -> x) -> Ty -> x
tyVarChkVisitLift
= withLkupChkVisitLift tyMbVar (noVisit . tyUnAnn)
where noVisit (Ty_TBind _ qv _ _) = Set.singleton qv
noVisit _ = Set.empty
-tyVarLift :: (TyVarId -> Maybe Ty) -> (Ty -> x) -> (Ty -> x) -> Ty -> x
+tyVarLift :: LookupTy -> (Ty -> x) -> (Ty -> x) -> Ty -> x
tyVarLift = withLkupLift tyMbVar
{-# INLINE tyVarLift #-}
%%]
@@ -1293,7 +1305,7 @@ implsTailVarLiftCyc = withLkupLiftCyc1 implsMbVar (const Set.empty)
Substitution aware variants
%%[(7 hmtyinfer || hmtyast) hs export(tyRowExtsWithLkup,tyRecExtrWithLkup,tyRecExtsWithLkup)
-tyRowExtsWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> (Ty,AssocL HsName Ty)
+tyRowExtsWithLkup :: LookupTy -> Ty -> (Ty,AssocL HsName Ty)
tyRowExtsWithLkup lookup
= extr []
where extr as t
@@ -1301,16 +1313,16 @@ tyRowExtsWithLkup lookup
(Ty_Ext r l e) -> extr ((l,e):as) r
t' -> tyVarLift lookup (extr as) (flip (,) as) t'
-tyRecExtsWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> (Ty,AssocL HsName Ty)
+tyRecExtsWithLkup :: LookupTy -> Ty -> (Ty,AssocL HsName Ty)
tyRecExtsWithLkup lookup t
= case tyRecRowWithLkup lookup t of
Ty_Any -> (Ty_Any,[])
row -> tyRowExtsWithLkup lookup row
-tyRecRowWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> Ty
+tyRecRowWithLkup :: LookupTy -> Ty -> Ty
tyRecRowWithLkup lookup = maybe Ty_Any id . tyMbRecRowWithLkup lookup
-tyRowExtrWithLkup :: (TyVarId -> Maybe Ty) -> HsName -> Ty -> Maybe (Ty,Ty)
+tyRowExtrWithLkup :: LookupTy -> HsName -> Ty -> Maybe (Ty,Ty)
tyRowExtrWithLkup lookup lbl t
= extr t
where extr t
@@ -1319,13 +1331,13 @@ tyRowExtrWithLkup lookup lbl t
| otherwise -> maybe Nothing (\(r',e') -> Just (Ty_Ext r' l e,e')) (extr r)
t' -> tyVarLift lookup extr (const Nothing) t'
-tyRecExtrWithLkup :: (TyVarId -> Maybe Ty) -> HsName -> Ty -> Maybe (Ty,Ty)
+tyRecExtrWithLkup :: LookupTy -> HsName -> Ty -> Maybe (Ty,Ty)
tyRecExtrWithLkup lookup lbl t
= case tyRowExtrWithLkup lookup lbl (tyRecRowWithLkup lookup t) of
Nothing -> Nothing
Just (r,e) -> Just (hsnRec `appConApp` [r],e)
-tyMbRecRowWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> Maybe Ty
+tyMbRecRowWithLkup :: LookupTy -> Ty -> Maybe Ty
tyMbRecRowWithLkup lookup t
= case tyAppFunArgsWithLkup lookup t of
(f,[row])
@@ -1458,7 +1470,7 @@ tyRecOffset lbl t
Substitution aware
%%[(8 hmtyinfer || hmtyast) hs export(tyRecOffsetWithLkup)
-tyRecOffsetWithLkup :: (TyVarId -> Maybe Ty) -> HsName -> Ty -> Int
+tyRecOffsetWithLkup :: LookupTy -> HsName -> Ty -> Int
tyRecOffsetWithLkup lookup nm
= tyVarLift lookup o o
where o = tyRecOffset nm
@@ -1589,7 +1601,7 @@ implsPredsTailWithLkup lookup sc i
= (map fst is,t)
where (is,t) = implsPredsTailWithLkup' lookup sc i
-tyImplsWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> Impls
+tyImplsWithLkup :: LookupTy -> Ty -> Impls
tyImplsWithLkup lookup = tyVarLift lookup tyImpls tyImpls
{-# INLINE tyImplsWithLkup #-}
@@ -1599,6 +1611,11 @@ implsPrIdLWithLkup lookup = map poPoi . fst . implsPredsTailWithLkup lookup init
%%]
+%%[(9 hmtyinfer || hmtyast) hs export()
+tyMbVarWithLkup :: LookupTy -> Ty -> Maybe TyVarId
+tyMbVarWithLkup lookup = tyVarLift lookup tyMbVar tyMbVar
+%%]
+
%%[(9 hmtyinfer || hmtyast) hs export(tyImpls,implsPredsTail,implsPredsMbTail,implsIsTail,tyIsImplsTail,tyImplsPreds,implsPrIdPredL,implsPrIdL)
tyMbImpls :: Ty -> Maybe Impls
tyMbImpls
@@ -1643,6 +1660,28 @@ implsPrIdL = map fst . implsPrIdPredL
{-# INLINE implsPrIdL #-}
%%]
+%%[(9 hmtyinfer || hmtyast) hs export(tyMb1ArrTailVar2VarWithLkup)
+-- | Is an 'Impls' the tail (last empty element) of a sequence?
+implsMbTailVarWithLkup :: LookupImpls -> Impls -> Maybe ImplsVarId
+implsMbTailVarWithLkup lkup (Impls_Tail iv _) = maybe (Just iv) (const Nothing) (lkup iv)
+implsMbTailVarWithLkup _ _ = Nothing
+{-# INLINE implsMbTailVarWithLkup #-}
+
+-- | Is a 'Ty' the tail of an Impls?
+tyMbTailVarWithLkup :: LookupImpls -> Ty -> Maybe ImplsVarId
+tyMbTailVarWithLkup lkup t = do { i <- tyMbImpls t ; implsMbTailVarWithLkup lkup i }
+{-# INLINE tyMbTailVarWithLkup #-}
+
+-- | Is 'Ty' a function type from an Impls tail to ...
+tyMb1ArrTailVarWithLkup :: LookupImpls -> Ty -> Maybe (ImplsVarId,Ty)
+tyMb1ArrTailVarWithLkup lkup t = do { (a,r) <- appMb1Arr t; i <- tyMbTailVarWithLkup lkup a; return (i,r) }
+{-# INLINE tyMb1ArrTailVarWithLkup #-}
+
+-- | Is 'Ty' a function type from an Impls tail to a ty var
+tyMb1ArrTailVar2VarWithLkup :: LookupTy -> LookupImpls -> Ty -> Maybe (ImplsVarId,TyVarId)
+tyMb1ArrTailVar2VarWithLkup lkupt lkupi t = do { (i,r) <- tyMb1ArrTailVarWithLkup lkupi t; v <- tyMbVarWithLkup lkupt r; return (i,v) }
+%%]
+
%%[(9 hmtyinfer || hmtyast) hs export(implsMbVar,implsTailVar)
implsMbVar :: Impls -> Maybe TyVarId
implsMbVar (Impls_Tail v _) = Just v
@@ -1671,7 +1710,7 @@ tyIsPredicated t = isPr a
isPr (Ty_Pred p:_) = True
isPr _ = False
-tyIsPredicatedWithLkup :: (TyVarId -> Maybe Ty) -> Ty -> Bool
+tyIsPredicatedWithLkup :: LookupTy -> Ty -> Bool
tyIsPredicatedWithLkup lookup = tyVarLift lookup tyIsPredicated tyIsPredicated
{-# INLINE tyIsPredicatedWithLkup #-}
%%]
View
40 EHC/src/ehc/Ty/FitsIn.chs
@@ -1114,33 +1114,17 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
| lBefR && fiAllowTyVarBind fi t1 = Just $ bind fi True v1 (updTy t2)
| not lBefR && fiAllowTyVarBind fi t2 = Just $ bind fi False v2 (updTy t1)
where lBefR = fioBindLBeforeR (fiFIOpts fi)
- {-
- varBind1 fi updTy t1@(Ty_Var v1 f1) t2
- | isJust mbNoise = case fromJust mbNoise of
- (Ty_Var v2 f2) | v1 == v2 && f1 == f2 -> Just $ res fi t1
- where mbNoise = tyUnNoiseForVarBind t2
- varBind1 fi updTy t1 t2@(Ty_Var v2 f2)
- | isJust mbNoise = case fromJust mbNoise of
- (Ty_Var v1 f1) | v1 == v2 && f1 == f2 -> Just $ res fi t2
- where mbNoise = tyUnNoiseForVarBind t1
- -}
varBind1 _ _ _ _ = Nothing
-- | tvar binding part 2: 1 of 2 tvars, impredicatively
varBind2 fi updTy t1@(Ty_Var v1 _) t2
+ | isJust m && v1 == v2 = Just $ res (fiBindImplsVar iv2 Impls_Nil fi) (updTy t1)
| allowImpredTVBindL fi t1 t2 = Just $ occurBind fi True v1 (updTy t2)
+ where m@(~(Just (iv2,v2))) = tyMb1ArrTailVar2VarWithLkup (fiLookupTyVarCyc fi) (lookupImplsVarCyc fi) t2
varBind2 fi updTy t1 t2@(Ty_Var v2 _)
+ | isJust m && v1 == v2 = Just $ res (fiBindImplsVar iv1 Impls_Nil fi) (updTy t2)
| allowImpredTVBindR fi t2 t1 = Just $ occurBind fi False v2 (updTy t1)
- {-
- varBind2 fi updTy t1@(Ty_Var v1 f1) t2
- | isJust mbNoise = case fromJust mbNoise of
- (Ty_Var v2 f2) | v1 == v2 && f1 == f2 -> Just $ res fi t1
- where mbNoise = tyUnNoiseForVarBind t2
- varBind2 fi updTy t1 t2@(Ty_Var v2 f2)
- | isJust mbNoise = case fromJust mbNoise of
- (Ty_Var v1 f1) | v1 == v2 && f1 == f2 -> Just $ res fi t2
- where mbNoise = tyUnNoiseForVarBind t1
- -}
+ where m@(~(Just (iv1,v1))) = tyMb1ArrTailVar2VarWithLkup (fiLookupTyVarCyc fi) (lookupImplsVarCyc fi) t1
varBind2 _ _ _ _ = Nothing
-- | tvar binding part 3: 1 of 2 tvars, non impredicatively
@@ -1181,11 +1165,11 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
%%[(9 hmtyinfer)
fVarPred2 f fi tpr1 (Ty_Impls (Impls_Tail iv2 _))
- | isJust mbTl = f fi tpr1 (Ty_Impls (fromJust mbTl))
- where mbTl = lookupImplsVarCyc fi iv2
+ | isJust mbTl = f fi tpr1 (Ty_Impls tl2)
+ where mbTl@(~(Just tl2)) = lookupImplsVarCyc fi iv2
fVarPred2 f fi (Ty_Impls (Impls_Tail iv1 _)) tpr2
- | isJust mbTl = f fi (Ty_Impls (fromJust mbTl)) tpr2
- where mbTl = lookupImplsVarCyc fi iv1
+ | isJust mbTl = f fi (Ty_Impls tl1) tpr2
+ where mbTl@(~(Just tl1)) = lookupImplsVarCyc fi iv1
fVarPred2 f fi tpr1 tpr2
= f fi tpr1 tpr2
fVarPred1 f fi (Ty_Impls (Impls_Tail iv1 _))
@@ -1231,7 +1215,7 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
t2
| hsnIsArrow c1 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp
= fromJust mbfp
- where mbfp = fVarPred1 fP fi tpr1
+ where mbfp = fVarPred1 fP fi tpr1
fP fi (Ty_Impls (Impls_Nil))
= Just (fVar' fTySyn fi updTy tr1 t2)
fP fi _ = Nothing
@@ -1239,7 +1223,7 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
t2@(Ty_App (Ty_App (Ty_Con c2) tpr2) tr2)
| hsnIsArrow c2 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp
= fromJust mbfp
- where mbfp = fVarPred1 fP fi tpr2
+ where mbfp = fVarPred1 fP fi tpr2
fP fi (Ty_Impls (Impls_Nil))
= Just (fVar' fTySyn fi updTy t1 tr2)
fP fi _ = Nothing
@@ -1325,6 +1309,7 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
%%]
%%[(9 hmtyinfer)
+ -- tpr1 => tr1 `fit` tpr2 => tr2
fBase fi updTy t1@(Ty_App (Ty_App (Ty_Con c1) tpr1) tr1)
t2@(Ty_App (Ty_App (Ty_Con c2) tpr2) tr2)
| hsnIsArrow c1 && c1 == c2 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp
@@ -1424,6 +1409,7 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
%%]
%%[(9 hmtyinfer)
+ -- t1 `fit` tpr2 => tr2
fBase fi updTy t1
t2@(Ty_App (Ty_App (Ty_Con c2) tpr2) tr2)
| hsnIsArrow c2 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp
@@ -1508,6 +1494,7 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
%%]
%%[(9 hmtyinfer)
+ -- tpr1 => tr1 `fit` t2
fBase fi updTy t1@(Ty_App (Ty_App (Ty_Con c1) tpr1) tr1)
t2
| hsnIsArrow c1 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp
@@ -1625,6 +1612,7 @@ GADT: when encountering a product with eq-constraints on the outset, remove them
%%]
%%[(4 hmtyinfer).fitsIn.App
+ -- tf1 ta1 `fit` tf2 ta2
fBase fi updTy t1@(Ty_App tf1 ta1)
t2@(Ty_App tf2 ta2)
= manyFO [ ffo, afo
View
5 EHC/src/ehc/Ty/FitsInCommon2.chs
@@ -181,3 +181,8 @@ fiBindTyVar :: TyVarId -> Ty -> FIIn' gm -> FIIn' gm
fiBindTyVar v t = fiPlusVarMp (v `varmpTyUnit` t)
%%]
+%%[(9 hmtyinfer) export(fiBindImplsVar)
+fiBindImplsVar :: ImplsVarId -> Impls -> FIIn' gm -> FIIn' gm
+fiBindImplsVar v i = fiPlusVarMp (v `varmpImplsUnit` i)
+%%]
+
View
8 EHC/src/text2text/Common.hs
@@ -11,8 +11,10 @@ module Common
, Err(..)
, OutDoc, emptyout
+ , outnl
, Out(..)
, (+++), outList, outListSep
+ , outPack
, outToString
, putOut, putOutLn
@@ -111,6 +113,9 @@ type OutDoc = Seq.Seq String
emptyout :: OutDoc
emptyout = Seq.empty
+outnl :: OutDoc
+outnl = out "\n"
+
class Out a where
out :: a -> OutDoc
@@ -138,6 +143,9 @@ outList = Seq.unions . map out
outListSep :: (Out s, Out c, Out o, Out a) => o -> c -> s -> [a] -> OutDoc
outListSep o c s outs = o +++ outList (intersperse (out s) (map out outs)) +++ c
+outPack :: (Out c, Out o, Out a) => o -> c -> a -> OutDoc
+outPack o c x = outListSep o c "" [x]
+
hPutOut :: Handle -> OutDoc -> IO ()
hPutOut h ou = hPutStr h (outToString ou)
View
14 EHC/src/text2text/Text/To/DocLaTeX.ag
@@ -50,7 +50,7 @@ dltxCmd :: Out c => c -> OutDoc
dltxCmd c = "\\" +++ c
dltxArg :: Out a => a -> OutDoc
-dltxArg a = "{" +++ a +++ "}"
+dltxArg = outPack "{" "}"
dltxArgs :: [OutDoc] -> OutDoc
dltxArgs a = outList $ map dltxArg a
@@ -101,7 +101,7 @@ SEM TextItem
| HorRuler TableHorRuler
loc . out = dltxCmd "hline"
| Header loc . out = @level.out +++ dltxArg @text.out
- | Group loc . out = dltxBeginEnd @envtype.out @text.out
+ | Group loc . out = @envtype.outWrap $ dltxBeginEnd @envtype.out @text.out
| DocumentContent loc . out = dltxBeginEnd "document" @text.out
| Table loc . out = dltxBeginEnd "center"
$ dltxBeginEnd "tabular"
@@ -179,6 +179,16 @@ SEM TableField
| Fld lhs . out = @extraseptext.out +++ @fld.out
-------------------------------------------------------------------------
+-- Additional wrapping as OutDoc -> OutDoc
+-------------------------------------------------------------------------
+
+ATTR GroupType [ | | outWrap: {OutDoc -> OutDoc} ]
+
+SEM GroupType
+ | Verbatim lhs . outWrap = id -- \x -> dltxArg (dltxCmd "tiny" +++ outnl +++ x +++ outnl)
+ | * - Verbatim lhs . outWrap = id
+
+-------------------------------------------------------------------------
-- Replacement, as [OutDoc]
-------------------------------------------------------------------------
View
71 EHC/text/Blog.cltex
@@ -1,5 +1,74 @@
%%[main
-%%@Blog.entry20101027.javascript.FFI
+%%@Blog.entry20120913.javascript.wholeProgLinking
+%%]
+
+%%[entry20120913.javascript.wholeProgLinking doclatex
+\section{Compiling Haskell to compact Javascript programs}
+@UHC@ allows for the generation of relatively compact Javascript programs from Haskell. With relatively I mean that @UHC@ can prune unnecessary code at the Core level before generating Javascript but then still redundant code from the runtime system remains, as well as the use of lengthy identifiers. This of course can be fixed, but currently not by @UHC@. Let's look at a small Hello World example and see what @UHC@ can do to obtain compact code.
+
+The hello world example @Hello.hs@ used runs in a browser, popping up an alert:
+
+\begin{pre}
+module Hello where
+
+import Language.UHC.JS.Prelude
+import Language.UHC.JS.Assorted
+
+main = alert "Hi"
+\end{pre}
+
+The UHC specific Javascript library \href{https://github.com/UU-ComputerScience/uhc-js}{UHC JavaScript libraries} for interacting with the Javascript runtime environment is required, so to get it running execute in a shell:
+
+\begin{pre}
+> git clone git://github.com/UU-ComputerScience/uhc-js.git uhcjs # read only access
+> uhc --import-path=uhcjs/uhc-js/src -tjs Hello.hs
+\end{pre}
+
+This will create @Hello.js@ and @Hello.html@; @Hello.html@ loads both @Hello.js@ and library modules, omitting most @script@ tags for brevity:
+
+\begin{pre}
+<!DOCTYPE html><html><head><title>Hello</title>
+<script type="text/javascript" src="/usr/local/lib/uhc-1.1.4/lib/js/libEH-RTS.mjs"></script>
+<script type="text/javascript" src="/usr/local/lib/uhc-1.1.4/lib/pkg/uhcbase-1.1.4/uhc-1.1.4/js/plain/UHC/UHC_Base.mjs"></script>
+...
+<script type="text/javascript" src="/usr/local/lib/uhc-1.1.4/lib/pkg/uhcbase-1.1.4/uhc-1.1.4/js/plain/UHC/UHC_Run.mjs"></script>
+<script type="text/javascript" src="/usr/local/lib/uhc-1.1.4/lib/pkg/base-3.0.0.0/uhc-1.1.4/js/plain/Prelude.mjs"></script>
+<script type="text/javascript" src="uhcjs/uhc-js/src/Language/UHC/JS/Language_UHC_JS_Types.mjs"></script>
+...
+<script type="text/javascript" src="uhcjs/uhc-js/src/Language/UHC/JS/Language_UHC_JS_Assorted.mjs"></script>
+<script type="text/javascript" src="Hello.js"></script>
+</head>
+<body>
+</body>
+</html>
+\end{pre}
+
+Opening @Hello.html@ in a browser then pops up an alert box.
+
+The problem with the resulting @Hello.html@ is that it loads too much code; running a word count reveals that almost 2MB will be loaded!
+This might be ok for locally running the html file, but now for network based access.
+
+Luckily the @-O@ optimization flag for @UHC@ allows to specify in which compiler stage linking will take place:
+
+\begin{pre}
+> uhc --import-path=uhcjs/uhc-js/src -tjs -O,2 Hello.hs
+\end{pre}
+
+With the @-O@ flag both the amount of optimization may be specified (e.g. classical @-O2@) as well as the scope of it, the @2@ behind the comma indicating that optimizations should be done on the whole program on the Core level (instead of just per module, being the default). Currently not many optimizations are in place in @UHC@ but this mechanism links all imported modules on the Core level, only pulling in required code, thus automatically minimizing its size. The size of @Hello.js@ now is almost 60KB, of which the major part is the runtime system. No other modules need to be loaded, as shown by the corresponding @Hello.html@:
+
+\begin{pre}
+<!DOCTYPE html><html><head><title>Hello</title>
+<script type="text/javascript" src="Hello.js"></script>
+</head>
+<body>
+</body>
+</html>
+\end{pre}
+
+This form of linking only has meaning for a program actually having a @main@ because @main@ acts as the root from which to start pulling in required code.
+In addition to @main@ also the @foreign export@s declarations of all linked modules are used as a root.
+
+
%%]
%%[entry20101204.Brazil.intersection doclatex
View
4 EHC/text/ReleaseHistory.cltex
@@ -1,6 +1,6 @@
%%[main
\section{Changes from 1.0.0 to 1.0.1 (20090425)}
-%%@ReleaseHistory.versionFrom100To101
+%%%@ReleaseHistory.versionFrom100To101
%%]
@@ -18,6 +18,6 @@ Fixed \href{http://code.google.com/p/uhc/issues/list}{issues 1 - 7}
\subsection{SVN log}
\begin{pre}
-%%@[exec:svn log -rHEAD:1576%%]
+%%%@[exec:svn log -rHEAD:1576%%]
\end{pre}
%%]
View
100 EHC/text/ToolDocEHC.cltex
@@ -126,6 +126,10 @@ hence no documentation is currently available.
\label{pragmas}
%%@ToolDocEHC.pragmas
+\subsection{Preprocessing (with @cpp@)}
+\label{preprocessing}
+%%@ToolDocEHC.preprocessing
+
\section{Haskell compatibility}
\label{HaskellCompatibility}
\glabel{HaskellCompatibility}
@@ -149,7 +153,7 @@ hence no documentation is currently available.
\subsubsection{@bc@ and @C@ backend}
%%@ToolDocEHC.ffi.C.bc
-\subsubsection{@js@}
+\subsubsection{@js@ backend}
%%@ToolDocEHC.ffi.js
@@ -454,12 +458,12 @@ A list of often occurring build problems is maintained \eref{BuildProblems}{here
%%[[gettingStartedDownload
\begin{itemize}
-\item Prerequisites:
+\item Prerequisites. Running the configure scripts yields an overview of what is missing.
\begin{itemize}
- \item \href{http://haskell.org/ghc/}{GHC}: a recent version, preferably @>= 6.12.1@; @GHC 6.12.1@ has been used for development.
- Older GHC versions may do as well, but are not used for developing.
+ \item \href{http://haskell.org/ghc/}{GHC}: a recent version, preferably @>= 7.0.3@; @GHC 7.0.3@ has been used for recent development, @GHC 7.4.1@ for current development.
+ Older GHC versions may do as well, but are not used for developing, nor is any effort done for keeping @UHC@ compilable with older @GHC@ versions.
The installed libraries should include the @mtl@ and @fgl@ library.
- Depending on platform and GHC distribution more libraries may need to be installed.
+ Depending on platform and @GHC@ distribution more libraries may need to be installed.
\item Additional libraries, available via \href{http://hackage.haskell.org/packages/hackage.html}{Hackage} or \href{http://www.cs.uu.nl/wiki/HUT/WebHome}{locally}.
\begin{itemize}
\item \href{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/uulib}{uulib}: parser combinators.
@@ -550,15 +554,21 @@ Type @make help@ to see what more can be build:
\subsubsection{Configuration parameters}
-Apart from the usual options @./configure@ accepts the following options enabling a particular feature:
+Apart from the usual options the @./configure@ accepts the following options enabling a particular feature.
+Unless mentioned otherwise, the default is @no@.
\begin{itemize}
\item \verb|--enable-java|. Enable @jazy@ backend.
-% \item \verb|--enable-jscript|. Enable @jscript@ (Javascript) backend. Default=yes.
-\item \verb|--enable-llvm|. Enable @llvm@ backend.
-\item \verb|--enable-clr|. Enable @clr@ backend.
+\item \verb|--enable-jscript|. Enable @jscript@ (Javascript) backend. Default=@yes@.
+\item \verb|--enable-llvm| (implies @wholeprogAnal@, @wholeprogC@). Enable @llvm@ backend.
+\item \verb|--enable-clr| (implies @wholeprogAnal@, @wholeprogC@). Enable @clr@ backend.
\item \verb|--enable-tycore|. Enable @TyCore@ typed core intermediate representation.
\item \verb|--enable-tauphi| (implies @tycore@). Enable @TyCore@ based experimental strictness optimizations.
+\item \verb|--enable-wholeprogC| (implies @wholeprogAnal@). Enable the @C@ whole program analysis backend.
+\item \verb|--enable-wholeprogAnal|. Enable whole program analysis.
+\item \verb|--enable-coresysf| (under construction). Enable System F generation for Core.
+\item \verb|--enable-cmm| (under construction). Enable Cmm intermediate language for C code generation.
\end{itemize}
+Replacing @enable@ with @disable@ will have the reverse effect.
%%]]
@@ -983,11 +993,30 @@ The implementation still has some quirks when abstracted dictionaries are involv
%%]
%%[lexicallyScopedTyVar doclatex
-Lexically scoped type variables can be introduced via pattern type signatures,
+Lexically scoped type variables can be introduced via
+\begin{itemize}
+\item
+pattern type signatures on arguments,
for example in the following result type and type of an intermediate computation are connected:
\begin{pre}
z (Wrap x) :: (mt,...) = let (m::mt,y) = properFraction x in (m::mt, Wrap y)
\end{pre}
+\item
+pattern type signatures on a function result,
+as in the following:
+\begin{pre}
+z a b c :: x = ... :: x
+\end{pre}
+\item
+type variables occurring in instance declarations,
+as in the following for @a@ and @b@:
+\begin{pre}
+instance (Sup (a (b ())) (a (b c)), Widen (a ()) (a (b ()))) => Sup (a ()) (a (b c)) where
+ downcast o = case widen o :: Maybe (a (b ())) of
+ Just r -> downcast r
+ Nothing -> Nothing
+\end{pre}
+\end{itemize}
%%]
@@ -1072,21 +1101,40 @@ The following pragmas are supported.
\begin{itemize}
\item \verb|{-# LANGAUGE pragma #-}| (file header) pragmas, where pragma may be:
\begin{itemize}
-\item @CPP@ : switch on \href{http://gcc.gnu.org/onlinedocs/cpp/}{cpp} preprocessing.
+\item @CPP@ : switch on \href{http://gcc.gnu.org/onlinedocs/cpp/}{cpp} preprocessing. See also \lref{preprocessing}{preprocessing}.
\item @NoImplicitPrelude@: don't automatically import @Prelude@ and/or assume its presence.
\item @GenericDeriving@, @NoGenericDeriving@: turn on/off respectively generic deriving, default is on.
+\item @BangPatterns@, @NoBangPatterns@: turn on/off respectively bang patterns, default is on.
\item @ExtensibleRecords@: turn on special syntax for extensible records. Available for internal backwards compatibility, but otherwise useless as codegeneration and runtime currently does not support extensible records. It reserves the operators \verb|#| and \verb|:=| for record selection and update respectively.
\end{itemize}
\item \verb|{-# DERIVING class field generic-function #-}| pragma: see \lref{generic-deriving}{generic deriving}.
\item \verb|{-# EXCLUDE_IF_TARGET targets #-}| (file header pragma) make the module invisible for compilation. This is a (hopefully) temporary measure to deal with the abilities of distinctive backend. For example, the @js@ (Javascript) backend does not support (e.g.) file access.
+\item \verb|{-# OPTIONS_UHC "..." #-}| (file header pragma) provide compiler options as a string to be parsed as if it were passed via the commandline.
\end{itemize}
Other or unsupported pragmas are silently ignored, even when appropriate currently no warning will be given.
The text inside the pragma delimiters is then treated as normal comment, as were it inside plain \verb|{-| and \verb|-}| comment delimiters.
%%]
+%%[preprocessing doclatex
+With @LANGUAGE@ pragma @CPP@ defined, or option @--cpp@ specified, source text will be preprocessed by @cpp@ before compilation.
+With option @--optP@ additional options passed to @cpp@ may be given.
+
+The following compile time flags are then defined.
+Unless mentioned otherwise the flags are just defined, i.e. have no value.
+\begin{itemize}
+\item \verb|__UHC__|, which has the numerical form of the compiler version as its value (See also option \verb|--version-asnumber|).
+\item \verb|__UHC_TARGET_X__|, where @X@ stands for the current backend target.
+\item \verb|__UHC_BUILDS_X__|, where @X@ stands for
+ \begin{itemize}
+ \item @O@ when @C@ compilation is done (only relevant for C code compilation, but @cpp@ is then invoked as part of @C@ compilation).
+ \item @CPP@ when @cpp@ preprocessing is done.
+ \end{itemize}
+\end{itemize}
+%%]
+
%%[typelevelOperators doclatex
UHC allows type constructors, classes, and type variables to be operators, and to be written infix, as does GHC.
-See GHC's documentation on
+See (e.g.) GHC's documentation on
\href{http://haskell.org/ghc/docs/6.12.1/html/users_guide/data-type-extensions.html}{Infix type constructors, classes, and type variables}
%%]
@@ -1327,13 +1375,23 @@ The subsequent is taken from the \href{http://utrechthaskellcompiler.wordpress.c
For reference, import entities follow the following grammar:
\begin{pre}
-<ent> ::= (<arg> | ident) <post>*
-<arg> ::= '%' <argnr> | '%*' | <string>
-<post> ::= '(' <arg> ')' | '.' ident | '[' <arg> ']'
-<string> ::= '"' char* '"' | "'" char* "'"
+exp ::= '{}' -- Haskell constructor to JS object
+ | (arg | ident) post * -- JS expression
+post ::= '.' ident -- object field
+ | '[' exp ']' -- array indexing
+ | '(' args ')' -- function call
+args ::= epsilon | arg (, arg) * -- possible arguments
+arg ::= '%' ('*' | int) -- all arguments, or a specific one
+ | '"' str '"' -- literal text
+
+ident ::= a valid JavaScript identifier
+int ::= any integer
+str ::= any string
\end{pre}
where @ident@ is a Haskell like lowercase/uppercase identifier, and where parenthesis only may appear at the end.
+
+See also \href{http://uu-computerscience.github.com/uhc-js/}{The Utrecht Haskell Compiler JavaScript Backend Page}
%%]
%%[includedPackages doclatex
@@ -1381,8 +1439,9 @@ The C based backends (C, bc) use the following public domain libraries:
\subsubsection{Third party libraries}
\begin{itemize}
-\item \href{http://www.hpl.hp.com/personal/Hans_Boehm/gc/}{Boehm Garbage Collection} (BGC) library.
- Some corners of some backends (notably llvm) still linger onto the BGC library, other backends are not using BGC anymore.
+%\item \href{http://www.hpl.hp.com/personal/Hans_Boehm/gc/}{Boehm Garbage Collection} (BGC) library.
+% Some corners of some backends (notably llvm) still linger onto the BGC library, other backends are not using BGC anymore.
+\item \href{http://libtom.org/}{LibTomMath} has been cloned and adapted to play nicely with the garbage collector.
\end{itemize}
\subsection{Known issues}
@@ -1567,12 +1626,13 @@ This is not yet used, except for experimenting with code generation with extra d
\item \verb|0|: per module (default).
\item \verb|1|: link per module GRIN to whole program GRIN, and continue from there (not yet implemented)
\item \verb|2|: link per module Core to whole program COre, and continue from ther; Core precedes GRIN in the compiler pipeline.
+ \end{itemize}
\item \verb|--no-recomp|. Don't check for the necessity to recompile, recompile allways instead.
\item \verb|--no-prelude|. Don't assume the presence of @Prelude@.
\item \verb|--no-hi-check|. Don't use out of date of compiler version w.r.t. to .hi files as a reason to recompile.
This is useful when debugging the compiler if you know that .hi files will not change.
Use this option only if you know what you are doing.
-\item \verb|--cpp|. Preprocess with \href{http://gcc.gnu.org/onlinedocs/cpp/}{cpp}.
+\item \verb|--cpp|. Preprocess with \href{http://gcc.gnu.org/onlinedocs/cpp/}{cpp}. See also \lref{preprocessing}{preprocessing}.
\item \verb|--limit-tysyn-expand=<nr>|. Limit the level of type synonym expansion.
\item \verb|-i<path>|, \verb|--import-path=<path>|. Add @<path>@ to the search path for importing modules and \href{http://gcc.gnu.org/onlinedocs/cpp/}{cpp}.
\item \verb|--odir=dir|. Generated files are put in @dir@. More precisely, for each generated artefact for a module,
@@ -1596,6 +1656,7 @@ This is not yet used, except for experimenting with code generation with extra d
\item \verb|--pkg-hide-all|: hide all packages.
\item \verb|--pkg-searchpath=path|: additional locations to search for packages.
\end{itemize}
+\item \verb|--opt<X>=opt|. Pass option to command for pass @<X>@. Currently only @P@ is implemented, that is, passing to the preprocessor (CPP).
\end{itemize}
%%]
@@ -1652,6 +1713,7 @@ See also
\item \eref{Text2TextDocumentation}{Text2Text} for documentation formatting.
\item \href{http://haskell.org/ghc/}{GHC}.
\item \href{http://www.cs.uu.nl/wiki/HUT/WebHome}{HUT library}.
+\item \href{http://uu-computerscience.github.com/uhc-js/}{The Utrecht Haskell Compiler JavaScript Backend Page}.
\end{itemize}
%%]
View
2  EHC/text/mainsty.clsty
@@ -748,7 +748,7 @@ Anonymity, blinding things
% pre environment (a verbatim environment based upon the fancyvrb package)
\DefineVerbatimEnvironment{pre}{Verbatim}
- {xleftmargin=0.03\linewidth,fontsize=\small}
+ {xleftmargin=0.03\linewidth,fontsize=\footnotesize}
% reference to label in url style:
% #1: label

No commit comments for this range

Something went wrong with that request. Please try again.