sifflet-lib 2.0.0.0 → 2.1.0
raw patch · 13 files changed
+225/−557 lines, 13 filesdep ~basedep ~containersdep ~directory
Dependency ranges changed: base, containers, directory
Files
- Data/Sifflet/WGraph.hs +20/−2
- Graphics/UI/Sifflet/Canvas.hs +24/−20
- Graphics/UI/Sifflet/Frame.hs +4/−4
- Graphics/UI/Sifflet/GtkUtil.hs +32/−31
- Graphics/UI/Sifflet/Window.hs +32/−28
- ISSUES +0/−403
- Language/Sifflet/Export/Exporter.hs +35/−0
- Language/Sifflet/Export/ToPython.hs +8/−16
- Language/Sifflet/Export/ToScheme.hs +15/−10
- Language/Sifflet/Expr.hs +1/−1
- Language/Sifflet/SiffML.hs +3/−1
- Language/Sifflet/TypeCheck.hs +35/−33
- sifflet-lib.cabal +16/−8
Data/Sifflet/WGraph.hs view
@@ -2,7 +2,7 @@ (WNode(..), WEdge(..), WGraph, WContext , wgraphNew, isWSimple, isWFrame, grInsertNode, grRemoveNode , connectToFrame- , grConnect, grDisconnect+ , grConnect, grInletIsConnected, grDisconnect , grAddGraph , grExtractExprTree, grExtractLayoutNode, grExtractLayoutTree @@ -158,8 +158,26 @@ (pins, jparent, plabel, (inlet, jchild) : pouts') & ((cins', jchild, clabel, couts) & g'') +-- | Tell whether a parent node already has a child connected on+-- the given inlet.++grInletIsConnected :: WGraph -> G.Node -> WEdge -> Bool+grInletIsConnected graph parent inlet =+ let (mContext, _g) = match parent graph+ in case mContext of+ Nothing -> + error "grConnect: parent not found"+ Just (_ins, _parent, _label, outs) ->+ -- _parent == parent+ any (edgeEqual inlet) outs+ +++edgeEqual :: WEdge -> (WEdge, G.Node) -> Bool+edgeEqual edge pair = edge == fst pair+ edgeNotEqual :: WEdge -> (WEdge, G.Node) -> Bool-edgeNotEqual edge pair = edge /= fst pair+edgeNotEqual edge = not . edgeEqual edge edgeNotTo :: G.Node -> (WEdge, G.Node) -> Bool edgeNotTo node pair = node /= snd pair
Graphics/UI/Sifflet/Canvas.hs view
@@ -381,32 +381,36 @@ in loop tuples --- | Connect nodes+-- | Connect nodes.+-- If parent and child are different,+-- connect the i-th inlet of node parent+-- to the o-th outlet of node child+-- UNLESS doing so would create a cycle+-- parent -> child -> ... -> parent+-- AND UNLESS something is already connected+-- to the ith inlet of the parent node. connect :: VCanvas -> G.Node -> WEdge -> G.Node -> WEdge -> IO VCanvas connect canvas parent inlet child outlet = do- -- if parent and child are different,- -- connect the ith inlet of node parent- -- to the oth outlet of node child- -- provided that doing so would not create a cycle- -- parent -> child -> ... -> parent- let graph = vcGraph canvas if elem parent (reachable child graph)- then - do- showErrorMessage "Sorry, this connection would create a cycle."- return canvas- else - -- now we need to store a labeled edges (inlet -> outlet)- -- and to clear any previous connections of the two.- let graph' = grConnect graph parent inlet child outlet- in return $ canvas {vcGraph = graph'}---- | Disconnect nodes+ then do + showErrorMessage "Sorry, this connection would create a cycle."+ return canvas+ else if grInletIsConnected graph parent inlet+ then do+ showErrorMessage $ "There is already something here; " +++ "disconnect it first."+ return canvas+ else+ -- now we need to store a labeled edges (inlet -> outlet)+ -- and to clear any previous connections of the two.+ let graph' = grConnect graph parent inlet child outlet+ in return $ canvas {vcGraph = graph'} --- disconnect wouldn't need to be in the IO monad,--- except that it needs the same type signature as connect+-- | Disconnect nodes.+-- Disconnect wouldn't need to be in the IO monad,+-- except that it needs the same type signature as connect. disconnect :: VCanvas -> G.Node -> WEdge -> G.Node -> WEdge -> IO VCanvas disconnect canvas parent inlet child outlet = do
Graphics/UI/Sifflet/Frame.hs view
@@ -300,8 +300,8 @@ Nothing -> vars Just [] -> vars Just values ->- if length vars /= length values- then error "buildFooterText: mismatched lists"- else [var ++ " = " ++ repr value |- (var, value) <- zip vars values]+ -- in case there are fewer values than vars,+ -- pad out with "?"s+ [var ++ " = " ++ rvalue |+ (var, rvalue) <- zip vars (map repr values ++ repeat "?")] in concat (intersperse ", " items)
Graphics/UI/Sifflet/GtkUtil.hs view
@@ -38,47 +38,48 @@ -- CUSTOMIZABLE DIALOGS -- | Show a message and a set of choices;--- run the action corresponding to the selected choice;--- you might want to include a "Cancel" option with the action return ().--- There *should* be as many actions as there are options.-showChoicesDialog :: String -> String -> [String] -> [IO a] -> IO a-showChoicesDialog title message options actions = do- {- -- Create basic dialog- dialog <- dialogNew- ; windowSetTitle dialog title- ; widgetSetName dialog ("Sifflet-" ++ title)+-- run the action corresponding to the selected choice.+-- The last argument is an action corresponding to the "Cancel" option+-- (a Cancel button is automatically inserted) and is also used for+-- strange actions like closing the dialog window.+-- A good value for this might be return ().+showChoicesDialog :: String -> String -> [String] -> [IO a] -> IO a -> IO a+showChoicesDialog title message options actions cancelAction = do+ -- Create basic dialog+ dialog <- dialogNew+ windowSetTitle dialog title+ widgetSetName dialog ("Sifflet-" ++ title) -- Add message- ; vbox <- dialogGetUpper dialog- ; label <- labelNew (Just message)- ; boxPackStartDefaults vbox label- ; widgetShowAll vbox+ vbox <- dialogGetUpper dialog+ label <- labelNew (Just message)+ boxPackStartDefaults vbox label+ widgetShowAll vbox -- Add buttons -- Work around bug in gtk2hs v. 0.10.0 and 0.10.1, -- which is fixed in darcs gtk2hs. -- fromResponse (ResponseUser i) requires i > 0. -- so zip [1..] instead of zip [0..]- ; let indexOptions = zip [1..] options- addButton (i, option) = - dialogAddButton dialog option (ResponseUser i)- ; forM_ indexOptions addButton- ; dialogGetActionArea dialog >>= widgetShowAll+ let allActions = actions ++ [cancelAction]+ allOptions = options ++ ["Cancel"]+ indexOptions = zip [1..] allOptions+ addButton (i, option) = + dialogAddButton dialog option (ResponseUser i)+ forM_ indexOptions addButton+ dialogGetActionArea dialog >>= widgetShowAll -- Run dialog- ; response <- dialogRun dialog- ; widgetDestroy dialog -- here? or after handling response?- ; case response of- ResponseUser i -> - let j = i - 1 -- work around bug described above- in if j >= 0 && j < length actions- then actions !! j- else errcats ["showChoicesDialog: response index",- show j, "is out of range for actions"]- _ -> errcats ["showChoicesDialog: expected a ResponseUser _ but got",- show response]- }+ response <- dialogRun dialog+ widgetDestroy dialog -- here? or after handling response?+ case response of+ ResponseUser i -> + let j = i - 1 -- work around bug described above+ in if j >= 0 && j < length allActions+ then allActions !! j+ else errcats ["showChoicesDialog: response index",+ show j, "is out of range for actions"]+ _ -> cancelAction createDialog :: String -> (VBox -> IO a) -> IO (Dialog, a) createDialog title addContent = do
Graphics/UI/Sifflet/Window.hs view
@@ -453,19 +453,13 @@ else [] labels = map fst choices actions = map snd choices- -- labels = ["Save them", - -- "Throw them away", - -- ]- -- actions = [menuFileSave vpui >>= mAckIfSaved >>= continue, -- save- -- return vpui >>= continue, -- throw away- -- return vpui] -- cancel offerSaveAndContinue = showChoicesDialog "Save changes?"- ("There are unsaved changes. " ++- "Before you " ++ beforeOperation ++- ", would you ...")- labels- actions- + ("There are unsaved changes. " +++ "Before you " ++ beforeOperation +++ ", would you ...")+ labels+ actions+ (return vpui) in if vpuiFileChanged vpui then offerSaveAndContinue else continue vpui@@ -638,40 +632,50 @@ "Use lambda in function definitions?" ["Yes", "No"] [result True, result False]+ (result False) -- | Save an image of a window in a file menuFileSaveImage :: VPUI -> IO VPUI menuFileSaveImage vpui = do- (windowId, fileExt) <- chooseImageOptions vpui- mfile <- chooseOutputFile ("Save image of " ++ windowId) vpui- case mfile of+ mImageOptions <- chooseImageOptions vpui+ case mImageOptions of Nothing -> return vpui- Just filePath ->- saveImageFile vpui windowId filePath fileExt+ Just (windowId, fileExt) -> do+ mfile <- chooseOutputFile ("Save image of " ++ windowId) vpui+ case mfile of+ Nothing -> return vpui+ Just filePath ->+ saveImageFile vpui windowId filePath fileExt -- | Returns (WinId, fileExtension), -- e.g., ("Sifflet Workspace", ".svg"), -- where fileExtension is ".svg", ".ps", or ".pdf"-chooseImageOptions :: VPUI -> IO (WinId, String)+chooseImageOptions :: VPUI -> IO (Maybe (WinId, String)) chooseImageOptions vpui = let hasCanvas winId = isJust (vpuiWindowLookupCanvas (vpuiGetWindow vpui winId)) -- We can only use Cairo to render a window that has a canvas windowChoices = filter hasCanvas (keys (vpuiWindows vpui))- windowActions = map return windowChoices+ windowActions = map (return . Just) windowChoices formatChoices = ["SVG", "PS", "PDF"]- formatActions = map return [".svg", ".ps", ".pdf"]+ formatActions = map (return . Just) [".svg", ".ps", ".pdf"] in do- ext <- showChoicesDialog "Save Image" "Select image format"- formatChoices formatActions- winId <- if length windowChoices == 1- then return $ head windowChoices- else showChoicesDialog "Save Image"- "Select window to save as image"- windowChoices windowActions- return (winId, ext)+ mExt <- showChoicesDialog "Save Image" "Select image format"+ formatChoices formatActions (return Nothing)+ case mExt of+ Nothing -> return Nothing+ Just ext -> do+ mWinId <- + if length windowChoices == 1+ then return $ Just $ head windowChoices+ else showChoicesDialog "Save Image"+ "Select window to save as image"+ windowChoices windowActions (return Nothing)+ case mWinId of+ Nothing -> return Nothing+ Just winId -> return $ Just (winId, ext) -- | Save the window image in the file format specified, -- adding the right file extension to the file path if it is
− ISSUES
@@ -1,403 +0,0 @@-ISSUES-======--Issues for sifflet and sifflet-lib--This is the ISSUES file for both sifflet and sifflet-lib.-If you are editing it, be sure you are editing the original-and not the copies in the app and lib subdirectories.--O = date opened-R = reporter-P = priority-C = closed--OPEN ISSUES--------------41 next issue bug number--40 Duplicate arguments in "Edit Arguments"-- Adding a duplicate argument in the "Edit Arguments" dialog- is possible (for example, two arguments named "f").- It should not be.- O: 2012 July 2- R: gdw- P: medium--39 No lambda tool-- There is no lambda tool, and since partial application doesn't work- (issue 32), this means there is no way to have a function return a function.- O: 2012 jul 2- R: gdw- P: medium--38 Working directory-- Sifflet should have some sense of its working directory, - for convenience of opening and saving files- O: 2012 july 2- R: gdw- P: medium--37 Changing helper function definition does not affect displayed function call-- See f2 and testF2 in ../examples/map.sfl- When testF2 is called on the workspace, and you edit and chagne f2,- apply the new definition, the displayed call is not re-evaluated- using the new definition. In fact if you use the displayed- testF2 frame to call again, it still uses the old definition --- it seems permanently bound to it. To use the new definition- of f2, you have to place a new copy of testF2 on the workspace.-- O: 2012 Jun 27- R: gdw- P: low--36 Cascade effect of changing kind of arguments to a function.-- When we change the number of type (kind) of the arguments of- a function, we also change the function's type (or kind); and if- it's used in the definitions of other functions, then they may- become invalid in turn -- what should be done in this case?- O: 2012 Jun 27- R: gdw- P: medium--33 testMapSumFromZero (see ../examples/map.sfl)- In testMapSumFromZero n, with n = [1,2],- opening the sumFromZero node displays bogus error messages- as though it is a call to sumFromZero with n = [1,2].- In fact, the node has no input, so there is no call - to sumFromZero until we get into map.- The problem doesn't occur with recursive functions.- It must be because the node has an inlet that expects n,- and finds n in the enclosing environment although it is not called.- O: 2012 June 22- R: gdw- P: low--32 Partial application does not work- (e.g., calling the + function with one argument)- Comment: See also #39.- O: 2012 Jun 21- R: gdw- P: medium--31 Edit function inputs: when an argument tool is selected,- and you change the arity of that argument, the next click- of the tool puts the argument down on the canvas with its- *old* arity; should be the new arity.- Comment: A work-around is to reselect the tool to get the right arity.- O: 2012 Jun 21- R: gdw- P: medium--26 EditArgsPanel: TAB fails to move the cursor to the next field.- O: 2011 Jun 23- R: gdw- P: medium-high--25 Nodes lose unused inlets when applying a function definition.- - Suppose the f node has two inlets, but none of them are- used by any f nodes in the definition. Then when you apply the- definition, all the f nodes lose both of their inlets.- On the other hand, if one f node uses none of its two inlets- and another uses both, then when you apply the definition,- both of them keep both of their inlets.- O: 2011 Jun 23- R: gdw- P: lowest.- Comment:- This seems not really to be a problem. If NONE of the f nodes- use their inlets, then why do they have inlets, anyway?- Besides, it should become irrelevant when a new UI is- developed without the circular inlets, as in issue 24.- Comment: The inlets will reappear if you reopen the "inputs"- dialog and then click "OK".--24 Arguments are shifted when applying a function definition.- - If a node has 3 inlets and connections on inlets 1 and 2,- but not on 0, then when "apply" is clicked the connections are- shifted to inlets 0 and 1, leaving 2 open.- O: 2011 Jun 23- R: gdw- P: lowest.- This should become irrelevant when and if I develop a new- UI that does away with the circular inlets. Why not just- let the user make as many connections as they please? And- that would get rid of the need for a dialog that lets you- change the number of inlets too.--23 typeToXml fails for (TypeCons Function)- O: 2011 Jun 23- R: gdw- P: medium--22 When you connect an input to the second (or generally not first)- input port of a node, and leave the first "open", then click on- apply, the input is reconnected to the first port instead of the- second.- -- Is this actually a bug? - O: 2011 Jun 2- R: gdw- P: ???--14 If two frames overlap, then clicks on the top frame- sometimes are interpreted as clicks on the lower (hidden) frame.- O: 2010 aug 16- P: low--13 If you change any of the *example* functions and quit or open,- Sifflet prompts you to save changes, but it does not save- these particular changes, since they are not in "My Functions".- Probably need to re-design the whole organization of examples- and my functions, introduce modules associated with files,- and show each in its own panel.- Opened 2010 May 27.- Priority: low--11 When function f, which calls function g, is on the workspace,- and you edit g, the changes do not propagate back to f, so that- calling f results in calling the *old* g.- Example: open test-champ.siff, place two-lovely on the workspace,- call it with any argument, edit lovely, apply, call two-lovely- again.- Opened 2010 May 20. - Priority: medium--* * *--CLOSED ISSUES-----------------1 After using the literal tool, etc., the program stops responding- to key presses in the workspace.- Opened ??- Closed 2009 Oct 5.--2 Fix resize frame- Opened ??- Closed 2009 Oct 13.--3 Quitting (q and File/quit) should actually quit!- Opened ??- Closed 2009 Oct 13.--4 vpTypeOf fails for [].- Opened ??- Closed 2009 Oct 30.--5 Deleting a node leaves its children orphans.- Opened ??- Closed 2009 Nov 4.--6 After closing "My functions" window and re-opening it,- it should "remembers" the function tools that it had when closed,- instead of showing up as a blank window.- Opened ??- Closed 2009 Nov 11--7 If function pad window is closed, then creating a - new function results in a "key not found" error.- Opened ??- Closed 2010 March 1--8 Opening a file twice put duplicate tools in- "My Functions" window (and toolkit, presumably).- Opened ??- Closed 2010 May 13--9 After the dialog suggesting save changes before quitting or- opening a new file, the program crashes due to a bug in- Gtk2hs 0.10.0 and 0.10.1 (but fixed in gtk2hs darcs).- Opened ??- Closed 2010 May 20.--10 Evaluating a call frame with zero arguments- opens an unnecessary dialog (there are not arguments,- so no values needed); moreover, it does not evaluate- the function call.--15 In the test function list_of_2, evaluating [] results in- "error: unbound variable: []". Ditto repeat_a_b.- O: 2010 aug 16- P: high- C: 2010 aug 16 -- fixed.--16 Editing a function, if you enter the literal ["a", "b"],- the program crashes with this message:- sifflet-new-expr: makeFixedLiteralTool: - non-empty list expression EList [EString "a",EString "b"]- O: 2010 aug 16- P: high- C: 2010 aug 16 -- fixed.---17 There is an error in reading a non-empty list element from- a SiffML file, e.g., - <literal>- <list>- <string>a</string>- <string>b</string>- </list>- </literal>- due to the fact that the children of the <list> element- directly represent values, not expressions, so they are- not read correctly (not read at all?) by xmlToExpr.- I think I need to use xmlToValue here, but how to connect- the two is not easy.- In the long run, it is desirable to change the XML doctype,- dropping the <literal> element so that strings would be- e.g. just <string>a</string>- and lists would be just e.g. - <list>- <string>a</string>- <string>b</string>- </list>- O: 2010 aug 17- P: highest- C: 2010 aug 17 -- fixed.--19 Closing all program windows leaves executable still running- but no way to kill it (Ctrl+C is a no-op).*- O: 2010 nov 3- R: Andrew Coppin andrewcoppin@btinternet.com- P: HIGH- C: 2010 dec 9 (actually fixed dec 3): closing the workspace window- now "safely" quits from the application.--20 Amend documentation/home page to note that installation on- Windows without curl is now definitely feasible- O: 2010 nov 3- R: Andrew Coppin andrewcoppin@btinternet.com- P: medium- C: 2010 dec 9 (actually fixed dec 3)--21 Define adds list =- if null list- then 0- else if head list- then + list 1- else tail (head list)- Call the function with list = [1]- Sifflet crashes with this error message:- evalTreeWithLimit (if): unexpected test result- O: 2010 dec 9- R: Charles Turner III (turnchan@iue.edu)- P: high- C: 2010 dec 9--29 typedValue (in Parser.hs) has two conditions that result in- run-time errors. For testing higher-order functions, it would- be good to be able to type in the name of a function in the global- environment, but we don't have access to the environment here,- do we? Also in case of failure, it should fail with an error- message but not crash sifflet.- O: 2012 Jun 15- R: gdw- P: high- Crashes program.- C: 2012 June 21 -- fixed.--30 typeToXml: program crashes when saving the map function definition,- with message:- sifflet-devel: typeToXml: TypeCons Function cannot be converted to XML.- Notes: - 1. typeToXml is fixed, but now I also need to fix the corresponding- part of xmlToType so the file can be read back in.- 2. Maybe better still:- Why do we need the types in the XML file anyway, now that- we have type inference?- 3. Also revise schema/DTD for SiffML files.- O: 2012 Jun 21- R: gdw- P: highest - program crash- C: 2012 June 22, fixed.--28 EditArgsPanel should change inlets for existing nodes when the arg's- kind is changed.- - Suppose you change the number of parameters for argument f.- Then any existing f nodes on the drawing should have their- number of inlets changed correspondingly.- Currently this works if the number is increased, but- fails if it is decreased and there are now too many- connected children in the graph --> error in graphRenderTree.- Unfortunately, this is not the place where that can be fixed:- even if I reduce nto or nfrom in this context,- there are still the contexts in the connected children to- consider.- - Also, when extra inputs are disconnected (as they should be)- they are sometimes also deleted from the canvas (shouldn't be).- O: 2011 Jun 23- R: gdw- P: highest. Crashes program.- C: 2012 Jun 27, fixed.---18 Sifflet crashes when applying a function if some connections- are missing.-- "PS. I presume you know that you can crash the whole of Sifflet by- something as trivial as hitting the "apply" button when some- connections are missing, and that closing all of the program windows- leaves the executable still running but with no way to kill it. (I'm- not sure why Ctrl+C is no-op...)"- -- email from Andrew Coppin, 2010 Nov 01.-- O: 2010 nov 3- R: Andrew Coppin andrewcoppin@btinternet.com- P: HIGH- C: 2012 Jun 27 -- unable to duplicate either part of this at this time;- must have been fixed earlier. Though it might be that the- "no way to kill it" issue persists on MS Windows.--35 vcCloseFrame does not remove the frame's subgraph from the canvas graph.-- vcCloseFrame removes only the WFrame node, not the WSimple nodes- displayed in the frame. It should remove all of them, otherwise- clutter builds up every time a function definition is applied,- since the apply command calls vcCloseFrame and then vcAddFrame.- O: 2012 Jun 27- R: gdw- P: high- C: 2012 Jun 27 fixed.--12 Four tests fail in testall -u.- These seem to all involve issues of text node size- and are pretty minor, so maybe the tests need to be - fine-tuned to allow for variations in what Cairo says- is the text's dimensions.- Opened 2010 May 24- Priority: medium- C: 2012 Jul 2, previously fixed but not closed; all unit tests now pass.--34 In edit function / edit arguments: the edit window sometimes- does not sufficiently increase in size, - so the edit arguments buttons (OK, cancel) - are hidden by the edit function buttons (args, apply, inputs, close).- Comment: see darcs change:- Tue Jun 7 12:40:24 EDT 2011 gdweber@iue.edu- * Crude window resizing to fit as the EditArgsPanel grows- - crude because it does not take into account the button bar- below the panel- Comment: duplicate of #27- O: 2012 June 26- R: gdw- P: top- C: 2012 jul 2, fixed--27 EditArgsPanel: window resizing is bad.- - Sometimes the window does not expand enough to show the - panel's buttons.- - Sometimes it shrinks back too much after the panel is closed.- - Comment: lib/Graphics/UI/Sifflet/EditArgsPanel.hs- Workspace.hs : 138- - O: 2011 Jun 23- R: gdw- P: top- C: 2012 jul 2, fixed
Language/Sifflet/Export/Exporter.hs view
@@ -11,10 +11,16 @@ , ruleRightToLeft , applyFirstMatch , findFixed+ , copyLibFile+ , readLibFile ) where +import Control.Monad (unless)+import System.Directory (doesFileExist, copyFile)++import Graphics.UI.Sifflet.GtkUtil (showErrorMessage) import Language.Sifflet.Expr -- | The type of a function to export (user) functions to a file.@@ -190,3 +196,32 @@ EGroup e'' -> EGroup (tdf e'') _ -> e' +-- | Copy a library file (such as sifflet.py or Sifflet.java) to the same directory+-- where an export file is being written, showing a warning message if+-- the library file cannot be found. But don't copy it if it already+-- exists in the destination location.+copyLibFile :: FilePath -> FilePath -> IO ()+copyLibFile orig dest = do+ origExists <- doesFileExist orig+ destExists <- doesFileExist dest+ unless destExists $+ if origExists+ then copyFile orig dest+ else showErrorMessage $ "Sifflet could not locate the file " ++ orig ++ "\n" +++ "Please copy it from the Sifflet installation directory to " +++ "the same directory in which you are saving the export file.\n"+ +-- | Get the contents of a library file (such as sifflet.scm) +-- so you can insert it into the file being exported.+-- If the file cannot be found, display an error message and+-- return the empty string.+readLibFile :: FilePath -> FilePath -> IO String+readLibFile libFile exportFile = do+ libExists <- doesFileExist libFile+ if libExists+ then readFile libFile+ else do+ showErrorMessage $ "Sifflet could not locate the file " ++ libFile ++ "\n" +++ "Please find it in the Sifflet installation directory " +++ "and insert its contents into " ++ exportFile ++ "\n"+ return ""
Language/Sifflet/Export/ToPython.hs view
@@ -18,9 +18,7 @@ where import Data.Char (isAlpha, isDigit, ord)-import Control.Monad (unless) import Data.Map ((!))-import System.Directory (copyFile, doesFileExist) import System.FilePath (replaceFileName) import Language.Sifflet.Export.Exporter@@ -149,23 +147,17 @@ exportPython :: PythonOptions -> Exporter exportPython _options funcs path = - let header = "# File: " ++ path ++- "\n# Generated by the Sifflet->Python exporter.\n\n" +++ let header = "# File: " ++ path ++ "\n" +++ "# Generated by the Sifflet->Python exporter.\n" +++ "# You may need to copy the file sifflet.py to this directory\n" +++ "# from the directory where Sifflet is installed.\n" +++ "\n" ++ "from sifflet import *\n\n" libDest = replaceFileName path "sifflet.py" in do- {- libDestExists <- doesFileExist libDest- ; unless libDestExists - (do- -- copy sifflet.py to the same directory as path- {- libSrc <- pythonLibSiffletPath - ; copyFile libSrc libDest- }- )- ; writeFile path (header ++ (functionsToPrettyPy funcs))- }+ libSrc <- pythonLibSiffletPath + copyLibFile libSrc libDest+ writeFile path (header ++ (functionsToPrettyPy funcs)) pythonLibSiffletPath :: IO FilePath pythonLibSiffletPath = getDataFileName "sifflet.py"
Language/Sifflet/Export/ToScheme.hs view
@@ -303,16 +303,21 @@ -- like defToSExpr. exportScheme :: SchemeOptions -> Exporter-exportScheme options functions path = do- {- let header = ";;; File: " ++ path ++- "\n;;; Generated by the Sifflet->Scheme exporter."- ; lib <- schemeLibSiffletPath >>= readFile- ; writeFile path - (sepLines2 [header,- functionsToPrettyScheme options functions,- lib])- }+exportScheme options functions path =+ let header = ";;; File: " ++ path ++ "\n" +++ ";;; Generated by the Sifflet->Scheme exporter.\n" +++ "\n"+ in do+ -- Get contents of sifflet.scm.+ -- It must be copied into the export file,+ -- since there is no standard way in Scheme to "include" or "import"+ -- a library.+ libFile <- schemeLibSiffletPath+ lib <- readLibFile libFile path+ writeFile path + (sepLines2 [header,+ functionsToPrettyScheme options functions,+ lib]) -- | The path to the "sifflet.scm" file. schemeLibSiffletPath :: IO FilePath
Language/Sifflet/Expr.hs view
@@ -885,7 +885,7 @@ else if isExact a && isExact b then EvalOk $ VNumber (oper a b) else err "arguments must be exact numbers"- _ -> error "wrong type or number of arguments"+ _ -> err "wrong type or number of arguments" in prim name [typeNum, typeNum] typeNum func primIntDiv, primIntMod :: Function
Language/Sifflet/SiffML.hs view
@@ -52,7 +52,9 @@ consumeSiffMLFile :: XMLConsumer XmlTree a -> FilePath -> IO [a] consumeSiffMLFile fromXml filePath = let options = defaultOptions- in runX (readDocument options filePath >>> fromXml)+ in do+ doc <- readFile filePath+ runX (readString options doc >>> fromXml) -- | Symbols
Language/Sifflet/TypeCheck.hs view
@@ -16,8 +16,8 @@ where --- drop this after debugging:-import System.IO.Unsafe(unsafePerformIO)+-- drop after debugging:+import Debug.Trace import Control.Monad (foldM) @@ -26,6 +26,8 @@ import Data.Map as Map hiding (filter, foldr, lookup, map, null) import qualified Data.Map as Map (map, lookup) +import Text.Printf+ import Language.Sifflet.Expr import Text.Sifflet.Repr import Language.Sifflet.Util@@ -434,11 +436,9 @@ tcApp te ns e1 e2 = let (tvn, ns') = nameSupplyNext ns in do- {- (phi, [t1, t2], ns'') <- tcExprs te ns' [e1, e2]- ; phi' <- unify phi (t1, t2 `arrow` (TypeVar tvn))- ; Succ (phi', phi' tvn, ns'')- }+ (phi, [t1, t2], ns'') <- tcExprs te ns' [e1, e2]+ phi' <- unify phi (t1, t2 `arrow` (TypeVar tvn))+ Succ (phi', phi' tvn, ns'') arrow :: Type -> Type -> Type arrow a b = TypeCons "Function" [a, b]@@ -485,38 +485,40 @@ te' = install te name (TypeScheme [] (TypeVar "u")) result :: SuccFail (Type, ([Type], Type)) result = do- {- expr <- toLambdaExpr args body- ; (_, t, _) <- tcExpr te' (newNameSupply "t") expr- -- ; fromLambdaType t- ; res <- fromLambdaType t- ; Succ (t, res)- }- in unsafePerformIO $ do - {- putStrLn "decideTypes:"- ; print (args, body)- ; putStrLn "::"- -- ; print result- -- ; return result- ; case result of- Succ (t, res) -> do { print t ; return (Succ res) }- Fail msg -> do { putStrLn msg; return (Fail msg) }- }+ expr <- traceValue "decideTypes.expr" $ toLambdaExpr args body+ (_, t, _) <- tcExpr te' (newNameSupply "t") expr+ _ <- traceValue "decideTypes.t" $ return t+ res <- traceValue "decideTypes.res" $ fromLambdaType t+ Succ (t, res)+ finalResult = + case result of+ Succ (t, res@(argTypes, _retType)) ->+ if length args == length argTypes+ then Succ res+ else Fail ("Inferred function type " ++ show t +++ " does not agree with number of arguments")+ Fail msg -> Fail msg+ in traceValue (printf "decideTypes: %s ::\n" (show (args, body))) + finalResult ++traceValue :: (Show a) => String -> a -> a+traceValue label value =+ trace (printf "\n%s: %s\n" label (show value)) value++-- | Convert a function type, such as a -> (b -> c), to+-- a pair consisting of the list of argument types and the+-- result type, such as ([a, b], c).+ fromLambdaType :: Type -> SuccFail ([Type], Type) fromLambdaType t = case t of TypeCons "Function" [t1, t2] -> case t2 of- TypeCons "Function" _ ->- do- {- (atypes, rtype) <- fromLambdaType t2- ; return (t1:atypes, rtype)- }- _ ->- Succ ([t1], t2)+ TypeCons "Function" _ -> do+ (atypes, rtype) <- fromLambdaType t2+ return (t1:atypes, rtype)+ _ -> Succ ([t1], t2) TypeCons "Function" _ -> error ("fromLambdaType: invalid function type " ++ show t) _ -> error ("fromLambdaType: non-function type " ++ show t)
sifflet-lib.cabal view
@@ -1,10 +1,10 @@ name: sifflet-lib-version: 2.0.0.0+version: 2.1.0 cabal-version: >= 1.8 build-type: Simple license: BSD3 license-file: LICENSE-copyright: (C) 2009-2012 Gregory D. Weber+copyright: (C) 2009-2013 Gregory D. Weber author: Gregory D. Weber maintainer: "gdweber" ++ drop 3 "abc@" ++ "iue.edu" bug-reports: mailto:"gdweber" ++ drop 3 "abc@" ++ "iue.edu"@@ -24,22 +24,22 @@ siffml-2.0.rnc data-dir: datafiles extra-tmp-files:-extra-source-files: README ISSUES RELEASE-NOTES+extra-source-files: README RELEASE-NOTES -- Library section library build-depends:- base >= 4.0 && < 4.6,+ base >= 4.0 && < 4.8, -- begin GTK stuff, these no longer need to have the same version -- numbers cairo >= 0.11 && < 0.13, glib >= 0.11 && < 0.13, gtk >= 0.11 && < 0.13, -- end- containers >= 0.2 && < 0.5,- directory >= 1.0 && < 1.2,+ containers >= 0.2 && < 0.7,+ directory >= 1.0 && < 1.4, filepath >= 1.1 && < 1.4, fgl >= 5.4 && < 5.5, hxt >= 9.0 && < 10.0,@@ -51,8 +51,16 @@ buildable: True extensions: ForeignFunctionInterface CPP ghc-options: -Wall- includes: gtk-2.0/gtk/gtk.h, gtk-2.0/gdk/gdk.h- extra-libraries: gdk-x11-2.0 gtk-x11-2.0+ -- if os(windows)+ -- extra-libraries: gdk-2.0 gtk+-2.0+ -- includes: gtk/gtk.h, gdk/gdk.h+ -- ghc-options: -Wall --extra-include-dirs=c:/MinGW/msys/1.0/opt/gtk/include --extra-lib-dirs=c:/MinGW/msys/1.0/opt/gtk/lib+ -- ghc-options: -Wall --extra-include-dirs=/c/MinGW/msys/1.0/opt/gtk/include --extra-lib-dirs=/c/MinGW/msys/1.0/opt/gtk/lib+ -- include-dirs: c:/MinGW/msys/1.0/opt/gtk/include+ -- extra-lib-dirs: c:/MinGW/msys/1.0/opt/gtk/lib+ if !os(windows)+ extra-libraries: gdk-x11-2.0 gtk-x11-2.0+ includes: gtk-2.0/gtk/gtk.h, gtk-2.0/gdk/gdk.h exposed-modules: Data.Number.Sifflet