├── CRAPL-LICENSE.txt ├── README.md ├── idris-ruby.cabal └── src ├── IRTS └── CodegenRuby.hs └── Main.hs /CRAPL-LICENSE.txt: -------------------------------------------------------------------------------- 1 | THE CRAPL v0 BETA 1 2 | 3 | 4 | 0. Information about the CRAPL 5 | 6 | If you have questions or concerns about the CRAPL, or you need more 7 | information about this license, please contact: 8 | 9 | Matthew Might 10 | http://matt.might.net/ 11 | 12 | 13 | I. Preamble 14 | 15 | Science thrives on openness. 16 | 17 | In modern science, it is often infeasible to replicate claims without 18 | access to the software underlying those claims. 19 | 20 | Let's all be honest: when scientists write code, aesthetics and 21 | software engineering principles take a back seat to having running, 22 | working code before a deadline. 23 | 24 | So, let's release the ugly. And, let's be proud of that. 25 | 26 | 27 | II. Definitions 28 | 29 | 1. "This License" refers to version 0 beta 1 of the Community 30 | Research and Academic Programming License (the CRAPL). 31 | 32 | 2. "The Program" refers to the medley of source code, shell scripts, 33 | executables, objects, libraries and build files supplied to You, 34 | or these files as modified by You. 35 | 36 | [Any appearance of design in the Program is purely coincidental and 37 | should not in any way be mistaken for evidence of thoughtful 38 | software construction.] 39 | 40 | 3. "You" refers to the person or persons brave and daft enough to use 41 | the Program. 42 | 43 | 4. "The Documentation" refers to the Program. 44 | 45 | 5. "The Author" probably refers to the caffeine-addled graduate 46 | student that got the Program to work moments before a submission 47 | deadline. 48 | 49 | 50 | III. Terms 51 | 52 | 1. By reading this sentence, You have agreed to the terms and 53 | conditions of this License. 54 | 55 | 2. If the Program shows any evidence of having been properly tested 56 | or verified, You will disregard this evidence. 57 | 58 | 3. You agree to hold the Author free from shame, embarrassment or 59 | ridicule for any hacks, kludges or leaps of faith found within the 60 | Program. 61 | 62 | 4. You recognize that any request for support for the Program will be 63 | discarded with extreme prejudice. 64 | 65 | 5. The Author reserves all rights to the Program, except for any 66 | rights granted under any additional licenses attached to the 67 | Program. 68 | 69 | 70 | IV. Permissions 71 | 72 | 1. You are permitted to use the Program to validate published 73 | scientific claims. 74 | 75 | 2. You are permitted to use the Program to validate scientific claims 76 | submitted for peer review, under the condition that You keep 77 | modifications to the Program confidential until those claims have 78 | been published. 79 | 80 | 3. You are permitted to use and/or modify the Program for the 81 | validation of novel scientific claims if You make a good-faith 82 | attempt to notify the Author of Your work and Your claims prior to 83 | submission for publication. 84 | 85 | 4. If You publicly release any claims or data that were supported or 86 | generated by the Program or a modification thereof, in whole or in 87 | part, You will release any inputs supplied to the Program and any 88 | modifications You made to the Progam. This License will be in 89 | effect for the modified program. 90 | 91 | 92 | V. Disclaimer of Warranty 93 | 94 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 95 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 96 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT 97 | WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT 98 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 99 | A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND 100 | PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE 101 | DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR 102 | CORRECTION. 103 | 104 | 105 | VI. Limitation of Liability 106 | 107 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 108 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR 109 | CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 110 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES 111 | ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT 112 | NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR 113 | LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM 114 | TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER 115 | PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 116 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Idris to Ruby back end 2 | ---------------------- 3 | 4 | As Edwin Brady said: 5 | 6 | Please, don't ever use this. 7 | 8 | This repo is based on Edwin's PHP back end for Idris. It targets the ANF intermediate representation and hasn't been optimized at all! 9 | 10 | Example (taken from Edwin) 11 | -------------------------- 12 | 13 | beaker:edwin$ cat pythag.idr 14 | module Main 15 | 16 | pythag : Int -> List (Int, Int, Int) 17 | pythag max = [(x, y, z) | z <- [1..max], y <- [1..z], x <- [1..y], 18 | x * x + y *y == z * z] 19 | 20 | main : IO () 21 | main = print (pythag 50) 22 | 23 | beaker:edwin$ idris pythag.idr --codegen ruby -o pythag.rb 24 | beaker:edwin$ rb pythag.rb 25 | [(3, (4, 5)), (6, (8, 10)), (5, (12, 13)), (9, (12, 15)), (8, (15, 17)), 26 | (12, (16, 20)), (15, (20, 25)), (7, (24, 25)), (10, (24, 26)), (20, (21, 29)), 27 | (18, (24, 30)), (16, (30, 34)), (21, (28, 35)), (12, (35, 37)), (15, (36, 39)), 28 | (24, (32, 40)), (9, (40, 41)), (27, (36, 45)), (30, (40, 50)), (14, (48, 50))] 29 | 30 | -------------------------------------------------------------------------------- /idris-ruby.cabal: -------------------------------------------------------------------------------- 1 | Name: idris-ruby 2 | Version: 0.0.0.1 3 | License: BSD3 4 | License-file: CRAPL-LICENSE.txt 5 | Author: Michael R. Bernstein 6 | Maintainer: Michael R. Bernstein 7 | Build-Type: Simple 8 | Cabal-Version: >= 1.8 9 | Extra-source-files: 10 | 11 | Executable idris-ruby 12 | Main-is: Main.hs 13 | hs-source-dirs: src 14 | 15 | Build-depends: idris 16 | , base 17 | , containers 18 | , directory 19 | , filepath 20 | , haskeline >= 0.7 21 | , mtl 22 | , transformers 23 | , pretty 24 | 25 | other-modules: IRTS.CodegenRuby 26 | 27 | if os(linux) 28 | cpp-options: -DLINUX 29 | build-depends: unix < 2.8 30 | if os(freebsd) 31 | cpp-options: -DFREEBSD 32 | build-depends: unix < 2.8 33 | if os(dragonfly) 34 | cpp-options: -DDRAGONFLY 35 | build-depends: unix < 2.8 36 | if os(darwin) 37 | cpp-options: -DMACOSX 38 | build-depends: unix < 2.8 39 | if os(windows) 40 | cpp-options: -DWINDOWS 41 | build-depends: Win32 < 2.4 42 | 43 | ghc-prof-options: -auto-all -caf-all 44 | ghc-options: -threaded -rtsopts -funbox-strict-fields 45 | 46 | 47 | -------------------------------------------------------------------------------- /src/IRTS/CodegenRuby.hs: -------------------------------------------------------------------------------- 1 | module IRTS.CodegenRuby(codegenRuby) where 2 | 3 | import IRTS.CodegenCommon 4 | import IRTS.Lang 5 | import IRTS.Simplified 6 | import Idris.Core.TT 7 | 8 | import Data.Maybe 9 | import Data.Char 10 | 11 | import Text.PrettyPrint hiding (Str) 12 | 13 | rubyPreamble :: Doc 14 | rubyPreamble = vcat . map text $ 15 | [ "def idris_error(str); puts str; exit(0); end", 16 | "def idris_writeStr(str); puts str; end", 17 | "def idris_readStr;return gets;end", 18 | "def idris_append(l, r);return l + r;end", 19 | "def idris_is_none(l,r); l == r ? 1 : 0;end" ] 20 | 21 | codegenRuby :: CodeGenerator 22 | codegenRuby ci = writeFile (outputFile ci) (render source) 23 | where 24 | source = rubyPreamble $+$ br $+$ (text out) $+$ start 25 | out = concatMap (show . doCodegen) (simpleDecls ci) 26 | start = rubyname (sMN 0 "runMain") 27 | 28 | rubyname :: Name -> Doc 29 | rubyname n = text "idris_" <> (text $ concatMap rubychar (showCG n)) 30 | where rubychar x | isAlpha x || isDigit x = [x] 31 | | otherwise = "_" ++ show (fromEnum x) ++ "_" 32 | 33 | var :: Name -> Doc 34 | var n = rubyname n 35 | 36 | loc :: Int -> Doc 37 | loc i = text "loc" <> (text $ show i) 38 | 39 | doCodegen :: (Name, SDecl) -> Doc 40 | doCodegen (n, SFun _ args i def) = cgFun n args def 41 | 42 | cgComment :: Doc -> Doc 43 | cgComment t = text "#" <+> t 44 | 45 | cgIndent :: Doc 46 | cgIndent = text " " 47 | 48 | doRet :: Doc -> Doc 49 | doRet str = cgIndent <> text "return" <+> str 50 | 51 | def :: Doc 52 | def = text "def" 53 | 54 | end :: Doc 55 | end = text "end" 56 | 57 | br :: Doc 58 | br = text "\n" 59 | 60 | when :: Doc 61 | when = text "when" 62 | 63 | cgFun :: Name -> [Name] -> SExp -> Doc 64 | cgFun n args d 65 | = comment $+$ function $+$ br 66 | where 67 | function = def <+> signature $+$ body $+$ end 68 | signature = rubyname n 69 | <> lparen <> text (showSep "," (map (show . loc . fst) (zip [0..] args))) 70 | <> rparen 71 | body = cgBody doRet d 72 | comment = cgComment (text $ (show n)) 73 | 74 | -- cgBody converts the SExp into a chunk of php which calculates the result 75 | -- of an expression, then runs the function on the resulting bit of code. 76 | -- 77 | -- We do it this way because we might calculate an expression in a deeply nested 78 | -- case statement, or inside a let, etc, so the assignment/return of the calculated 79 | -- expression itself may happen quite deeply. 80 | 81 | cgBody :: (Doc -> Doc) -> SExp -> Doc 82 | cgBody ret (SV (Glob n)) = ret $ rubyname n 83 | cgBody ret (SV (Loc i)) = ret $ loc i 84 | cgBody ret (SApp _ f args) = ret $ rubyname f <> lparen <> 85 | text (showSep "," (map (show . cgVar) args)) <> rparen 86 | cgBody ret (SLet (Loc i) v sc) 87 | = cgBody (\x -> cgIndent <> loc i <+> text "=" <+> x <+> br) v <+> 88 | cgIndent <> cgBody ret sc 89 | cgBody ret (SUpdate n e) = cgIndent <> cgBody ret e 90 | cgBody ret (SProj e i) 91 | = ret $ cgVar e <> lbrack <> text (show (i + 1)) <> rbrack 92 | cgBody ret (SCon _ t n args) 93 | = ret $ lbrack <> text (showSep "," ((show t) : (map (show . cgVar) args))) <> rbrack 94 | cgBody ret (SCase _ e alts) 95 | = let scrvar = cgVar e 96 | scr = if any conCase alts then scrvar <> text "[0]" else scrvar in 97 | cgIndent <> text "case" <+> scr $+$ 98 | text (showSep "\n" (map (show . (cgAlt ret scrvar)) alts)) $+$ 99 | cgIndent <> end <+> br 100 | where conCase (SConCase _ _ _ _ _) = True 101 | conCase _ = False 102 | cgBody ret (SChkCase e alts) 103 | = let scrvar = cgVar e 104 | scr = if any conCase alts then scrvar <> text "[0]" else scrvar in 105 | cgIndent <> text "case" <+> scr $+$ 106 | text (showSep "\n" (map (show . (cgAlt ret scrvar)) alts)) $+$ 107 | cgIndent <> end <+> br 108 | where conCase (SConCase _ _ _ _ _) = True 109 | conCase _ = False 110 | 111 | cgBody ret (SConst c) = ret $ (cgConst c) 112 | cgBody ret (SOp op args) = ret $ cgOp op (map (show . cgVar) args) 113 | cgBody ret SNothing = ret $ text "0" 114 | cgBody ret (SError x) = ret $ text ("idris_error( " ++ show x ++ ")") 115 | cgBody ret _ = ret $ text "idris_error(\"NOT IMPLEMENTED!!!!\")" 116 | 117 | cgAlt :: (Doc -> Doc) -> Doc -> SAlt -> Doc 118 | cgAlt ret scr (SConstCase t exp) 119 | = cgIndent <> when <+> text (show t) $+$ 120 | cgIndent <> cgBody ret exp 121 | cgAlt ret scr (SDefaultCase exp) = cgIndent <> when <> text "-1; else" $+$ 122 | cgIndent <> cgBody ret exp 123 | cgAlt ret scr (SConCase lv t n args exp) 124 | = cgIndent <> when <+> text (show t) $+$ 125 | cgIndent <> project 1 lv args $+$ 126 | cgIndent <> cgBody ret exp 127 | where project i v [] = text "" 128 | project i v (n : ns) = cgIndent <> loc v <> text " = " <> scr <> lbrack <> text (show i) <> rbrack $+$ 129 | cgIndent <> project (i + 1) (v + 1) ns 130 | 131 | cgVar :: LVar -> Doc 132 | cgVar (Loc i) = loc i 133 | cgVar (Glob n) = var n 134 | 135 | cgConst :: Const -> Doc 136 | cgConst (I i) = text $ show i 137 | cgConst (Ch i) = text $ show (ord i) 138 | cgConst (BI i) = text $ show i 139 | cgConst (Str s) = text $ show s 140 | cgConst TheWorld = text "0" 141 | cgConst x | isTypeConst x = text "0" 142 | cgConst x = error $ "Constant " ++ show x ++ " not compilable yet" 143 | 144 | cgOp :: PrimFn -> [String] -> Doc 145 | cgOp (LPlus (ATInt _)) [l, r] 146 | = text $ "(" ++ l ++ " + " ++ r ++ ")" 147 | cgOp (LMinus (ATInt _)) [l, r] 148 | = text $ "(" ++ l ++ " - " ++ r ++ ")" 149 | cgOp (LTimes (ATInt _)) [l, r] 150 | = text $ "(" ++ l ++ " * " ++ r ++ ")" 151 | cgOp (LEq (ATInt _)) [l, r] 152 | = text $ "idris_is_none(" ++ l ++ ", " ++ r ++ ")" 153 | cgOp (LSLt (ATInt _)) [l, r] 154 | = text $ "(" ++ l ++ " < " ++ r ++ ")" 155 | cgOp (LSLe (ATInt _)) [l, r] 156 | = text $ "(" ++ l ++ " <= " ++ r ++ ")" 157 | cgOp (LSGt (ATInt _)) [l, r] 158 | = text $ "(" ++ l ++ " > " ++ r ++ ")" 159 | cgOp (LSGe (ATInt _)) [l, r] 160 | = text $ "(" ++ l ++ " >= " ++ r ++ ")" 161 | cgOp LStrEq [l,r] = text $ "idris_is_none(" ++ l ++ ", " ++ r ++ ")" 162 | cgOp LStrRev [x] = text $ x ++ ".reverse" 163 | cgOp LStrLen [x] = text $ x ++ ".length" 164 | cgOp LStrHead [x] = text $ x ++ "[0].ord" 165 | cgOp LStrIndex [x, y] = text $ x ++ "[" ++ y ++ "].ord" 166 | cgOp LStrTail [x] = text $ x ++ "[1..-1]" 167 | 168 | cgOp (LIntStr _) [x] = text $ x ++ ".to_s" 169 | cgOp (LChInt _) [x] = text $ x 170 | cgOp (LIntCh _) [x] = text $ x 171 | cgOp (LSExt _ _) [x] = text $ x 172 | cgOp (LTrunc _ _) [x] = text $ x 173 | cgOp LWriteStr [_,str] = text $ "idris_writeStr(" ++ str ++ ")" 174 | cgOp LReadStr [_] = text $ "idris_readStr()" 175 | cgOp LStrConcat [l,r] = text $ "idris_append(" ++ l ++ ", " ++ r ++ ")" 176 | cgOp LStrCons [l,r] = text $ "idris_append(" ++ l ++ ".chr, " ++ r ++ ")" 177 | cgOp op exps = text $ "idris_error(\"OPERATOR " ++ show op ++ " NOT IMPLEMENTED!!!!\")" 178 | -- error("Operator " ++ show op ++ " not implemented") 179 | 180 | 181 | 182 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Idris.Core.TT 4 | import Idris.AbsSyntax 5 | import Idris.ElabDecls 6 | import Idris.REPL 7 | 8 | import IRTS.Compiler 9 | import IRTS.CodegenRuby 10 | 11 | import System.Environment 12 | import System.Exit 13 | 14 | import Paths_idris_ruby 15 | 16 | data Opts = Opts { inputs :: [FilePath], 17 | output :: FilePath } 18 | 19 | showUsage = do putStrLn "Usage: idris-ruby [-o ]" 20 | exitWith ExitSuccess 21 | 22 | getOpts :: IO Opts 23 | getOpts = do xs <- getArgs 24 | return $ process (Opts [] "a.rb") xs 25 | where 26 | process opts ("-o":o:xs) = process (opts { output = o }) xs 27 | process opts (x:xs) = process (opts { inputs = x:inputs opts }) xs 28 | process opts [] = opts 29 | 30 | c_main :: Opts -> Idris () 31 | c_main opts = do elabPrims 32 | loadInputs (inputs opts) Nothing 33 | mainProg <- elabMain 34 | ir <- compile (Via "ruby") (output opts) (Just mainProg) 35 | runIO $ codegenRuby ir 36 | 37 | main :: IO () 38 | main = do opts <- getOpts 39 | if (null (inputs opts)) 40 | then showUsage 41 | else runMain (c_main opts) 42 | 43 | 44 | --------------------------------------------------------------------------------