├── .gitignore ├── LICENSE ├── idris-elixir.cabal ├── run_tests.sh ├── src ├── IRTS │ └── CodegenElixir.hs └── Main.hs ├── stack.yaml └── test ├── inputs └── hello.idr └── test.sh /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | /.stack-work 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2017 Jacob Mitchell 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /idris-elixir.cabal: -------------------------------------------------------------------------------- 1 | Name: idris-elixir 2 | Version: 0.0.0.1 3 | License: Apache-2.0 4 | License-file: LICENSE 5 | Author: Jacob Mitchell 6 | Maintainer: Jacob Mitchell 7 | Build-Type: Simple 8 | Cabal-Version: >= 1.8 9 | Extra-source-files: 10 | rts/* 11 | 12 | Executable idris-elixir 13 | Main-is: Main.hs 14 | hs-source-dirs: src 15 | 16 | Build-depends: idris >= 0.99 17 | , base 18 | , containers 19 | , directory 20 | , filepath 21 | , haskeline >= 0.7 22 | , mtl 23 | , transformers 24 | , pretty 25 | , pretty-show 26 | 27 | other-modules: IRTS.CodegenElixir 28 | 29 | if os(linux) 30 | cpp-options: -DLINUX 31 | build-depends: unix < 2.8 32 | if os(freebsd) 33 | cpp-options: -DFREEBSD 34 | build-depends: unix < 2.8 35 | if os(dragonfly) 36 | cpp-options: -DDRAGONFLY 37 | build-depends: unix < 2.8 38 | if os(darwin) 39 | cpp-options: -DMACOSX 40 | build-depends: unix < 2.8 41 | if os(windows) 42 | cpp-options: -DWINDOWS 43 | build-depends: Win32 < 2.4 44 | 45 | ghc-prof-options: -auto-all -caf-all 46 | ghc-options: -threaded -rtsopts -funbox-strict-fields 47 | -------------------------------------------------------------------------------- /run_tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | TESTS=("hello") 4 | 5 | for t in ${TESTS}; do 6 | ./test/test.sh "${t}" 7 | done 8 | -------------------------------------------------------------------------------- /src/IRTS/CodegenElixir.hs: -------------------------------------------------------------------------------- 1 | module IRTS.CodegenElixir(codegenElixir) where 2 | 3 | import IRTS.CodegenCommon 4 | import IRTS.Simplified 5 | import IRTS.Defunctionalise (DDecl) 6 | import IRTS.Lang 7 | 8 | import Idris.Core.TT 9 | 10 | import Data.Maybe 11 | import Data.Char 12 | 13 | codegenElixir :: CodeGenerator 14 | codegenElixir ci = do 15 | let out = concatMap doCodegen (simpleDecls ci) 16 | writeFile (outputFile ci) ("# generated by idris-elixir\n" ++ helpers ++ "\n" ++ 17 | "defmodule IdrisElixir do\n" ++ 18 | indent out ++ "\n" ++ 19 | "end\n" ++ 20 | start ++ "\n" ++ 21 | "\n\n") 22 | 23 | start = "IdrisElixir." ++ elixirname (sMN 0 "runMain") ++ "()" 24 | 25 | helpers = errCode ++ "\n" 26 | 27 | errCode = unlines 28 | [ "defmodule IdrisElixirError do" 29 | , " defexception [:message]" 30 | , "" 31 | , " def exception(value) do" 32 | , " %IdrisElixirError{message: inspect value}" 33 | , " end" 34 | , "end" 35 | ] 36 | 37 | elixirname :: Name -> String 38 | elixirname n = "idris_" ++ concatMap elixirchar (showCG n) 39 | where elixirchar x | isAlpha x || isDigit x = [x] 40 | | otherwise = "_" ++ show (fromEnum x) ++ "_" 41 | 42 | var :: Name -> String 43 | var n = "var" ++ elixirname n 44 | 45 | loc :: Int -> String 46 | loc i = "loc" ++ show i 47 | 48 | doCodegen :: (Name, SDecl) -> String 49 | doCodegen (n, SFun _ args i def) = cgFun n args def 50 | 51 | indent :: String -> String 52 | indent block = 53 | unlines $ map (\line -> " " ++ line) (lines block) 54 | 55 | cgFun :: Name -> [Name] -> SExp -> String 56 | cgFun n args def 57 | = "def " ++ elixirname n ++ "(" 58 | ++ showSep ", " (map (loc . fst) (zip [0..] args)) ++ ") do\n" 59 | ++ indent (cgBody doRet def) ++ "end\n\n" 60 | where doRet :: String -> String -- Return the calculated expression 61 | doRet str = str 62 | 63 | -- cgBody converts the SExp into a chunk of php which calculates the result 64 | -- of an expression, then runs the function on the resulting bit of code. 65 | -- 66 | -- We do it this way because we might calculate an expression in a deeply nested 67 | -- case statement, or inside a let, etc, so the assignment/return of the calculated 68 | -- expression itself may happen quite deeply. 69 | 70 | cgBody :: (String -> String) -> SExp -> String 71 | cgBody ret (SV (Glob n)) = ret $ elixirname n ++ "()" 72 | cgBody ret (SV (Loc i)) = ret $ loc i 73 | cgBody ret (SApp _ f args) = ret $ elixirname f ++ "(" ++ 74 | showSep "," (map cgVar args) ++ ")" 75 | cgBody ret (SLet (Loc i) v sc) 76 | = cgBody (\x -> loc i ++ " = " ++ x ++ "\n") v ++ 77 | cgBody ret sc 78 | cgBody ret (SUpdate n e) 79 | = cgBody ret e 80 | cgBody ret (SProj e i) 81 | = ret $ cgVar e ++ "[" ++ show (i + 1) ++ "]" 82 | cgBody ret (SCon _ t n args) 83 | = ret $ "[" ++ showSep ", " 84 | (show t : (map cgVar args)) ++ "]" 85 | cgBody ret (SCase _ e alts) 86 | = let scrvar = cgVar e 87 | scr = if any conCase alts then "hd " ++ scrvar else scrvar in 88 | "case " ++ scr ++ " do\n" 89 | ++ indent (showSep "\n" (map (cgAlt ret scrvar) alts)) ++ "\nend" 90 | where conCase (SConCase _ _ _ _ _) = True 91 | conCase _ = False 92 | cgBody ret (SChkCase e alts) 93 | = let scrvar = cgVar e 94 | scr = if any conCase alts then "hd " ++ scrvar else scrvar in 95 | "case " ++ scr ++ " do\n" 96 | ++ indent (showSep "\n" (map (cgAlt ret scrvar) alts)) ++ "\nend" 97 | where conCase (SConCase _ _ _ _ _) = True 98 | conCase _ = False 99 | cgBody ret (SConst c) = ret $ cgConst c 100 | cgBody ret (SOp op args) = ret $ cgOp op (map cgVar args) 101 | cgBody ret SNothing = ret "0" 102 | cgBody ret (SError x) = ret $ "raise IdrisElixirError, " ++ show x 103 | cgBody ret _ = ret $ "raise IdrisElixirError, \"NOT IMPLEMENTED!!!!\"" 104 | 105 | cgAlt :: (String -> String) -> String -> SAlt -> String 106 | cgAlt ret scr (SConstCase t exp) 107 | = show t ++ " ->\n" ++ indent (cgBody ret exp) 108 | cgAlt ret scr (SDefaultCase exp) = "_ ->\n" ++ indent (cgBody ret exp) 109 | cgAlt ret scr (SConCase lv t n args exp) 110 | = show t ++ " ->\n" 111 | ++ indent (project 1 lv args ++ "\n" ++ cgBody ret exp) 112 | where project i v [] = "" 113 | project i v (n : ns) = loc v ++ " = Enum.at(" ++ scr ++ ", " ++ show i ++ "); " 114 | ++ project (i + 1) (v + 1) ns 115 | 116 | cgVar :: LVar -> String 117 | cgVar (Loc i) = loc i 118 | cgVar (Glob n) = var n 119 | 120 | cgConst :: Const -> String 121 | cgConst (I i) = show i 122 | cgConst (Ch i) = "''" ++ show i ++ "''" 123 | cgConst (BI i) = show i 124 | cgConst (Str s) = show s 125 | cgConst TheWorld = "0" 126 | cgConst x | isTypeConst x = "0" 127 | cgConst x = error $ "Constant " ++ show x ++ " not compilable yet" 128 | 129 | cgOp :: PrimFn -> [String] -> String 130 | cgOp (LPlus (ATInt _)) [l, r] 131 | = "(" ++ l ++ " + " ++ r ++ ")" 132 | cgOp (LMinus (ATInt _)) [l, r] 133 | = "(" ++ l ++ " - " ++ r ++ ")" 134 | cgOp (LTimes (ATInt _)) [l, r] 135 | = "(" ++ l ++ " * " ++ r ++ ")" 136 | cgOp (LEq (ATInt _)) [l, r] 137 | = "(" ++ l ++ " == " ++ r ++ ")" 138 | cgOp (LSLt (ATInt _)) [l, r] 139 | = "(" ++ l ++ " < " ++ r ++ ")" 140 | cgOp (LSLe (ATInt _)) [l, r] 141 | = "(" ++ l ++ " <= " ++ r ++ ")" 142 | cgOp (LSGt (ATInt _)) [l, r] 143 | = "(" ++ l ++ " > " ++ r ++ ")" 144 | cgOp (LSGe (ATInt _)) [l, r] 145 | = "(" ++ l ++ " >= " ++ r ++ ")" 146 | cgOp LStrEq [l,r] = "(" ++ l ++ " == " ++ r ++ ")" 147 | cgOp LStrRev [x] = "strrev(" ++ x ++ ")" 148 | cgOp LStrLen [x] = "strlen(utf8_decode(" ++ x ++ "))" 149 | cgOp LStrHead [x] = "ord(" ++ x ++ "[0])" 150 | cgOp LStrIndex [x, y] = "ord(" ++ x ++ "[" ++ y ++ "])" 151 | cgOp LStrTail [x] = "substr(" ++ x ++ ", 1)" 152 | 153 | cgOp (LIntStr _) [x] = "\"" ++ x ++ "\"" 154 | cgOp (LChInt _) [x] = x 155 | cgOp (LIntCh _) [x] = x 156 | cgOp (LSExt _ _) [x] = x 157 | cgOp (LTrunc _ _) [x] = x 158 | cgOp LWriteStr [_,str] = "IO.puts(" ++ str ++ ")" 159 | cgOp LReadStr [_] = "IO.gets(\"\")" 160 | cgOp LStrConcat [l,r] = "(" ++ l ++ " <> " ++ r ++ ")" 161 | cgOp LStrCons [l,r] = "\"#{" ++ l ++ "}{" ++ r ++ "}\"" 162 | cgOp (LStrInt _) [x] = x 163 | cgOp op exps = "raise IdrisElixirError, \"OPERATOR " ++ show op ++ " NOT IMPLEMENTED!!!!\"" 164 | -- error("Operator " ++ show op ++ " not implemented") 165 | -------------------------------------------------------------------------------- /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 | import Idris.Main 8 | import Idris.ModeCommon 9 | 10 | import IRTS.Compiler 11 | import IRTS.CodegenElixir 12 | 13 | import System.Environment 14 | import System.Exit 15 | 16 | import Paths_idris_elixir 17 | 18 | data Opts = Opts { inputs :: [FilePath], 19 | output :: FilePath } 20 | 21 | showUsage = do putStrLn "Usage: idris-elixir [-o ]" 22 | exitWith ExitSuccess 23 | 24 | getOpts :: IO Opts 25 | getOpts = do xs <- getArgs 26 | return $ process (Opts [] "a.ex") xs 27 | where 28 | process opts ("-o":o:xs) = process (opts { output = o }) xs 29 | process opts (x:xs) = process (opts { inputs = x:inputs opts }) xs 30 | process opts [] = opts 31 | 32 | cg_main :: Opts -> Idris () 33 | cg_main opts = do elabPrims 34 | loadInputs (inputs opts) Nothing 35 | mainProg <- elabMain 36 | ir <- compile (Via IBCFormat "elixir") (output opts) (Just mainProg) 37 | runIO $ codegenElixir ir 38 | 39 | main :: IO () 40 | main = do opts <- getOpts 41 | if (null (inputs opts)) 42 | then showUsage 43 | else runMain (cg_main opts) 44 | 45 | 46 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # A warning or info to be displayed to the user on config load. 8 | user-message: ! 'Warning (added by new or init): Specified resolver could not satisfy 9 | all dependencies. Some external packages have been added as dependencies. 10 | 11 | You can suppress this message by removing it from stack.yaml 12 | 13 | ' 14 | 15 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 16 | # A snapshot resolver dictates the compiler version and the set of packages 17 | # to be used for project dependencies. For example: 18 | # 19 | # resolver: lts-3.5 20 | # resolver: nightly-2015-09-21 21 | # resolver: ghc-7.10.2 22 | # resolver: ghcjs-0.1.0_ghc-7.10.2 23 | # resolver: 24 | # name: custom-snapshot 25 | # location: "./custom-snapshot.yaml" 26 | resolver: lts-7.17 27 | 28 | # User packages to be built. 29 | # Various formats can be used as shown in the example below. 30 | # 31 | # packages: 32 | # - some-directory 33 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 34 | # - location: 35 | # git: https://github.com/commercialhaskell/stack.git 36 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 37 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 38 | # extra-dep: true 39 | # subdirs: 40 | # - auto-update 41 | # - wai 42 | # 43 | # A package marked 'extra-dep: true' will only be built if demanded by a 44 | # non-dependency (i.e. a user package), and its test suites and benchmarks 45 | # will not be run. This is useful for tweaking upstream packages. 46 | packages: 47 | - '.' 48 | # Dependency packages to be pulled from upstream that are not in the resolver 49 | # (e.g., acme-missiles-0.3) 50 | extra-deps: 51 | - idris-0.99 52 | - safe-0.3.9 53 | 54 | # Override default flag values for local packages and extra-deps 55 | flags: {} 56 | 57 | # Extra package databases containing global packages 58 | extra-package-dbs: [] 59 | 60 | # Control whether we use the GHC we find on the path 61 | # system-ghc: true 62 | # 63 | # Require a specific version of stack, using version ranges 64 | # require-stack-version: -any # Default 65 | # require-stack-version: ">=1.3" 66 | # 67 | # Override the architecture used by stack, especially useful on Windows 68 | # arch: i386 69 | # arch: x86_64 70 | # 71 | # Extra directories used by stack for building 72 | # extra-include-dirs: [/path/to/dir] 73 | # extra-lib-dirs: [/path/to/dir] 74 | # 75 | # Allow a newer minor version of GHC than the snapshot specifies 76 | # compiler-check: newer-minor -------------------------------------------------------------------------------- /test/inputs/hello.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | main : IO () 4 | main = putStrLn "Hello world" 5 | -------------------------------------------------------------------------------- /test/test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | TEST_INPUT_DIR="./test/inputs" 6 | TEST="${TEST_INPUT_DIR}/$1" 7 | TMP_DIR="./tmp" 8 | TMP_FILE_PREFIX="${TMP_DIR}/$(basename ${TEST})" 9 | STACK_BIN="./.stack-work/install/x86_64-linux/lts-7.17/8.0.1/bin" 10 | 11 | rm -rf "${TMP_DIR}" 12 | mkdir -p "${TMP_DIR}" 13 | 14 | "${STACK_BIN}/idris" "${TEST}.idr" -o "${TMP_FILE_PREFIX}" 15 | mv "${TEST}.ibc" "${TMP_FILE_PREFIX}.ibc" 16 | stack build 17 | "${STACK_BIN}/idris-elixir" "${TMP_FILE_PREFIX}.ibc" -o "${TMP_FILE_PREFIX}.exs" 18 | elixir "${TMP_FILE_PREFIX}.exs" 19 | --------------------------------------------------------------------------------