Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
Browse the repository at this point in the history
refactor code into separate files; fix toJs tabbing
- Loading branch information
Showing
5 changed files
with
130 additions
and
75 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,28 @@ | ||
module Test where | ||
|
||
import Control.Monad.State(runState) | ||
import Data.Maybe(fromJust) | ||
|
||
import Infer | ||
import Pretty | ||
import Types | ||
|
||
-- ------------------------------------------------------------------------ | ||
|
||
ex expr = Expr expr () | ||
|
||
e1 = ex $ LitFunc ["arg"] ["vari"] | ||
$ [ex $ Var "vari" | ||
, ex $ Assign (ex $ Var "vari") (ex $ LitObject [("amount", ex $ LitNumber 123)]) | ||
, ex $ Assign (ex $ Property (ex $ Var "vari") "amount") (ex $ LitNumber 0) | ||
-- , ex $ Assign (ex $ Var "vari") (ex $ LitString "ma?") | ||
, ex $ Return (ex $ LitArray []) | ||
, ex $ Return (ex $ LitArray [ex $ LitObject [("bazooka", ex $ Var "arg"), ("number", ex $ Var "vari")]])] | ||
--e1 = ex $ LitFunc ["arg"] ["vari"] [] | ||
|
||
t1 = inferType Global e1 | ||
s1 = runState t1 emptyScope | ||
s1doc = toJsDoc . fromJust . getExprType $ fst s1 | ||
|
||
e2 = ex $ Property (ex $ Index (ex $ Call e1 [(ex $ LitString "abc")]) (ex $ LitNumber 2)) "number" | ||
s2 = runState (inferType Global e2) emptyScope |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,75 @@ | ||
module Pretty where | ||
|
||
import Data.List(intersperse) | ||
import Text.PrettyPrint.GenericPretty(Generic, Out(..), pp) | ||
|
||
|
||
import Types | ||
import Infer | ||
|
||
|
||
|
||
instance (Out a) => Out (Body a) | ||
instance (Out a) => Out (Expr a) | ||
instance Out TypeError | ||
instance Out VarScope | ||
instance Out TypeScope | ||
instance Out FuncScope | ||
instance Out Scope | ||
|
||
|
||
commafy :: [String] -> String | ||
commafy [] = [] | ||
commafy (x:[]) = x | ||
commafy (x:xs) = x ++ ", " ++ (commafy xs) | ||
|
||
toJs :: Expr a -> String | ||
toJs = toJs' 0 | ||
|
||
makeTab :: Int -> String | ||
makeTab tabAmount = "\n" ++ (concat $ replicate tabAmount " " ) | ||
|
||
toJs' :: Int -> Expr a -> String | ||
toJs' tabAmount (Expr body _) = let tab = makeTab tabAmount in | ||
case body of | ||
Assign target src -> (toJs'' target) ++ " = " ++ (toJs'' src) | ||
Call callee args -> (toJs'' callee) ++ "(" ++ (commafy $ map toJs'' args) ++ ")" | ||
Index arr idx -> (toJs'' arr) ++ "[" ++ (toJs'' idx) ++ "]" | ||
LitArray xs -> "[" ++ (commafy $ map toJs'' xs) ++ "]" | ||
LitBoolean x -> if x then "true" else "false" | ||
LitFunc args varNames exprs -> "function (" ++ argsJs ++ ") {" ++ block ++ tab ++ "}" | ||
where argsJs = commafy $ args | ||
block = concat $ intersperse tab' ["", vars', "", statements] | ||
statements = (concat $ map (++ ";" ++ tab') $ map toJs'' exprs) | ||
vars' = "var " ++ commafy varNames ++ ";" | ||
tab' = makeTab $ tabAmount + 1 | ||
LitNumber x -> if (fromIntegral truncated) == x | ||
then show $ truncated | ||
else show x | ||
where truncated = truncate x :: Integer | ||
LitObject xs -> "{ " ++ (commafy $ map (\(name, val) -> name ++ ": " ++ (toJs'' val)) xs) ++ " }" | ||
LitRegex regex -> "/" ++ regex ++ "/" -- todo correctly | ||
LitString s -> "'" ++ s ++ "'" -- todo escape | ||
Property obj name -> (toJs'' obj) ++ "." ++ name | ||
Return expr -> "return " ++ toJs'' expr | ||
Var name -> name | ||
where toJs'' = toJs' (tabAmount + 1) | ||
|
||
|
||
toJsDoc :: JSType -> String | ||
toJsDoc JSBoolean = "boolean" | ||
toJsDoc JSNumber = "number" | ||
toJsDoc JSString = "string" | ||
toJsDoc JSRegex = "regex" | ||
toJsDoc (JSFunc args res) = "function(" ++ (commafy . map toJsDoc $ args) ++ ") : " ++ (toJsDoc res) | ||
toJsDoc (JSArray elem') = "[" ++ toJsDoc elem' ++ "]" | ||
toJsDoc (JSObject props) = "{ " ++ (commafy . map showProp $ props) ++ " }" | ||
where showProp (name, t) = (show name) ++ ": " ++ (toJsDoc t) | ||
toJsDoc (JSTVar name) = toStrName name | ||
where toStrName x = letters!!(x `mod` numLetters):[] ++ (suffix x) | ||
letters = ['a'..'z'] | ||
numLetters = length letters | ||
suffix x = if 0 < x `div` numLetters | ||
then show (x `div` numLetters) | ||
else "" | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,2 @@ | ||
import Distribution.Simple | ||
main = defaultMain |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,24 @@ | ||
-- Initial jss.cabal generated by cabal init. For further documentation, | ||
-- see http://haskell.org/cabal/users-guide/ | ||
|
||
name: jss | ||
version: 0.1.0.0 | ||
-- synopsis: | ||
-- description: | ||
-- license: | ||
license-file: LICENSE | ||
author: Noam Lewis | ||
maintainer: noam.lewis@elastifile.com | ||
-- copyright: | ||
-- category: | ||
build-type: Simple | ||
extra-source-files: README.md | ||
cabal-version: >=1.10 | ||
|
||
library | ||
exposed-modules: Infer, Pretty, Types | ||
-- other-modules: | ||
other-extensions: DeriveGeneric | ||
build-depends: base >=4.7 && <4.8, GenericPretty, mtl, containers | ||
--hs-source-dirs: | ||
default-language: Haskell2010 |